diff options
380 files changed, 11847 insertions, 21400 deletions
diff --git a/.github/dependabot.yml b/.github/dependabot.yml new file mode 100644 index 0000000..203f3c8 --- /dev/null +++ b/.github/dependabot.yml @@ -0,0 +1,6 @@ +version: 2 +updates: +- package-ecosystem: "github-actions" + directory: "/" + schedule: + interval: "weekly" @@ -1,6 +1,6 @@ <?xml version="1.0" encoding="UTF-8"?> <projectDescription> - <name>tcl8</name> + <name>tcl9</name> <comment></comment> <projects> </projects> diff --git a/.travis.yml b/.travis.yml index 02fd9a3..99b692d 100644 --- a/.travis.yml +++ b/.travis.yml @@ -20,13 +20,13 @@ jobs: compiler: gcc env: - BUILD_DIR=unix - - name: "Linux/GCC/Shared: UTF_MAX=4" + - name: "Linux/GCC/Shared: UTF_MAX=3" os: linux dist: focal compiler: gcc env: - BUILD_DIR=unix - - CFGOPT=CFLAGS=-DTCL_UTF_MAX=4 + - CFGOPT="CFLAGS=-DTCL_UTF_MAX=3" - name: "Linux/GCC/Shared: NO_DEPRECATED" os: linux dist: focal @@ -83,13 +83,6 @@ jobs: compiler: clang env: - BUILD_DIR=unix - - name: "Linux/Clang/Shared:NO_DEPRECATED" - os: linux - dist: xenial - compiler: clang - env: - - BUILD_DIR=unix - - CFGOPT="CFLAGS=-DTCL_NO_DEPRECATED=1" - name: "Linux/Clang/Static" os: linux dist: focal @@ -215,15 +208,6 @@ jobs: script: - cmd.exe //C vcvarsall.bat x64 '&&' nmake '-f' makefile.vc all tcltest - cmd.exe //C vcvarsall.bat x64 '&&' nmake '-f' makefile.vc test - - name: "Windows/MSVC/Shared: UTF_MAX=4" - os: windows - compiler: cl - env: *vcenv - before_install: *vcpreinst - install: [] - script: - - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=utf16' '-f' makefile.vc all tcltest - - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=utf16' '-f' makefile.vc test - name: "Windows/MSVC/Shared: NO_DEPRECATED" os: windows compiler: cl @@ -270,15 +254,6 @@ jobs: script: - cmd.exe //C vcvarsall.bat x86 '&&' nmake '-f' makefile.vc all tcltest - cmd.exe //C vcvarsall.bat x86 '&&' nmake '-f' makefile.vc test - - name: "Windows/MSVC-x86/Shared: UTF_MAX=4" - os: windows - compiler: cl - env: *vcenv - before_install: *vcpreinst - install: [] - script: - - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'OPTS=utf16' '-f' makefile.vc all tcltest - - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'OPTS=utf16' '-f' makefile.vc test - name: "Windows/MSVC-x86/Shared: NO_DEPRECATED" os: windows compiler: cl @@ -326,12 +301,12 @@ jobs: - touch generic/tclStubInit.c generic/tclOOStubInit.c generic/tclOOScript.h - choco install -y make zip - cd ${BUILD_DIR} - - name: "Windows/GCC/Shared: UTF_MAX=4" + - name: "Windows/GCC/Shared: UTF_MAX=3" os: windows compiler: gcc env: - BUILD_DIR=win - - CFGOPT="--enable-64bit CFLAGS=-DTCL_UTF_MAX=4" + - CFGOPT="--enable-64bit CFLAGS=-DTCL_UTF_MAX=3" before_install: *makepreinst - name: "Windows/GCC/Shared: NO_DEPRECATED" os: windows @@ -368,12 +343,12 @@ jobs: env: - BUILD_DIR=win before_install: *makepreinst - - name: "Windows/GCC-x86/Shared: UTF_MAX=4" + - name: "Windows/GCC-x86/Shared: UTF_MAX=3" os: windows compiler: gcc env: - BUILD_DIR=win - - CFGOPT="CFLAGS=-DTCL_UTF_MAX=4" + - CFGOPT="CFLAGS=-DTCL_UTF_MAX=3" before_install: *makepreinst - name: "Windows/GCC-x86/Shared: NO_DEPRECATED" os: windows diff --git a/ChangeLog.2000 b/ChangeLog.2000 index 7e78c19..8abe6c2 100644 --- a/ChangeLog.2000 +++ b/ChangeLog.2000 @@ -1356,7 +1356,7 @@ * doc/source.n: * doc/Eval.3: * tests/source.test: - * generic/tclIOUtil.c (Tcl_EvalFile): added explicit \32 (^Z) eofchar + * generic/tclIOUtil.c (Tcl_EvalFile): added explicit \x1A (^Z) eofchar (affects Tcl_EvalFile in C, "source" in Tcl). This was implicit on Windows already, and is now cross-platform to allow for scripted documents. @@ -1,13 +1,24 @@ # README: Tcl -This is the **Tcl 8.7a6** source distribution. +This is the **Tcl 9.0a4** source distribution. You can get any source release of Tcl from [our distribution site](https://sourceforge.net/projects/tcl/files/Tcl/). +8.6 (production release, daily build) +[](https://github.com/tcltk/tcl/actions?query=workflow%3A%22Linux%22+branch%3Acore-8-6-branch) +[](https://github.com/tcltk/tcl/actions?query=workflow%3A%22Windows%22+branch%3Acore-8-6-branch) +[](https://github.com/tcltk/tcl/actions?query=workflow%3A%22macOS%22+branch%3Acore-8-6-branch) +<br> +8.7 (in development, daily build)) [](https://github.com/tcltk/tcl/actions?query=workflow%3A%22Linux%22+branch%3Acore-8-branch) [](https://github.com/tcltk/tcl/actions?query=workflow%3A%22Windows%22+branch%3Acore-8-branch) [](https://github.com/tcltk/tcl/actions?query=workflow%3A%22macOS%22+branch%3Acore-8-branch) +<br> +9.0 (in development, daily build)) +[](https://github.com/tcltk/tcl/actions?query=workflow%3A%22Linux%22+branch%3Amain) +[](https://github.com/tcltk/tcl/actions?query=workflow%3A%22Windows%22+branch%3Amain) +[](https://github.com/tcltk/tcl/actions?query=workflow%3A%22macOS%22+branch%3Amain) ## Contents 1. [Introduction](#intro) @@ -45,7 +56,7 @@ and selling it either in whole or in part. See the file ## <a id="doc">2.</a> Documentation Extensive documentation is available on our website. The home page for this release, including new features, is -[here](https://www.tcl-lang.org/software/tcltk/8.7.html). +[here](https://www.tcl-lang.org/software/tcltk/9.0.html). Detailed release notes can be found at the [file distributions page](https://sourceforge.net/projects/tcl/files/Tcl/) by clicking on the relevant version. @@ -55,8 +66,8 @@ Xchange](https://www.tcl-lang.org/about/). There have been many Tcl books on the market. Many are mentioned in [the Wiki](https://wiki.tcl-lang.org/_/ref?N=25206). -The complete set of reference manual entries for Tcl 8.7 is [online, -here](https://www.tcl-lang.org/man/tcl8.7/). +The complete set of reference manual entries for Tcl 9.0 is [online, +here](https://www.tcl-lang.org/man/tcl9.0/). ### <a id="doc.unix">2a.</a> Unix Documentation The `doc` subdirectory in this release contains a complete set of @@ -4976,7 +4976,7 @@ msgcat package (duperval, krone, nelson) trace {add|remove|list} {variable|command} name ops command (darley, melski) -2000-09-06 (cross-platform feature) Set ^Z (\32) as default EOF char. (hobbs) +2000-09-06 (cross-platform feature) Set ^Z (\x1A) as default EOF char. (hobbs) 2000-09-07 partial fix for bug 2460 to prevent exec mem leak on Windows for the common case (gravereaux) @@ -9127,6 +9127,26 @@ in this changeset (new minor version) rather than bug fixes: - Released 8.7a3, Nov 21, 2019 --- https://core.tcl-lang.org/tcl/ for details - +Changes to 9.0a1 include all changes to the 8.7 line through 8.7a3, +plus the following, which focuses on the high-level feature changes +in this changeset (new minor version) rather than bug fixes: + +2017-11-03 [TIP 114] Leading zero integer no longer means octal + +2017-11-03 [TIP 278] Revise variable name resolution, solve "Creative Writing" + +2017-11-03 [TIPs 330,336] Encapsulate struct Tcl_Interp + +2017-11-17 [TIP 422] Remove all Tcl_*VA() routines + +2017-12-15 [TIP 488] Disable magic $::tcl_precision + +2018-10-08 [TIP 494] Increased support for size_t value ranges + +2019-05-31 [TIP 537] 64-bit indices in regexp matching + +- Released 9.0a1, Nov 25, 2019 --- https://core.tcl-lang.org/tcl/ for details - + 2019-12-03 (bug)[3cd9be] Corner case in surrogate handling (nijtmans) 2019-12-09 (new) Add tcltest::(Setup|Eval|Cleanup|)Test (coulter,sebres) @@ -9334,6 +9354,24 @@ in this changeset (new minor version) rather than bug fixes: - Released 8.7a5, Jun 18, 2021 --- https://core.tcl-lang.org/tcl/ for details - +Changes to 9.0a3 include all changes to the 8.7 line through 8.7a5, +plus the following, which focuses on the high-level feature changes +in this changeset (new major version) rather than bug fixes: + +Many of the TIPs in Tcl 8.7 mentioned above are extended further in 9.0 + +2020-02-28 [TIP 497] Full support for Unicode planes 1-16 + +2020-08-21 (bug)[43b434] improper calls to stat64() + +2021-04-08 [TIP 595] Unicode-aware loadable library handling. + +2021-04-30 [TIP 596] Stubs support for embedding Tcl in apps + +Many internal changes to broaden support for sizes beyond 32-bits. + +- Released 9.0a3, Jun 23, 2021 --- https://core.tcl-lang.org/tcl/ for details - + 2021-02-02 (new) support for MacOS Big Sur updates (nijtmans) => platform 1.0.17 diff --git a/compat/opendir.c b/compat/opendir.c index 25a7ada..13eb974 100644 --- a/compat/opendir.c +++ b/compat/opendir.c @@ -28,7 +28,7 @@ opendir( if ((fd = open(myname, 0, 0)) == -1) { return NULL; } - dirp = (DIR *) ckalloc(sizeof(DIR)); + dirp = (DIR *) Tcl_Alloc(sizeof(DIR)); if (dirp == NULL) { /* unreachable? */ close(fd); @@ -106,5 +106,5 @@ closedir( close(dirp->dd_fd); dirp->dd_fd = -1; dirp->dd_loc = 0; - ckfree(dirp); + Tcl_Free(dirp); } diff --git a/compat/waitpid.c b/compat/waitpid.c index 626d210..cf025b0 100644 --- a/compat/waitpid.c +++ b/compat/waitpid.c @@ -100,7 +100,7 @@ waitpid( } else { prevPtr->nextPtr = waitPtr->nextPtr; } - ckfree(waitPtr); + Tcl_Free(waitPtr); return result; } @@ -156,7 +156,7 @@ waitpid( goto waitAgain; } } - waitPtr = (WaitInfo *) ckalloc(sizeof(WaitInfo)); + waitPtr = (WaitInfo *) Tcl_Alloc(sizeof(WaitInfo)); waitPtr->pid = result; waitPtr->status = status; waitPtr->nextPtr = deadList; diff --git a/doc/AddErrInfo.3 b/doc/AddErrInfo.3 index 53f134a..3968820 100644 --- a/doc/AddErrInfo.3 +++ b/doc/AddErrInfo.3 @@ -9,7 +9,7 @@ .so man.macros .BS .SH NAME -Tcl_GetReturnOptions, Tcl_SetReturnOptions, Tcl_AddErrorInfo, Tcl_AppendObjToErrorInfo, Tcl_AddObjErrorInfo, Tcl_SetObjErrorCode, Tcl_SetErrorCode, Tcl_SetErrorCodeVA, Tcl_SetErrorLine, Tcl_GetErrorLine, Tcl_PosixError, Tcl_LogCommandInfo \- retrieve or record information about errors and other return options +Tcl_GetReturnOptions, Tcl_SetReturnOptions, Tcl_AddErrorInfo, Tcl_AppendObjToErrorInfo, Tcl_AddObjErrorInfo, Tcl_SetObjErrorCode, Tcl_SetErrorCode, Tcl_SetErrorLine, Tcl_GetErrorLine, Tcl_PosixError, Tcl_LogCommandInfo \- retrieve or record information about errors and other return options .SH SYNOPSIS .nf \fB#include <tcl.h>\fR @@ -30,8 +30,6 @@ int .sp \fBTcl_SetErrorCode\fR(\fIinterp, element, element, ... \fB(char *) NULL\fR) .sp -\fBTcl_SetErrorCodeVA\fR(\fIinterp, argList\fR) -.sp \fBTcl_GetErrorLine\fR(\fIinterp\fR) .sp \fBTcl_SetErrorLine\fR(\fIinterp, lineNum\fR) @@ -56,14 +54,14 @@ 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 negative. +unless \fIlength\fR is TCL_INDEX_NONE. .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 int length in +.AP size_t length in The number of bytes to copy from \fImessage\fR when appending to the \fB\-errorinfo\fR return option. -If negative, all bytes up to the first null byte are used. +If TCL_INDEX_NONE, 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 @@ -78,8 +76,8 @@ The line number of a script where an error occurred. 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 int commandLength in -Number of bytes in command; -1 means use all bytes up to first null byte +.AP size_t commandLength in +Number of bytes in command; TCL_INDEX_NONE means use all bytes up to first null byte .BE .SH DESCRIPTION .PP @@ -229,7 +227,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 negative \fIlength\fR value. +interface is used at all, it should be with a TCL_INDEX_NONE \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 @@ -245,12 +243,6 @@ The procedure \fBTcl_SetErrorCode\fR is also used to set the record instead of a value. Otherwise, it is similar to \fBTcl_SetObjErrorCode\fR in behavior. .PP -\fBTcl_SetErrorCodeVA\fR is the same as \fBTcl_SetErrorCode\fR except that -instead of taking a variable number of arguments it takes an argument list. -Interfaces using argument lists have been found to be nonportable in practice. -This function is deprecated and will be removed in Tcl 9.0. - -.PP The procedure \fBTcl_GetErrorLine\fR is used to read the integer value of the \fB\-errorline\fR return option without the overhead of a full call to \fBTcl_GetReturnOptions\fR. Likewise, \fBTcl_SetErrorLine\fR diff --git a/doc/Alloc.3 b/doc/Alloc.3 index 70b0f7d..c0fd0cd 100644 --- a/doc/Alloc.3 +++ b/doc/Alloc.3 @@ -4,11 +4,11 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.TH Tcl_Alloc 3 7.5 Tcl "Tcl Library Procedures" +.TH Tcl_Alloc 3 9.0 Tcl "Tcl Library Procedures" .so man.macros .BS .SH NAME -Tcl_Alloc, Tcl_Free, Tcl_Realloc, Tcl_AttemptAlloc, Tcl_AttemptRealloc, Tcl_GetMemoryInfo, ckalloc, ckfree, ckrealloc, attemptckalloc, attemptckrealloc \- allocate or free heap memory +Tcl_Alloc, Tcl_Free, Tcl_Realloc, Tcl_AttemptAlloc, Tcl_AttemptRealloc, Tcl_GetMemoryInfo \- allocate or free heap memory .SH SYNOPSIS .nf \fB#include <tcl.h>\fR @@ -19,32 +19,17 @@ char * void \fBTcl_Free\fR(\fIptr\fR) .sp -char * +void * \fBTcl_Realloc\fR(\fIptr, size\fR) .sp -char * +void * \fBTcl_AttemptAlloc\fR(\fIsize\fR) .sp -char * +void * \fBTcl_AttemptRealloc\fR(\fIptr, size\fR) .sp void \fBTcl_GetMemoryInfo\fR(\fIdsPtr\fR) -.sp -char * -\fBckalloc\fR(\fIsize\fR) -.sp -void -\fBckfree\fR(\fIptr\fR) -.sp -char * -\fBckrealloc\fR(\fIptr, size\fR) -.sp -char * -\fBattemptckalloc\fR(\fIsize\fR) -.sp -char * -\fBattemptckrealloc\fR(\fIptr, size\fR) .SH ARGUMENTS .AS char *size .AP "unsigned int" size in @@ -84,18 +69,17 @@ allocation fails, these functions will return NULL. Note that on some platforms, but not all, attempting to allocate a zero-sized block of memory will also cause these functions to return NULL. .PP -The procedures \fBckalloc\fR, \fBckfree\fR, \fBckrealloc\fR, -\fBattemptckalloc\fR, and \fBattemptckrealloc\fR are implemented -as macros. Normally, they are synonyms for the corresponding -procedures documented on this page. When Tcl and all modules -calling Tcl are compiled with \fBTCL_MEM_DEBUG\fR defined, however, -these macros are redefined to be special debugging versions -of these procedures. To support Tcl's memory debugging within a -module, use the macros rather than direct calls to \fBTcl_Alloc\fR, etc. +When a module or Tcl itself is compiled with \fBTCL_MEM_DEBUG\fR defined, +the procedures \fBTcl_Alloc\fR, \fBTcl_Free\fR, \fBTcl_Realloc\fR, +\fBTcl_AttemptAlloc\fR, and \fBTcl_AttempRealloc\fR are implemented +as macros, redefined to be special debugging versions of these procedures. \fBTcl_GetMemoryInfo\fR appends a list-of-lists of memory stats to the provided DString. This function cannot be used in stub-enabled extensions, -and it is only available if Tcl is compiled with the threaded memory allocator. +and it is only available if Tcl is compiled with the threaded memory allocator +When used in stub-enabled embedders, the stubs table must be first initialized +using one of \fBTcl_InitSubsystems\fR, \fBTcl_SetPanicProc\fR, +\fBTcl_FindExecutable\fR or \fBTclZipfs_AppHook\fR. .SH KEYWORDS alloc, allocation, free, malloc, memory, realloc, TCL_MEM_DEBUG diff --git a/doc/AllowExc.3 b/doc/AllowExc.3 index 172bb30..29e31be 100644 --- a/doc/AllowExc.3 +++ b/doc/AllowExc.3 @@ -30,8 +30,7 @@ or \fBTCL_RETURN\fR, then Tcl normally converts this into a \fBTCL_ERROR\fR return with an appropriate message. The particular script evaluation procedures of Tcl that act in the manner are \fBTcl_EvalObjEx\fR, \fBTcl_EvalObjv\fR, \fBTcl_Eval\fR, \fBTcl_EvalEx\fR, -\fBTcl_GlobalEval\fR, \fBTcl_GlobalEvalObj\fR, \fBTcl_VarEval\fR and -\fBTcl_VarEvalVA\fR. +\fBTcl_GlobalEval\fR, \fBTcl_GlobalEvalObj\fR and \fBTcl_VarEval\fR. .PP However, if \fBTcl_AllowExceptions\fR is invoked immediately before calling one of those a procedures, then arbitrary completion diff --git a/doc/AssocData.3 b/doc/AssocData.3 index d4fa3d7..e95c26b 100644 --- a/doc/AssocData.3 +++ b/doc/AssocData.3 @@ -13,7 +13,7 @@ Tcl_GetAssocData, Tcl_SetAssocData, Tcl_DeleteAssocData \- manage associations o .nf \fB#include <tcl.h>\fR .sp -ClientData +void * \fBTcl_GetAssocData\fR(\fIinterp, key, delProcPtr\fR) .sp \fBTcl_SetAssocData\fR(\fIinterp, key, delProc, clientData\fR) @@ -31,7 +31,7 @@ Procedure to call when \fIinterp\fR is deleted. .AP Tcl_InterpDeleteProc **delProcPtr in Pointer to location in which to store address of current deletion procedure for association. Ignored if NULL. -.AP ClientData clientData in +.AP void *clientData in Arbitrary one-word value associated with the given key in this interpreter. This data is owned by the caller. .BE @@ -64,7 +64,7 @@ the type \fBTcl_InterpDeleteProc\fR: .PP .CS typedef void \fBTcl_InterpDeleteProc\fR( - ClientData \fIclientData\fR, + void *\fIclientData\fR, Tcl_Interp *\fIinterp\fR); .CE .PP diff --git a/doc/Async.3 b/doc/Async.3 index e6ec5f8..a8d7da0 100644 --- a/doc/Async.3 +++ b/doc/Async.3 @@ -35,7 +35,7 @@ int .AS Tcl_AsyncHandler clientData .AP Tcl_AsyncProc *proc in Procedure to invoke to handle an asynchronous event. -.AP ClientData clientData in +.AP void *clientData in One-word value to pass to \fIproc\fR. .AP Tcl_AsyncHandler async in Token for asynchronous event handler. @@ -95,7 +95,7 @@ type \fBTcl_AsyncProc\fR: .PP .CS typedef int \fBTcl_AsyncProc\fR( - ClientData \fIclientData\fR, + void *\fIclientData\fR, Tcl_Interp *\fIinterp\fR, int \fIcode\fR); .CE diff --git a/doc/Backslash.3 b/doc/Backslash.3 deleted file mode 100644 index 1a807f6..0000000 --- a/doc/Backslash.3 +++ /dev/null @@ -1,47 +0,0 @@ -'\" -'\" Copyright (c) 1989-1993 The Regents of the University of California. -'\" Copyright (c) 1994-1996 Sun Microsystems, Inc. -'\" -'\" See the file "license.terms" for information on usage and redistribution -'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" -.TH Tcl_Backslash 3 "8.1" Tcl "Tcl Library Procedures" -.so man.macros -.BS -.SH NAME -Tcl_Backslash \- parse a backslash sequence -.SH SYNOPSIS -.nf -\fB#include <tcl.h>\fR -.sp -char -\fBTcl_Backslash\fR(\fIsrc, countPtr\fR) -.SH ARGUMENTS -.AS char *countPtr out -.AP "const char" *src in -Pointer to a string starting with a backslash. -.AP int *countPtr out -If \fIcountPtr\fR is not NULL, \fI*countPtr\fR gets filled -in with number of characters in the backslash sequence, including -the backslash character. -.BE - -.SH DESCRIPTION -.PP -The use of \fBTcl_Backslash\fR is deprecated in favor of -\fBTcl_UtfBackslash\fR. -.PP -This is a utility procedure provided for backwards compatibility with -non-internationalized Tcl extensions. It parses a backslash sequence and -returns the low byte of the Unicode character corresponding to the sequence. -\fBTcl_Backslash\fR modifies \fI*countPtr\fR to contain the number of -characters in the backslash sequence. -.PP -See the Tcl manual entry for information on the valid backslash sequences. -All of the sequences described in the Tcl manual entry are supported by -\fBTcl_Backslash\fR. -.SH "SEE ALSO" -Tcl(n), Tcl_UtfBackslash(3) - -.SH KEYWORDS -backslash, parse diff --git a/doc/ByteArrObj.3 b/doc/ByteArrObj.3 index fd7f245..69f55d6 100644 --- a/doc/ByteArrObj.3 +++ b/doc/ByteArrObj.3 @@ -4,7 +4,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.TH Tcl_ByteArrayObj 3 8.1 Tcl "Tcl Library Procedures" +.TH Tcl_ByteArrayObj 3 9.0 Tcl "Tcl Library Procedures" .so man.macros .BS .SH NAME @@ -34,8 +34,8 @@ 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 int numBytes in -The number of bytes in the array. It must be >= 0. +.AP size_t 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 overwritten by a byte-array value. For \fBTcl_GetBytesFromObj\fR, @@ -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 "size_t \&| 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 @@ -92,11 +92,6 @@ returns a pointer to the created value with a reference count of zero. of the unshared \fIobjPtr\fR as appropriate, and keeps its reference count (0 or 1) unchanged. The value produced by these routines has no string representation. Any memory allocation failure may cause a panic. -Note that the type of the \fInumBytes\fR argument is \fBint\fR; consequently -the largest byte-array value that can be produced by these routines is one -holding \fBINT_MAX\fR bytes. Note also that the string representation of -any Tcl value is limited to \fBINT_MAX\fR bytes, so caution should be -taken with any byte-array of more than \fBINT_MAX / 2\fR bytes. .PP \fBTcl_GetBytesFromObj\fR performs the opposite function of \fBTcl_SetByteArrayObj\fR, providing access to read a byte-array from @@ -121,29 +116,14 @@ failure, nothing will be written to \fInumBytesPtr\fR, and if the \fIinterp\fR argument is non-NULL, then error messages and codes are left in it recording the error. .PP -\fBTcl_GetByteArrayFromObj\fR performs nearly the same function as -\fBTcl_GetBytesFromObj\fR. They differ only in the circumstance when -a byte-array internal value must be created by transformation of -a string representation, and that string representation contains a -character with codepoint greater than U+00FF. Instead of failing -the conversion, \fBTcl_GetByteArrayFromObj\fR will use the 8 least -significant bits of each codepoint to produce a valid byte value -from any character codepoint value. In any other circumstance, -\fBTcl_GetByteArrayFromObj\fR performs just as \fBTcl_GetBytesFromObj\fR -does. Since the conversion cannot fail, \fBTcl_GetByteArrayFromObj\fR -has no need for an \fIinterp\fR argument to record any errors and -the caller can assume \fBTcl_GetByteArrayFromObj\fR does not return NULL. +\fBTcl_GetByteArrayFromObj\fR performs exactly the same function as +\fBTcl_GetBytesFromObj\fR does when called with the \fIinterp\fR +argument passed the value NULL. This is incompatible with the +way \fBTcl_GetByteArrayFromObj\fR functioned in Tcl 8. +\fBTcl_GetBytesFromObj\fR is the more capable interface and should +usually be favored for use over \fBTcl_GetByteArrayFromObj\fR. .PP -\fBTcl_GetByteArrayFromObj\fR must be used with caution. Because of the -truncation on conversion, the byte-array made available to the caller -cannot reliably complete a round-trip back to the original string -representation. This creates opportunities for bugs due to blindness -to differences in values. This routine exists in this form primarily -for compatibility with codebases written for earlier releases of Tcl. -It is expected this routine will incompatibly change in Tcl 9 so that -it also signals failed conversions with a NULL return. -.PP -On success, both \fBTcl_GetBytesFromObj\fR and \fBTcl_GetByteArrayFromObj\fR +On success, both \fBTcl_GetByteFromObj\fR and \fBTcl_GetByteArrayFromObj\fR return a pointer into the internal representation of a \fBTcl_Obj\fR. That pointer must not be freed by the caller, and should not be retained for use beyond the known time the internal representation of the value @@ -154,10 +134,14 @@ 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. In Tcl 8, the largest number of -bytes possible is \fBINT_MAX\fR, so either type can receive the value. -In codebases meant to migrate to Tcl 9, the option to write to a space -of type \fBsize_t\fR may aid in the migration. +\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 +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. +The ability to provide an \fBint\fR space is best considered a migration +aid for codebases constrained to continue operating with Tcl releases +older than 8.7. .PP \fBTcl_SetByteArrayLength\fR enables a caller to change the size of a byte-array in the internal representation of an unshared \fIobjPtr\fR to @@ -170,8 +154,9 @@ changes the internal representation, \fBTcl_SetByteArrayLength\fR also invalidates any string representation in \fIobjPtr\fR. If resizing grows the byte-array, the new byte values are undefined. If \fIobjPtr\fR does not already possess an internal byte-array, one is produced in the -same way that \fBTcl_GetByteArrayFromObj\fR does, with all the cautions -that go along with that. +same way that \fBTcl_GetBytesFromObj\fR does, also returning NULL +when any characters of the value in \fIobjPtr\fR (up to +\fInumBytes\fR of them) are not valid bytes. .SH "REFERENCE COUNT MANAGEMENT" .PP \fBTcl_NewByteArrayObj\fR always returns a zero-reference object, much diff --git a/doc/CallDel.3 b/doc/CallDel.3 index 33b8afc..00763b6 100644 --- a/doc/CallDel.3 +++ b/doc/CallDel.3 @@ -23,7 +23,7 @@ Tcl_CallWhenDeleted, Tcl_DontCallWhenDeleted \- Arrange for callback when interp Interpreter with which to associated callback. .AP Tcl_InterpDeleteProc *proc in Procedure to call when \fIinterp\fR is deleted. -.AP ClientData clientData in +.AP void *clientData in Arbitrary one-word value to pass to \fIproc\fR. .BE .SH DESCRIPTION @@ -38,7 +38,7 @@ type \fBTcl_InterpDeleteProc\fR: .PP .CS typedef void \fBTcl_InterpDeleteProc\fR( - ClientData \fIclientData\fR, + void *\fIclientData\fR, Tcl_Interp *\fIinterp\fR); .CE .PP diff --git a/doc/Cancel.3 b/doc/Cancel.3 index 73edaf6..4f727b3 100644 --- a/doc/Cancel.3 +++ b/doc/Cancel.3 @@ -30,7 +30,7 @@ ORed 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. -.AP ClientData clientData in +.AP void *clientData in Currently reserved for future use. It should be set to NULL. .BE diff --git a/doc/ChnlStack.3 b/doc/ChnlStack.3 index b046cd2..9233a88 100644 --- a/doc/ChnlStack.3 +++ b/doc/ChnlStack.3 @@ -32,7 +32,7 @@ Tcl_Channel Interpreter for error reporting. .AP "const Tcl_ChannelType" *typePtr in The new channel I/O procedures to use for \fIchannel\fR. -.AP ClientData clientData in +.AP void *clientData in Arbitrary one-word value to pass to channel I/O procedures. .AP int mask in Conditions under which \fIchannel\fR will be used: OR-ed combination of @@ -49,11 +49,8 @@ I/O channels. Examples include compression and encryption modules. These functions transparently stack and unstack a new channel on top of an existing one. Any number of channels can be stacked together. .PP -The implementation of the Tcl channel code was rewritten in 8.3.2 to -correct some problems with the previous implementation with regard to -stacked channels. Anyone using stacked channels or creating stacked -channel drivers should update to the new \fBTCL_CHANNEL_VERSION_2\fR -\fBTcl_ChannelType\fR structure. See \fBTcl_CreateChannel\fR for details. +The \fBTcl_ChannelType\fR version currently supported is +\fBTCL_CHANNEL_VERSION_5\fR. See \fBTcl_CreateChannel\fR for details. .PP \fBTcl_StackChannel\fR stacks a new \fIchannel\fR on an existing channel with the same name that was registered for \fIchannel\fR by diff --git a/doc/Class.3 b/doc/Class.3 index c89c5f4..c029595 100644 --- a/doc/Class.3 +++ b/doc/Class.3 @@ -41,12 +41,12 @@ Tcl_Object int \fBTcl_ObjectDeleted\fR(\fIobject\fR) .sp -ClientData +void * \fBTcl_ObjectGetMetadata\fR(\fIobject, metaTypePtr\fR) .sp \fBTcl_ObjectSetMetadata\fR(\fIobject, metaTypePtr, metadata\fR) .sp -ClientData +void * \fBTcl_ClassGetMetadata\fR(\fIclass, metaTypePtr\fR) .sp \fBTcl_ClassSetMetadata\fR(\fIclass, metaTypePtr, metadata\fR) @@ -64,7 +64,7 @@ Tcl_Obj * \fBTcl_GetObjectClassName\fR(\fIinterp\fR, \fIobject\fR) .VE "TIP 605" .SH ARGUMENTS -.AS ClientData metadata in/out +.AS void *metadata in/out .AP Tcl_Interp *interp in/out Interpreter providing the context for looking up or creating an object, and into whose result error messages will be written on failure. @@ -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 int objc in +.AP size_t 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 int skip in +.AP size_t 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 @@ -93,7 +93,7 @@ error messages even when complicated calling patterns are used (e.g., via the .AP Tcl_ObjectMetadataType *metaTypePtr in The type of \fImetadata\fR being set with \fBTcl_ClassSetMetadata\fR or retrieved with \fBTcl_ClassGetMetadata\fR. -.AP ClientData metadata in +.AP void *metadata in An item of metadata to attach to the class, or NULL to remove the metadata associated with a particular \fImetaTypePtr\fR. .AP "Tcl_ObjectMapMethodNameProc" "methodNameMapper" in @@ -200,7 +200,7 @@ a class or object. .PP .CS typedef void \fBTcl_ObjectMetadataDeleteProc\fR( - ClientData \fImetadata\fR); + void *\fImetadata\fR); .CE .PP The \fImetadata\fR argument gives the address of the metadata to be @@ -213,8 +213,8 @@ associated with a class or object. .CS typedef int \fBTcl_CloneProc\fR( Tcl_Interp *\fIinterp\fR, - ClientData \fIsrcMetadata\fR, - ClientData *\fIdstMetadataPtr\fR); + void *\fIsrcMetadata\fR, + void **\fIdstMetadataPtr\fR); .CE .PP The \fIinterp\fR argument gives a place to write an error message when the diff --git a/doc/Concat.3 b/doc/Concat.3 index e853fc3..10b4a10 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 int argc in +.AP size_t 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 77a3bc2..12494bf 100644 --- a/doc/CrtAlias.3 +++ b/doc/CrtAlias.3 @@ -8,7 +8,7 @@ .so man.macros .BS .SH NAME -Tcl_IsSafe, Tcl_MakeSafe, Tcl_CreateChild, Tcl_CreateSlave, Tcl_GetChild, Tcl_GetSlave, Tcl_GetParent, Tcl_GetMaster, Tcl_GetInterpPath, Tcl_CreateAlias, Tcl_CreateAliasObj, Tcl_GetAlias, Tcl_GetAliasObj, Tcl_ExposeCommand, Tcl_HideCommand \- manage multiple Tcl interpreters, aliases and hidden commands +Tcl_IsSafe, Tcl_CreateChild, Tcl_GetChild, Tcl_GetParent, Tcl_GetInterpPath, Tcl_CreateAlias, Tcl_CreateAliasObj, Tcl_GetAlias, Tcl_GetAliasObj, Tcl_ExposeCommand, Tcl_HideCommand \- manage multiple Tcl interpreters, aliases and hidden commands .SH SYNOPSIS .nf \fB#include <tcl.h>\fR @@ -16,25 +16,13 @@ Tcl_IsSafe, Tcl_MakeSafe, Tcl_CreateChild, Tcl_CreateSlave, Tcl_GetChild, Tcl_Ge int \fBTcl_IsSafe\fR(\fIinterp\fR) .sp -int -\fBTcl_MakeSafe\fR(\fIinterp\fR) -.sp Tcl_Interp * \fBTcl_CreateChild\fR(\fIinterp, name, isSafe\fR) .sp Tcl_Interp * -\fBTcl_CreateSlave\fR(\fIinterp, name, isSafe\fR) -.sp -Tcl_Interp * -\fBTcl_GetSlave\fR(\fIinterp, name\fR) -.sp -Tcl_Interp * \fBTcl_GetChild\fR(\fIinterp, name\fR) .sp Tcl_Interp * -\fBTcl_GetMaster\fR(\fIinterp\fR) -.sp -Tcl_Interp * \fBTcl_GetParent\fR(\fIinterp\fR) .sp int @@ -81,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 int argc in +.AP size_t 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 int objc in +.AP size_t 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 @@ -142,38 +130,19 @@ child in which Tcl code has access only to set of Tcl commands defined as see the manual entry for the Tcl \fBinterp\fR command for details. If the creation of the new child interpreter failed, \fBNULL\fR is returned. .PP -\fBTcl_CreateSlave\fR is a synonym for \fBTcl_CreateChild\fR. -.PP \fBTcl_IsSafe\fR returns \fB1\fR if \fIinterp\fR is .QW safe (was created with the \fBTCL_SAFE_INTERPRETER\fR flag specified), \fB0\fR otherwise. .PP -\fBTcl_MakeSafe\fR marks \fIinterp\fR as -.QW safe , -so that future -calls to \fBTcl_IsSafe\fR will return 1. It also removes all known -potentially-unsafe core functionality (both commands and variables) -from \fIinterp\fR. However, it cannot know what parts of an extension -or application are safe and does not make any attempt to remove those -parts, so safety is not guaranteed after calling \fBTcl_MakeSafe\fR. -Callers will want to take care with their use of \fBTcl_MakeSafe\fR -to avoid false claims of safety. For many situations, \fBTcl_CreateChild\fR -may be a better choice, since it creates interpreters in a known-safe state. -\fBTcl_MakeSafe\fR is deprecated and will be removed in Tcl 9.0. -.PP \fBTcl_GetChild\fR returns a pointer to a child interpreter of \fIinterp\fR. The child interpreter is identified by \fIname\fR. If no such child interpreter exists, \fBNULL\fR is returned. .PP -\fBTcl_GetSlave\fR is a synonym for \fBTcl_GetChild\fR. -.PP \fBTcl_GetParent\fR returns a pointer to the parent interpreter of \fIinterp\fR. If \fIinterp\fR has no parent (it is a top-level interpreter) then \fBNULL\fR is returned. .PP -\fBTcl_GetMaster\fR is a synonym for \fBTcl_GetParent\fR. -.PP \fBTcl_GetInterpPath\fR stores in the result of \fIinterp\fR the relative path between \fIinterp\fR and \fIchildInterp\fR; \fIchildInterp\fR must be a child of \fIinterp\fR. If the computation diff --git a/doc/CrtChannel.3 b/doc/CrtChannel.3 index 1496631..f04fbff 100644 --- a/doc/CrtChannel.3 +++ b/doc/CrtChannel.3 @@ -9,7 +9,7 @@ .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME -Tcl_CreateChannel, Tcl_GetChannelInstanceData, Tcl_GetChannelType, Tcl_GetChannelName, Tcl_GetChannelHandle, Tcl_GetChannelMode, Tcl_GetChannelBufferSize, Tcl_SetChannelBufferSize, Tcl_NotifyChannel, Tcl_BadChannelOption, Tcl_ChannelName, Tcl_ChannelVersion, Tcl_ChannelBlockModeProc, Tcl_ChannelCloseProc, Tcl_ChannelClose2Proc, Tcl_ChannelInputProc, Tcl_ChannelOutputProc, Tcl_ChannelSeekProc, Tcl_ChannelWideSeekProc, Tcl_ChannelTruncateProc, Tcl_ChannelSetOptionProc, Tcl_ChannelGetOptionProc, Tcl_ChannelWatchProc, Tcl_ChannelGetHandleProc, Tcl_ChannelFlushProc, Tcl_ChannelHandlerProc, Tcl_ChannelThreadActionProc, Tcl_IsChannelShared, Tcl_IsChannelRegistered, Tcl_CutChannel, Tcl_SpliceChannel, Tcl_IsChannelExisting, Tcl_ClearChannelHandlers, Tcl_GetChannelThread, Tcl_ChannelBuffered \- procedures for creating and manipulating channels +Tcl_CreateChannel, Tcl_GetChannelInstanceData, Tcl_GetChannelType, Tcl_GetChannelName, Tcl_GetChannelHandle, Tcl_GetChannelMode, Tcl_GetChannelBufferSize, Tcl_SetChannelBufferSize, Tcl_NotifyChannel, Tcl_BadChannelOption, Tcl_ChannelName, Tcl_ChannelVersion, Tcl_ChannelBlockModeProc, Tcl_ChannelClose2Proc, Tcl_ChannelInputProc, Tcl_ChannelOutputProc, Tcl_ChannelWideSeekProc, Tcl_ChannelTruncateProc, Tcl_ChannelSetOptionProc, Tcl_ChannelGetOptionProc, Tcl_ChannelWatchProc, Tcl_ChannelGetHandleProc, Tcl_ChannelFlushProc, Tcl_ChannelHandlerProc, Tcl_ChannelThreadActionProc, Tcl_IsChannelShared, Tcl_IsChannelRegistered, Tcl_CutChannel, Tcl_SpliceChannel, Tcl_IsChannelExisting, Tcl_ClearChannelHandlers, Tcl_GetChannelThread, Tcl_ChannelBuffered \- procedures for creating and manipulating channels .SH SYNOPSIS .nf \fB#include <tcl.h>\fR @@ -17,7 +17,7 @@ Tcl_CreateChannel, Tcl_GetChannelInstanceData, Tcl_GetChannelType, Tcl_GetChanne Tcl_Channel \fBTcl_CreateChannel\fR(\fItypePtr, channelName, instanceData, mask\fR) .sp -ClientData +void * \fBTcl_GetChannelInstanceData\fR(\fIchannel\fR) .sp const Tcl_ChannelType * @@ -80,9 +80,6 @@ Tcl_ChannelTypeVersion Tcl_DriverBlockModeProc * \fBTcl_ChannelBlockModeProc\fR(\fItypePtr\fR) .sp -Tcl_DriverCloseProc * -\fBTcl_ChannelCloseProc\fR(\fItypePtr\fR) -.sp Tcl_DriverClose2Proc * \fBTcl_ChannelClose2Proc\fR(\fItypePtr\fR) .sp @@ -92,9 +89,6 @@ Tcl_DriverInputProc * Tcl_DriverOutputProc * \fBTcl_ChannelOutputProc\fR(\fItypePtr\fR) .sp -Tcl_DriverSeekProc * -\fBTcl_ChannelSeekProc\fR(\fItypePtr\fR) -.sp Tcl_DriverWideSeekProc * \fBTcl_ChannelWideSeekProc\fR(\fItypePtr\fR) .sp @@ -133,7 +127,7 @@ by any other channel. Can be NULL, in which case the channel is created without a name. If the created channel is assigned to one of the standard channels (\fBstdin\fR, \fBstdout\fR or \fBstderr\fR), the assigned channel name will be the name of the standard channel. -.AP ClientData instanceData in +.AP void *instanceData in Arbitrary one-word value to be associated with this channel. This value is passed to procedures in \fItypePtr\fR when they are invoked. .AP int mask in @@ -144,10 +138,10 @@ The channel to operate on. .AP int direction in \fBTCL_READABLE\fR means the input handle is wanted; \fBTCL_WRITABLE\fR means the output handle is wanted. -.AP ClientData *handlePtr out +.AP void **handlePtr out Points to the location where the desired OS-specific handle should be stored. -.AP int size in +.AP size_t 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 @@ -302,16 +296,13 @@ name is registered in the (thread)-global list of all channels (result (thread)global list of all channels (of the current thread). Application to a channel still registered in some interpreter is not allowed. -Also notifies the driver if the \fBTcl_ChannelType\fR version is -\fBTCL_CHANNEL_VERSION_4\fR (or higher), and +Also notifies the driver if \fBTcl_DriverThreadActionProc\fR is defined for it. .PP \fBTcl_SpliceChannel\fR adds the specified \fIchannel\fR to the (thread)global list of all channels (of the current thread). Application to a channel registered in some interpreter is not allowed. -Also notifies the driver if the \fBTcl_ChannelType\fR version is -\fBTCL_CHANNEL_VERSION_4\fR (or higher), and -\fBTcl_DriverThreadActionProc\fR is defined for it. +Also notifies the driver if \fBTcl_DriverThreadActionProc\fR is defined for it. .PP \fBTcl_ClearChannelHandlers\fR removes all channel handlers and event scripts associated with the specified \fIchannel\fR, thus shutting @@ -331,10 +322,10 @@ The \fBTcl_ChannelType\fR structure contains the following fields: typedef struct Tcl_ChannelType { const char *\fItypeName\fR; Tcl_ChannelTypeVersion \fIversion\fR; - Tcl_DriverCloseProc *\fIcloseProc\fR; + void *\fIcloseProc\fR; /* Not used any more*/ Tcl_DriverInputProc *\fIinputProc\fR; Tcl_DriverOutputProc *\fIoutputProc\fR; - Tcl_DriverSeekProc *\fIseekProc\fR; + void *\fIseekProc\fR; /* Not used any more */ Tcl_DriverSetOptionProc *\fIsetOptionProc\fR; Tcl_DriverGetOptionProc *\fIgetOptionProc\fR; Tcl_DriverWatchProc *\fIwatchProc\fR; @@ -363,9 +354,8 @@ The user should only use the above structure for \fBTcl_ChannelType\fR instantiation. When referencing fields in a \fBTcl_ChannelType\fR structure, the following functions should be used to obtain the values: \fBTcl_ChannelName\fR, \fBTcl_ChannelVersion\fR, -\fBTcl_ChannelBlockModeProc\fR, \fBTcl_ChannelCloseProc\fR, -\fBTcl_ChannelClose2Proc\fR, \fBTcl_ChannelInputProc\fR, -\fBTcl_ChannelOutputProc\fR, \fBTcl_ChannelSeekProc\fR, +\fBTcl_ChannelBlockModeProc\fR, \fBTcl_ChannelClose2Proc\fR, +\fBTcl_ChannelInputProc\fR, \fBTcl_ChannelOutputProc\fR, \fBTcl_ChannelWideSeekProc\fR, \fBTcl_ChannelThreadActionProc\fR, \fBTcl_ChannelTruncateProc\fR, \fBTcl_ChannelSetOptionProc\fR, \fBTcl_ChannelGetOptionProc\fR, @@ -388,25 +378,9 @@ a pointer to the string. .PP The \fIversion\fR field should be set to the version of the structure -that you require. \fBTCL_CHANNEL_VERSION_2\fR is the minimum recommended. -\fBTCL_CHANNEL_VERSION_3\fR must be set to specify the \fIwideSeekProc\fR member. -\fBTCL_CHANNEL_VERSION_4\fR must be set to specify the \fIthreadActionProc\fR member -(includes \fIwideSeekProc\fR). -\fBTCL_CHANNEL_VERSION_5\fR must be set to specify the -\fItruncateProc\fR members (includes -\fIwideSeekProc\fR and \fIthreadActionProc\fR). -If it is not set to any of these, then this -\fBTcl_ChannelType\fR is assumed to have the original structure. See -\fBOLD CHANNEL TYPES\fR for more details. While Tcl will recognize -and function with either structures, stacked channels must be of at -least \fBTCL_CHANNEL_VERSION_2\fR to function correctly. -.PP -This value can be retrieved with \fBTcl_ChannelVersion\fR, which returns -one of -\fBTCL_CHANNEL_VERSION_5\fR, -\fBTCL_CHANNEL_VERSION_4\fR, -\fBTCL_CHANNEL_VERSION_3\fR, -\fBTCL_CHANNEL_VERSION_2\fR or \fBTCL_CHANNEL_VERSION_1\fR. +that you require. \fBTCL_CHANNEL_VERSION_5\fR is the minimum supported. +.PP +This value can be retrieved with \fBTcl_ChannelVersion\fR. .SS BLOCKMODEPROC .PP The \fIblockModeProc\fR field contains the address of a function called by @@ -415,7 +389,7 @@ the generic layer to set blocking and nonblocking mode on the device. .PP .CS typedef int \fBTcl_DriverBlockModeProc\fR( - ClientData \fIinstanceData\fR, + void *\fIinstanceData\fR, int \fImode\fR); .CE .PP @@ -442,22 +416,23 @@ blocking mode is acceptable to it, and should this also document for the user so that the blocking mode of the channel is not changed to an unacceptable value. Any confusion here may lead the interpreter into a (spurious and difficult to find) deadlock. -.SS "CLOSEPROC AND CLOSE2PROC" +.SS "CLOSE2PROC" .PP -The \fIcloseProc\fR field contains the address of a function called by the +The \fIclose2Proc\fR field contains the address of a function called by the generic layer to clean up driver-related information when the channel is -closed. \fICloseProc\fR must match the following prototype: +closed. \fIClose2Proc\fR must match the following prototype: .PP .CS -typedef int \fBTcl_DriverCloseProc\fR( - ClientData \fIinstanceData\fR, - Tcl_Interp *\fIinterp\fR); +typedef int \fBTcl_DriverClose2Proc\fR( + void *\fIinstanceData\fR, + Tcl_Interp *\fIinterp\fR, + int \fIflags\fR); .CE .PP -The \fIinstanceData\fR argument is the same as the value provided to -\fBTcl_CreateChannel\fR when the channel was created. The function should -release any storage maintained by the channel driver for this channel, and -close the input and output devices encapsulated by this channel. All queued +If \fIflags\fR is 0, the \fIinstanceData\fR argument is the same as the value +provided to \fBTcl_CreateChannel\fR when the channel was created. The function +should release any storage maintained by the channel driver for this channel, +and close the input and output devices encapsulated by this channel. All queued output will have been flushed to the device before this function is called, and no further driver operations will be invoked on this instance after calling the \fIcloseProc\fR. If the close operation is successful, the @@ -466,35 +441,20 @@ error code. In addition, if an error occurs and \fIinterp\fR is not NULL, the procedure should store an error message in the interpreter's result. .PP Alternatively, channels that support closing the read and write sides -independently may set \fIcloseProc\fR to \fBTCL_CLOSE2PROC\fR and set -\fIclose2Proc\fR to the address of a function that matches the -following prototype: -.PP -.CS -typedef int \fBTcl_DriverClose2Proc\fR( - ClientData \fIinstanceData\fR, - Tcl_Interp *\fIinterp\fR, - int \fIflags\fR); -.CE -.PP -The \fIclose2Proc\fR will be called with \fIflags\fR set to an OR'ed +independently may accept other flag values than 0. +Then \fIclose2Proc\fR will be called with \fIflags\fR set to an OR'ed combination of \fBTCL_CLOSE_READ\fR or \fBTCL_CLOSE_WRITE\fR to indicate that the driver should close the read and/or write side of the channel. The channel driver may be invoked to perform additional operations on the channel after \fIclose2Proc\fR is -called to close one or both sides of the channel. If \fIflags\fR is -\fB0\fR (zero), the driver should close the channel in the manner -described above for \fIcloseProc\fR. No further operations will be -invoked on this instance after \fIclose2Proc\fR is called with all -flags cleared. In all cases, the \fIclose2Proc\fR function should -return zero if the close operation was successful; otherwise it should -return a nonzero POSIX error code. In addition, if an error occurs and -\fIinterp\fR is not NULL, the procedure should store an error message -in the interpreter's result. -.PP -The \fIcloseProc\fR and \fIclose2Proc\fR values can be retrieved with -\fBTcl_ChannelCloseProc\fR or \fBTcl_ChannelClose2Proc\fR, which -return a pointer to the respective function. +called to close one or both sides of the channel. In all cases, the +\fIclose2Proc\fR function should return zero if the close operation was +successful; otherwise it should return a nonzero POSIX error code. +In addition, if an error occurs and \fIinterp\fR is not NULL, the procedure +should store an error message in the interpreter's result. +.PP +The \fIclose2Proc\fR value can be retrieved with \fBTcl_ChannelClose2Proc\fR, +which returns a pointer to the function. .SS INPUTPROC .PP The \fIinputProc\fR field contains the address of a function called by the @@ -503,7 +463,7 @@ internal buffer. \fIInputProc\fR must match the following prototype: .PP .CS typedef int \fBTcl_DriverInputProc\fR( - ClientData \fIinstanceData\fR, + void *\fIinstanceData\fR, char *\fIbuf\fR, int \fIbufSize\fR, int *\fIerrorCodePtr\fR); @@ -547,7 +507,7 @@ generic layer to transfer data from an internal buffer to the output device. .PP .CS typedef int \fBTcl_DriverOutputProc\fR( - ClientData \fIinstanceData\fR, + void *\fIinstanceData\fR, const char *\fIbuf\fR, int \fItoWrite\fR, int *\fIerrorCodePtr\fR); @@ -577,17 +537,17 @@ without writing any data. .PP This value can be retrieved with \fBTcl_ChannelOutputProc\fR, which returns a pointer to the function. -.SS "SEEKPROC AND WIDESEEKPROC" +.SS "WIDESEEKPROC" .PP -The \fIseekProc\fR field contains the address of a function called by the +The \fIwideSeekProc\fR field contains the address of a function called by the generic layer to move the access point at which subsequent input or output -operations will be applied. \fISeekProc\fR must match the following +operations will be applied. \fIWideSeekProc\fR must match the following prototype: .PP .CS -typedef int \fBTcl_DriverSeekProc\fR( - ClientData \fIinstanceData\fR, - long \fIoffset\fR, +typedef long long \fBTcl_DriverWideSeekProc\fR( + void *\fIinstanceData\fR, + long long \fIoffset\fR, int \fIseekMode\fR, int *\fIerrorCodePtr\fR); .CE @@ -606,30 +566,8 @@ does not implement seeking. The return value is the new access point or -1 in case of error. If an error occurred, the function should not move the access point. .PP -If there is a non-NULL \fIseekProc\fR field, the \fIwideSeekProc\fR -field may contain the address of an alternative function to use which -handles wide (i.e. larger than 32-bit) offsets, so allowing seeks -within files larger than 2GB. The \fIwideSeekProc\fR will be called -in preference to the \fIseekProc\fR, but both must be defined if the -\fIwideSeekProc\fR is defined. \fIWideSeekProc\fR must match the -following prototype: -.PP -.CS -typedef long long \fBTcl_DriverWideSeekProc\fR( - ClientData \fIinstanceData\fR, - long long \fIoffset\fR, - int \fIseekMode\fR, - int *\fIerrorCodePtr\fR); -.CE -.PP -The arguments and return values mean the same thing as with -\fIseekProc\fR above, except that the type of offsets and the return -type are different. -.PP -The \fIseekProc\fR value can be retrieved with -\fBTcl_ChannelSeekProc\fR, which returns a pointer to the function, -and similarly the \fIwideSeekProc\fR can be retrieved with -\fBTcl_ChannelWideSeekProc\fR. +The \fIwideSseekProc\fR value can be retrieved with +\fBTcl_ChannelWideSeekProc\fR, which returns a pointer to the function. .SS SETOPTIONPROC .PP The \fIsetOptionProc\fR field contains the address of a function called by @@ -638,7 +576,7 @@ the generic layer to set a channel type specific option on a channel. .PP .CS typedef int \fBTcl_DriverSetOptionProc\fR( - ClientData \fIinstanceData\fR, + void *\fIinstanceData\fR, Tcl_Interp *\fIinterp\fR, const char *\fIoptionName\fR, const char *\fInewValue\fR); @@ -679,7 +617,7 @@ channel. \fIgetOptionProc\fR must match the following prototype: .PP .CS typedef int \fBTcl_DriverGetOptionProc\fR( - ClientData \fIinstanceData\fR, + void *\fIinstanceData\fR, Tcl_Interp *\fIinterp\fR, const char *\fIoptionName\fR, Tcl_DString *\fIoptionValue\fR); @@ -717,7 +655,7 @@ notice events of interest on this channel. .PP .CS typedef void \fBTcl_DriverWatchProc\fR( - ClientData \fIinstanceData\fR, + void *\fIinstanceData\fR, int \fImask\fR); .CE .PP @@ -748,9 +686,9 @@ the generic layer to retrieve a device-specific handle from the channel. .PP .CS typedef int \fBTcl_DriverGetHandleProc\fR( - ClientData \fIinstanceData\fR, + void *\fIinstanceData\fR, int \fIdirection\fR, - ClientData *\fIhandlePtr\fR); + void **\fIhandlePtr\fR); .CE .PP \fIInstanceData\fR is the same as the value passed to @@ -777,7 +715,7 @@ It should be set to NULL. .PP .CS typedef int \fBTcl_DriverFlushProc\fR( - ClientData \fIinstanceData\fR); + void *\fIinstanceData\fR); .CE .PP This value can be retrieved with \fBTcl_ChannelFlushProc\fR, which returns @@ -792,7 +730,7 @@ that occur on the underlying (stacked) channel. .PP .CS typedef int \fBTcl_DriverHandlerProc\fR( - ClientData \fIinstanceData\fR, + void *\fIinstanceData\fR, int \fIinterestMask\fR); .CE .PP @@ -821,7 +759,7 @@ might be maintaining using the calling thread as the associate. See .PP .CS typedef void \fBTcl_DriverThreadActionProc\fR( - ClientData \fIinstanceData\fR, + void *\fIinstanceData\fR, int \fIaction\fR); .CE .PP @@ -838,7 +776,7 @@ length. It can be NULL. .PP .CS typedef int \fBTcl_DriverTruncateProc\fR( - ClientData \fIinstanceData\fR, + void *\fIinstanceData\fR, long long \fIlength\fR); .CE .PP @@ -886,58 +824,6 @@ The function takes good care of inserting minus signs before each option, commas after, and an .QW or before the last option. -.SH "OLD CHANNEL TYPES" -The original (8.3.1 and below) \fBTcl_ChannelType\fR structure contains -the following fields: -.PP -.CS -typedef struct Tcl_ChannelType { - const char *\fItypeName\fR; - Tcl_DriverBlockModeProc *\fIblockModeProc\fR; - Tcl_DriverCloseProc *\fIcloseProc\fR; - Tcl_DriverInputProc *\fIinputProc\fR; - Tcl_DriverOutputProc *\fIoutputProc\fR; - Tcl_DriverSeekProc *\fIseekProc\fR; - Tcl_DriverSetOptionProc *\fIsetOptionProc\fR; - Tcl_DriverGetOptionProc *\fIgetOptionProc\fR; - Tcl_DriverWatchProc *\fIwatchProc\fR; - Tcl_DriverGetHandleProc *\fIgetHandleProc\fR; - Tcl_DriverClose2Proc *\fIclose2Proc\fR; -} \fBTcl_ChannelType\fR; -.CE -.PP -It is still possible to create channel with the above structure. The -internal channel code will determine the version. It is imperative to use -the new \fBTcl_ChannelType\fR structure if you are creating a stacked -channel driver, due to problems with the earlier stacked channel -implementation (in 8.2.0 to 8.3.1). -.PP -Prior to 8.4.0 (i.e. during the later releases of 8.3 and early part -of the 8.4 development cycle) the \fBTcl_ChannelType\fR structure -contained the following fields: -.PP -.CS -typedef struct Tcl_ChannelType { - const char *\fItypeName\fR; - Tcl_ChannelTypeVersion \fIversion\fR; - Tcl_DriverCloseProc *\fIcloseProc\fR; - Tcl_DriverInputProc *\fIinputProc\fR; - Tcl_DriverOutputProc *\fIoutputProc\fR; - Tcl_DriverSeekProc *\fIseekProc\fR; - Tcl_DriverSetOptionProc *\fIsetOptionProc\fR; - Tcl_DriverGetOptionProc *\fIgetOptionProc\fR; - Tcl_DriverWatchProc *\fIwatchProc\fR; - Tcl_DriverGetHandleProc *\fIgetHandleProc\fR; - Tcl_DriverClose2Proc *\fIclose2Proc\fR; - Tcl_DriverBlockModeProc *\fIblockModeProc\fR; - Tcl_DriverFlushProc *\fIflushProc\fR; - Tcl_DriverHandlerProc *\fIhandlerProc\fR; - Tcl_DriverTruncateProc *\fItruncateProc\fR; -} \fBTcl_ChannelType\fR; -.CE -.PP -When the above structure is registered as a channel type, the -\fIversion\fR field should always be \fBTCL_CHANNEL_VERSION_2\fR. .SH "SEE ALSO" Tcl_Close(3), Tcl_OpenFileChannel(3), Tcl_SetErrno(3), Tcl_QueueEvent(3), Tcl_StackChannel(3), Tcl_GetStdChannel(3) .SH KEYWORDS diff --git a/doc/CrtChnlHdlr.3 b/doc/CrtChnlHdlr.3 index 0ecd3c9..ee8b411 100644 --- a/doc/CrtChnlHdlr.3 +++ b/doc/CrtChnlHdlr.3 @@ -29,10 +29,10 @@ Tcl channel such as returned by \fBTcl_CreateChannel\fR. Conditions under which \fIproc\fR should be called: OR-ed combination of \fBTCL_READABLE\fR, \fBTCL_WRITABLE\fR and \fBTCL_EXCEPTION\fR. Specify a zero value to temporarily disable an existing handler. -.AP Tcl_FileProc *proc in +.AP Tcl_ChannelProc *proc in Procedure to invoke whenever the channel indicated by \fIchannel\fR meets the conditions specified by \fImask\fR. -.AP ClientData clientData in +.AP void *clientData in Arbitrary one-word value to pass to \fIproc\fR. .BE .SH DESCRIPTION @@ -48,7 +48,7 @@ what it means for a channel to be readable or writable. .PP .CS typedef void \fBTcl_ChannelProc\fR( - ClientData \fIclientData\fR, + void *\fIclientData\fR, int \fImask\fR); .CE .PP diff --git a/doc/CrtCloseHdlr.3 b/doc/CrtCloseHdlr.3 index bac2431..1046ea3 100644 --- a/doc/CrtCloseHdlr.3 +++ b/doc/CrtCloseHdlr.3 @@ -26,7 +26,7 @@ void The channel for which to create or delete a close callback. .AP Tcl_CloseProc *proc in The procedure to call as the callback. -.AP ClientData clientData in +.AP void *clientData in Arbitrary one-word value to pass to \fIproc\fR. .BE .SH DESCRIPTION @@ -38,7 +38,7 @@ Arbitrary one-word value to pass to \fIproc\fR. .PP .CS typedef void \fBTcl_CloseProc\fR( - ClientData \fIclientData\fR); + void *\fIclientData\fR); .CE .PP The \fIclientData\fR is the same as the value provided in the call to diff --git a/doc/CrtCommand.3 b/doc/CrtCommand.3 index bf76d48..50baa6f 100644 --- a/doc/CrtCommand.3 +++ b/doc/CrtCommand.3 @@ -25,7 +25,7 @@ Name of command. .AP Tcl_CmdProc *proc in Implementation of new command: \fIproc\fR will be called whenever \fIcmdName\fR is invoked as a command. -.AP ClientData clientData in +.AP voie *clientData in Arbitrary one-word value to pass to \fIproc\fR and \fIdeleteProc\fR. .AP Tcl_CmdDeleteProc *deleteProc in Procedure to call before \fIcmdName\fR is deleted from the interpreter; @@ -75,7 +75,7 @@ and it returns NULL. .PP .CS typedef int \fBTcl_CmdProc\fR( - ClientData \fIclientData\fR, + void *\fIclientData\fR, Tcl_Interp *\fIinterp\fR, int \fIargc\fR, const char *\fIargv\fR[]); @@ -131,7 +131,7 @@ result that match the type \fBTcl_CmdDeleteProc\fR: .PP .CS typedef void \fBTcl_CmdDeleteProc\fR( - ClientData \fIclientData\fR); + void *\fIclientData\fR); .CE .PP The \fIclientData\fR argument will be the same as the \fIclientData\fR diff --git a/doc/CrtFileHdlr.3 b/doc/CrtFileHdlr.3 index f1b8df7..0dfb429 100644 --- a/doc/CrtFileHdlr.3 +++ b/doc/CrtFileHdlr.3 @@ -29,7 +29,7 @@ a handler. .AP Tcl_FileProc *proc in Procedure to invoke whenever the file or device indicated by \fIfile\fR meets the conditions specified by \fImask\fR. -.AP ClientData clientData in +.AP void *clientData in Arbitrary one-word value to pass to \fIproc\fR. .BE .SH DESCRIPTION @@ -51,7 +51,7 @@ type \fBTcl_FileProc\fR: .PP .CS typedef void \fBTcl_FileProc\fR( - ClientData \fIclientData\fR, + void *\fIclientData\fR, int \fImask\fR); .CE .PP diff --git a/doc/CrtMathFnc.3 b/doc/CrtMathFnc.3 deleted file mode 100644 index bb96fc9..0000000 --- a/doc/CrtMathFnc.3 +++ /dev/null @@ -1,166 +0,0 @@ -'\" -'\" Copyright (c) 1989-1993 The Regents of the University of California. -'\" Copyright (c) 1994-1996 Sun Microsystems, Inc. -'\" -'\" See the file "license.terms" for information on usage and redistribution -'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" -.TH Tcl_CreateMathFunc 3 8.4 Tcl "Tcl Library Procedures" -.so man.macros -.BS -.SH NAME -Tcl_CreateMathFunc, Tcl_GetMathFuncInfo, Tcl_ListMathFuncs \- Define, query and enumerate math functions for expressions -.SH "NOTICE OF EVENTUAL DEPRECATION" -.PP -The \fBTcl_CreateMathFunc\fR and \fBTcl_GetMathFuncInfo\fR functions -are rendered somewhat obsolete by the ability to create functions for -expressions by placing commands in the \fBtcl::mathfunc\fR namespace, -as described in the \fBmathfunc\fR manual page; the API described on -this page is not expected to be maintained indefinitely. -.SH SYNOPSIS -.nf -\fB#include <tcl.h>\fR -.sp -void -\fBTcl_CreateMathFunc\fR(\fIinterp, name, numArgs, argTypes, proc, clientData\fR) -.sp -int -\fBTcl_GetMathFuncInfo\fR(\fIinterp, name, numArgsPtr, argTypesPtr, procPtr, - clientDataPtr\fR) -.sp -Tcl_Obj * -\fBTcl_ListMathFuncs\fR(\fIinterp, pattern\fR) -.SH ARGUMENTS -.AS Tcl_ValueType *clientDataPtr out -.AP Tcl_Interp *interp in -Interpreter in which new function will be defined. -.AP "const char" *name in -Name for new function. -.AP int numArgs in -Number of arguments to new function; also gives size of \fIargTypes\fR array. -.AP Tcl_ValueType *argTypes in -Points to an array giving the permissible types for each argument to -function. -.AP Tcl_MathProc *proc in -Procedure that implements the function. -.AP ClientData clientData in -Arbitrary one-word value to pass to \fIproc\fR when it is invoked. -.AP int *numArgsPtr out -Points to a variable that will be set to contain the number of -arguments to the function. -.AP Tcl_ValueType **argTypesPtr out -Points to a variable that will be set to contain a pointer to an array -giving the permissible types for each argument to the function which -will need to be freed up using \fITcl_Free\fR. -.AP Tcl_MathProc **procPtr out -Points to a variable that will be set to contain a pointer to the -implementation code for the function (or NULL if the function is -implemented directly in bytecode). -.AP ClientData *clientDataPtr out -Points to a variable that will be set to contain the clientData -argument passed to \fITcl_CreateMathFunc\fR when the function was -created if the function is not implemented directly in bytecode. -.AP "const char" *pattern in -Pattern to match against function names so as to filter them (by -passing to \fITcl_StringMatch\fR), or NULL to not apply any filter. -.BE -.SH DESCRIPTION -.PP -Tcl allows a number of mathematical functions to be used in -expressions, such as \fBsin\fR, \fBcos\fR, and \fBhypot\fR. -These functions are represented by commands in the namespace, -\fBtcl::mathfunc\fR. The \fBTcl_CreateMathFunc\fR function is -an obsolete way for applications to add additional functions -to those already provided by Tcl or to replace existing functions. -It should not be used by new applications, which should create -math functions using \fBTcl_CreateObjCommand\fR to create a command -in the \fBtcl::mathfunc\fR namespace. -.PP -In the \fBTcl_CreateMathFunc\fR interface, -\fIName\fR is the name of the function as it will appear in expressions. -If \fIname\fR does not already exist in the \fB::tcl::mathfunc\fR -namespace, then a new command is created in that namespace. -If \fIname\fR does exist, then the existing function is replaced. -\fINumArgs\fR and \fIargTypes\fR describe the arguments to the function. -Each entry in the \fIargTypes\fR array must be -one of \fBTCL_INT\fR, \fBTCL_DOUBLE\fR, \fBTCL_WIDE_INT\fR, -or \fBTCL_EITHER\fR to indicate whether the corresponding argument must be an -integer, a double-precision floating value, a wide (64-bit) integer, -or any, respectively. -.PP -Whenever the function is invoked in an expression Tcl will invoke -\fIproc\fR. \fIProc\fR should have arguments and result that match -the type \fBTcl_MathProc\fR: -.PP -.CS -typedef int \fBTcl_MathProc\fR( - ClientData \fIclientData\fR, - Tcl_Interp *\fIinterp\fR, - Tcl_Value *\fIargs\fR, - Tcl_Value *\fIresultPtr\fR); -.CE -.PP -When \fIproc\fR is invoked the \fIclientData\fR and \fIinterp\fR -arguments will be the same as those passed to \fBTcl_CreateMathFunc\fR. -\fIArgs\fR will point to an array of \fInumArgs\fR Tcl_Value structures, -which describe the actual arguments to the function: -.PP -.CS -typedef struct Tcl_Value { - Tcl_ValueType \fItype\fR; - long \fIintValue\fR; - double \fIdoubleValue\fR; - Tcl_WideInt \fIwideValue\fR; -} \fBTcl_Value\fR; -.CE -.PP -The \fItype\fR field indicates the type of the argument and is -one of \fBTCL_INT\fR, \fBTCL_DOUBLE\fR or \fBTCL_WIDE_INT\fR. -It will match the \fIargTypes\fR value specified for the function unless -the \fIargTypes\fR value was \fBTCL_EITHER\fR. Tcl converts -the argument supplied in the expression to the type requested in -\fIargTypes\fR, if that is necessary. -Depending on the value of the \fItype\fR field, the \fIintValue\fR, -\fIdoubleValue\fR or \fIwideValue\fR -field will contain the actual value of the argument. -.PP -\fIProc\fR should compute its result and store it either as an integer -in \fIresultPtr->intValue\fR or as a floating value in -\fIresultPtr->doubleValue\fR. -It should set also \fIresultPtr->type\fR to one of -\fBTCL_INT\fR, \fBTCL_DOUBLE\fR or \fBTCL_WIDE_INT\fR -to indicate which value was set. -Under normal circumstances \fIproc\fR should return \fBTCL_OK\fR. -If an error occurs while executing the function, \fIproc\fR should -return \fBTCL_ERROR\fR and leave an error message in the interpreter's result. -.PP -\fBTcl_GetMathFuncInfo\fR retrieves the values associated with -function \fIname\fR that were passed to a preceding -\fBTcl_CreateMathFunc\fR call. Normally, the return code is -\fBTCL_OK\fR but if the named function does not exist, \fBTCL_ERROR\fR -is returned and an error message is placed in the interpreter's -result. -.PP -If an error did not occur, the array reference placed in the variable -pointed to by \fIargTypesPtr\fR is newly allocated, and should be -released by passing it to \fBTcl_Free\fR. Some functions (the -standard set implemented in the core, and those defined by placing -commands in the \fBtcl::mathfunc\fR namespace) do not have -argument type information; attempting to retrieve values for -them causes a NULL to be stored in the variable pointed to by -\fIprocPtr\fR and the variable pointed to by \fIclientDataPtr\fR -will not be modified. The variable pointed to by \fInumArgsPointer\fR -will contain -1, and no argument types will be stored in the variable -pointed to by \fIargTypesPointer\fR. -.PP -\fBTcl_ListMathFuncs\fR returns a Tcl value containing a list of all -the math functions defined in the interpreter whose name matches -\fIpattern\fR. The returned value has a reference count of zero. -.SH "REFERENCE COUNT MANAGEMENT" -.PP -\fBTcl_ListMathFuncs\fR always returns a zero-reference object, much -like \fBTcl_NewObj\fR. -.SH "SEE ALSO" -expr(n), info(n), Tcl_CreateObjCommand(3), Tcl_Free(3), Tcl_NewListObj(3) -.SH KEYWORDS -expression, mathematical function diff --git a/doc/CrtObjCmd.3 b/doc/CrtObjCmd.3 index 0490bd7..ffd9e27 100644 --- a/doc/CrtObjCmd.3 +++ b/doc/CrtObjCmd.3 @@ -58,7 +58,7 @@ Implementation of the new command: \fIproc\fR will be called whenever .AP Tcl_ObjCmdProc2 *proc2 in Implementation of the new command: \fIproc2\fR will be called whenever \fIcmdName\fR is invoked as a command. -.AP ClientData clientData in +.AP void *clientData in Arbitrary one-word value to pass to \fIproc\fR and \fIdeleteProc\fR. .AP Tcl_CmdDeleteProc *deleteProc in Procedure to call before \fIcmdName\fR is deleted from the interpreter; @@ -101,7 +101,7 @@ and it returns NULL. .PP .CS typedef int \fBTcl_ObjCmdProc\fR( - ClientData \fIclientData\fR, + void *\fIclientData\fR, Tcl_Interp *\fIinterp\fR, int \fIobjc\fR, Tcl_Obj *const \fIobjv\fR[]); @@ -174,7 +174,7 @@ result that match the type \fBTcl_CmdDeleteProc\fR: .PP .CS typedef void \fBTcl_CmdDeleteProc\fR( - ClientData \fIclientData\fR); + void *\fIclientData\fR); .CE .PP The \fIclientData\fR argument will be the same as the \fIclientData\fR @@ -185,7 +185,7 @@ except its \fIproc2\fR argument is of type \fBTcl_ObjCmdProc2\fR. .PP .CS typedef int \fBTcl_ObjCmdProc2\fR( - ClientData \fIclientData\fR, + void *\fIclientData\fR, Tcl_Interp *\fIinterp\fR, size_t \fIobjc\fR, Tcl_Obj *const \fIobjv\fR[]); @@ -224,24 +224,29 @@ pointed to by \fIinfoPtr\fR and returns 1. A \fBTcl_CmdInfo\fR structure has the following fields: .PP .CS -typedef struct Tcl_CmdInfo { +typedef struct { int \fIisNativeObjectProc\fR; Tcl_ObjCmdProc *\fIobjProc\fR; - ClientData \fIobjClientData\fR; + void *\fIobjClientData\fR; Tcl_CmdProc *\fIproc\fR; - ClientData \fIclientData\fR; + void *\fIclientData\fR; Tcl_CmdDeleteProc *\fIdeleteProc\fR; - ClientData \fIdeleteData\fR; + void *\fIdeleteData\fR; Tcl_Namespace *\fInamespacePtr\fR; + Tcl_ObjCmdProc2 *\fIobjProc2\fR; + void *\fIobjClientData2\fR; } \fBTcl_CmdInfo\fR; .CE .PP -The \fIisNativeObjectProc\fR field has the value 1 -if \fBTcl_CreateObjCommand\fR was called to register the command; -it is 0 if only \fBTcl_CreateCommand\fR was called. +The \fIisNativeObjectProc\fR field has the value 2 if +\fBTcl_CreateObjCommand2\fR was called to register the command; +it has the value 1 if \fBTcl_CreateObjCommand\fR was called to +register the command; it is 0 if only \fBTcl_CreateCommand\fR was called. It allows a program to determine whether it is faster to -call \fIobjProc\fR or \fIproc\fR: -\fIobjProc\fR is normally faster +call \fIobjProc2\fR, \fIobjProc\fR or \fIproc\fR: +\fIobjProc2\fR/\fIobjProc\fR is normally faster +if \fIisNativeObjectProc\fR has the value 2; +\fIobjProc\fR/\fIobjProc\fR is normally faster if \fIisNativeObjectProc\fR has the value 1. The fields \fIobjProc\fR and \fIobjClientData\fR have the same meaning as the \fIproc\fR and \fIclientData\fR @@ -257,7 +262,7 @@ otherwise, this is a compatibility procedure registered by \fBTcl_CreateObjCommand\fR that simply calls the command's value-based procedure after converting its string arguments to Tcl values. -The field \fIdeleteData\fR is the ClientData value +The field \fIdeleteData\fR is the clientData value to pass to \fIdeleteProc\fR; it is normally the same as \fIclientData\fR but may be set independently using the \fBTcl_SetCommandInfo\fR procedure. @@ -271,7 +276,7 @@ from \fBTcl_CreateObjCommand\fR in place of the command name. If the and fills in the structure designated by \fIinfoPtr\fR. .PP \fBTcl_SetCommandInfo\fR is used to modify the procedures and -ClientData values associated with a command. +clientData values associated with a command. Its \fIcmdName\fR argument is the name of a command in \fIinterp\fR. \fIcmdName\fR may include \fB::\fR namespace qualifiers to identify a command in a particular namespace. @@ -287,9 +292,9 @@ copies the information from \fI*infoPtr\fR to Tcl's internal structure for the command and returns 1. .PP Note that \fBTcl_SetCommandInfo\fR and -\fBTcl_SetCommandInfoFromToken\fR both allow the ClientData for a +\fBTcl_SetCommandInfoFromToken\fR both allow the clientData for a command's deletion procedure to be given a different value than the -ClientData for its command procedure. +clientData for its command procedure. .PP Note that neither \fBTcl_SetCommandInfo\fR nor \fBTcl_SetCommandInfoFromToken\fR will change a command's namespace. diff --git a/doc/CrtTimerHdlr.3 b/doc/CrtTimerHdlr.3 index c229a23..1190417 100644 --- a/doc/CrtTimerHdlr.3 +++ b/doc/CrtTimerHdlr.3 @@ -24,7 +24,7 @@ Tcl_TimerToken How many milliseconds to wait before invoking \fIproc\fR. .AP Tcl_TimerProc *proc in Procedure to invoke after \fImilliseconds\fR have elapsed. -.AP ClientData clientData in +.AP void *clientData in Arbitrary one-word value to pass to \fIproc\fR. .AP Tcl_TimerToken token in Token for previously created timer handler (the return value @@ -51,7 +51,7 @@ the type \fBTcl_TimerProc\fR: .PP .CS typedef void \fBTcl_TimerProc\fR( - ClientData \fIclientData\fR); + void *\fIclientData\fR); .CE .PP The \fIclientData\fR parameter to \fIproc\fR is a diff --git a/doc/CrtTrace.3 b/doc/CrtTrace.3 index 723a392..e4d1a43 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 int level in +.AP size_t 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 @@ -97,7 +97,7 @@ typedef int \fBTcl_CmdObjTraceProc2\fR( .PP The \fIclientData\fR and \fIinterp\fR parameters are copies of the corresponding arguments given to \fBTcl_CreateTrace\fR. -\fIClientData\fR typically points to an application-specific data +\fIclientData\fR typically points to an application-specific data structure that describes what to do when \fIobjProc\fR is invoked. The \fIlevel\fR parameter gives the nesting level of the command (1 for top-level commands passed to \fBTcl_Eval\fR by the application, 2 for diff --git a/doc/DString.3 b/doc/DString.3 index 66323a7..5c4d8f4 100644 --- a/doc/DString.3 +++ b/doc/DString.3 @@ -9,7 +9,7 @@ .so man.macros .BS .SH NAME -Tcl_DStringInit, Tcl_DStringAppend, Tcl_DStringAppendElement, Tcl_DStringStartSublist, Tcl_DStringEndSublist, Tcl_DStringLength, Tcl_DStringValue, Tcl_DStringSetLength, Tcl_DStringTrunc, Tcl_DStringFree, Tcl_DStringResult, Tcl_DStringGetResult \- manipulate dynamic strings +Tcl_DStringInit, Tcl_DStringAppend, Tcl_DStringAppendElement, Tcl_DStringStartSublist, Tcl_DStringEndSublist, Tcl_DStringLength, Tcl_DStringValue, Tcl_DStringSetLength, Tcl_DStringFree, Tcl_DStringResult, Tcl_DStringGetResult \- manipulate dynamic strings .SH SYNOPSIS .nf \fB#include <tcl.h>\fR @@ -26,7 +26,7 @@ char * .sp \fBTcl_DStringEndSublist\fR(\fIdsPtr\fR) .sp -int +size_t \fBTcl_DStringLength\fR(\fIdsPtr\fR) .sp char * @@ -34,8 +34,6 @@ char * .sp \fBTcl_DStringSetLength\fR(\fIdsPtr, newLength\fR) .sp -\fBTcl_DStringTrunc\fR(\fIdsPtr, newLength\fR) -.sp \fBTcl_DStringFree\fR(\fIdsPtr\fR) .sp \fBTcl_DStringResult\fR(\fIinterp, dsPtr\fR) @@ -53,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 int length in -Number of bytes from \fIbytes\fR to add to dynamic string. If -1, +.AP size_t length in +Number of bytes from \fIbytes\fR to add to dynamic string. If TCL_INDEX_NONE, add all characters up to null terminating character. -.AP int newLength in +.AP size_t newLength in New length for dynamic string, not including null terminating character. .AP Tcl_Interp *interp in/out @@ -132,10 +130,6 @@ caller to fill in the new space. even if the string is truncated to zero length, so \fBTcl_DStringFree\fR will still need to be called. .PP -\fBTcl_DStringTrunc\fR changes the length of a dynamic string. -This procedure is now deprecated. \fBTcl_DStringSetLength\fR should -be used instead. -.PP \fBTcl_DStringFree\fR should be called when you are finished using the string. It frees up any memory that was allocated for the string and reinitializes the string's value to an empty string. diff --git a/doc/DetachPids.3 b/doc/DetachPids.3 index 26075c3..c4d6fa7 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 int numPids in +.AP size_t 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 0b4c1ca..ebff7bf 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 int *sizePtr out +.AP "size_t \&| 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 int keyc in +.AP size_t keyc in Indicates the number of keys that will be supplied in the \fIkeyv\fR array. .AP "Tcl_Obj *const" *keyv in @@ -138,7 +138,8 @@ converted to a dictionary. \fBTcl_DictObjSize\fR updates the given variable with the number of key/value pairs currently in the given dictionary. The result of this procedure is \fBTCL_OK\fR, or \fBTCL_ERROR\fR if the \fIdictPtr\fR cannot be -converted to a dictionary. +converted to a dictionary or if \fIsizePtr\fR points to a variable of type +\fBint\fR and the dict contains more than 2**31 key/value pairs. .PP \fBTcl_DictObjFirst\fR commences an iteration across all the key/value pairs in the given dictionary, placing the key and value in the diff --git a/doc/DoWhenIdle.3 b/doc/DoWhenIdle.3 index cfdbff9..1a252cc 100644 --- a/doc/DoWhenIdle.3 +++ b/doc/DoWhenIdle.3 @@ -21,7 +21,7 @@ Tcl_DoWhenIdle, Tcl_CancelIdleCall \- invoke a procedure when there are no pendi .AS Tcl_IdleProc clientData .AP Tcl_IdleProc *proc in Procedure to invoke. -.AP ClientData clientData in +.AP coid *clientData in Arbitrary one-word value to pass to \fIproc\fR. .BE .SH DESCRIPTION @@ -43,7 +43,7 @@ type \fBTcl_IdleProc\fR: .PP .CS typedef void \fBTcl_IdleProc\fR( - ClientData \fIclientData\fR); + void *\fIclientData\fR); .CE .PP The \fIclientData\fR parameter to \fIproc\fR is a copy of the \fIclientData\fR diff --git a/doc/DumpActiveMemory.3 b/doc/DumpActiveMemory.3 index 226209a..0e162bb 100644 --- a/doc/DumpActiveMemory.3 +++ b/doc/DumpActiveMemory.3 @@ -43,7 +43,7 @@ is not defined, these functions are all no-ops. \fBTcl_DumpActiveMemory\fR will output a list of all currently allocated memory to the specified file. The information output for each allocated block of memory is: starting and ending addresses -(excluding guard zone), size, source file where \fBckalloc\fR was +(excluding guard zone), size, source file where \fBTcl_Alloc\fR was called to allocate the block and line number in that file. It is especially useful to call \fBTcl_DumpActiveMemory\fR after the Tcl interpreter has been deleted. @@ -55,8 +55,8 @@ by \fBTcl_Main\fR. \fBTcl_ValidateAllMemory\fR forces a validation of the guard zones of all currently allocated blocks of memory. Normally validation of a block occurs when its freed, unless full validation is enabled, in -which case validation of all blocks occurs when \fBckalloc\fR and -\fBckfree\fR are called. This function forces the validation to occur +which case validation of all blocks occurs when \fBTcl_Alloc\fR and +\fBTcl_Free\fR are called. This function forces the validation to occur at any point. .SH "SEE ALSO" diff --git a/doc/Encoding.3 b/doc/Encoding.3 index 43bb2b8..974e70e 100644 --- a/doc/Encoding.3 +++ b/doc/Encoding.3 @@ -8,7 +8,7 @@ .so man.macros .BS .SH NAME -Tcl_GetEncoding, Tcl_FreeEncoding, Tcl_GetEncodingFromObj, Tcl_ExternalToUtfDString, Tcl_ExternalToUtf, Tcl_UtfToExternalDString, Tcl_UtfToExternal, Tcl_GetEncodingName, Tcl_SetSystemEncoding, Tcl_GetEncodingNameFromEnvironment, Tcl_GetEncodingNames, Tcl_CreateEncoding, Tcl_GetEncodingSearchPath, Tcl_SetEncodingSearchPath, Tcl_GetDefaultEncodingDir, Tcl_SetDefaultEncodingDir \- procedures for creating and using encodings +Tcl_GetEncoding, Tcl_FreeEncoding, Tcl_GetEncodingFromObj, Tcl_ExternalToUtfDString, Tcl_ExternalToUtf, Tcl_UtfToExternalDString, Tcl_UtfToExternal, Tcl_GetEncodingName, Tcl_SetSystemEncoding, Tcl_GetEncodingNameFromEnvironment, Tcl_GetEncodingNames, Tcl_CreateEncoding, Tcl_GetEncodingSearchPath, Tcl_SetEncodingSearchPath \- procedures for creating and using encodings .SH SYNOPSIS .nf \fB#include <tcl.h>\fR @@ -25,13 +25,13 @@ int char * \fBTcl_ExternalToUtfDString\fR(\fIencoding, src, srcLen, dstPtr\fR) .sp -int +size_t \fBTcl_ExternalToUtfDStringEx\fR(\fIencoding, src, srcLen, flags, dstPtr\fR) .sp char * \fBTcl_UtfToExternalDString\fR(\fIencoding, src, srcLen, dstPtr\fR) .sp -int +size_t \fBTcl_UtfToExternalDStringEx\fR(\fIencoding, src, srcLen, flags, dstPtr\fR) .sp int @@ -42,12 +42,6 @@ int \fBTcl_UtfToExternal\fR(\fIinterp, encoding, src, srcLen, flags, statePtr, dst, dstLen, srcReadPtr, dstWrotePtr, dstCharsPtr\fR) .sp -char * -\fBTcl_WinTCharToUtf\fR(\fItsrc, srcLen, dstPtr\fR) -.sp -TCHAR * -\fBTcl_WinUtfToTChar\fR(\fIsrc, srcLen, dstPtr\fR) -.sp const char * \fBTcl_GetEncodingName\fR(\fIencoding\fR) .sp @@ -71,12 +65,6 @@ Tcl_Obj * .sp int \fBTcl_SetEncodingSearchPath\fR(\fIsearchPath\fR) -.sp -const char * -\fBTcl_GetDefaultEncodingDir\fR(\fIvoid\fR) -.sp -void -\fBTcl_SetDefaultEncodingDir\fR(\fIpath\fR) .SH ARGUMENTS .AS "const Tcl_EncodingType" *dstWrotePtr in/out .AP Tcl_Interp *interp in @@ -94,11 +82,11 @@ Points to storage where encoding token is to be written. .AP "const char" *src in For the \fBTcl_ExternalToUtf\fR functions, an array of bytes in the specified encoding that are to be converted to UTF-8. For the -\fBTcl_UtfToExternal\fR and \fBTcl_WinUtfToTChar\fR functions, an array of +\fBTcl_UtfToExternal\fR function, an array of 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 int srcLen in +.AP size_t 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 @@ -114,15 +102,15 @@ converted. \fBTCL_ENCODING_END\fR signifies that the source buffer is the last block in a (potentially multi-block) input stream, telling the conversion routine to perform any finalization that needs to occur after the last byte is converted and then to reset to an initial state. -\fBTCL_ENCODING_STOPONERROR\fR signifies that the conversion routine should -return immediately upon reading a source character that does not exist in -the target encoding; otherwise a default fallback character will -automatically be substituted. The flag \fBTCL_ENCODING_STRICT\fR makes the +\fBTCL_ENCODING_NOCOMPLAIN\fR signifies that the conversion routine should +not return immediately upon reading a source character that does not exist in +the target encoding, but it will substitute a default fallback character for +all of such characters. The flag \fBTCL_ENCODING_STOPONERROR\fR has no effect, +it only has meaning in Tcl 8.x. The flag \fBTCL_ENCODING_STRICT\fR makes the encoder/decoder more strict in what it considers to be an invalid byte -sequence. The flag \fBTCL_ENCODING_NOCOMPLAIN\fR has -no effect, it is reserved for Tcl 9.0. The flag \fBTCL_ENCODING_MODIFIED\fR makes -\fBTcl_UtfToExternalDStringEx\fR and \fBTcl_UtfToExternal\fR produce the -byte sequence \exC0\ex80 in stead of \ex00, for the utf-8/cesu-8 encoders. +sequence. The flag \fBTCL_ENCODING_MODIFIED\fR makes +\fBTcl_UtfToExternalDStringEx\fR and \fBTcl_UtfToExternal\fR produce the byte +sequence \exC0\ex80 in stead of \ex00, for the utf-8/cesu-8 encoders. .AP Tcl_EncodingState *statePtr in/out Used when converting a (generally long or indefinite length) byte stream in a piece-by-piece fashion. The conversion routine stores its current @@ -253,7 +241,7 @@ if the input stream has been damaged or if the input encoding method was misidentified. .IP \fBTCL_CONVERT_UNKNOWN\fR 29 The source buffer contained a character that could not be represented in -the target encoding and \fBTCL_ENCODING_STOPONERROR\fR was specified. +the target encoding and \fBTCL_ENCODING_NOCOMPLAIN\fR was not specified. .RE .LP \fBTcl_UtfToExternalDString\fR converts a source buffer \fIsrc\fR from UTF-8 @@ -279,18 +267,6 @@ is filled with the corresponding number of bytes that were stored in \fIdst\fR. The return values are the same as the return values for \fBTcl_ExternalToUtf\fR. .PP -\fBTcl_WinUtfToTChar\fR and \fBTcl_WinTCharToUtf\fR are Windows-only -convenience functions for converting between UTF-8 and Windows strings -based on the TCHAR type which is by convention a Unicode character on -Windows NT. Those functions are deprecated. You can use -\fBTcl_UtfToWCharDString\fR resp. \fBTcl_WCharToUtfDString\fR as replacement. -If you want compatibility with earlier Tcl releases than 8.7, use -\fBTcl_UtfToUniCharDString\fR resp. \fBTcl_UniCharToUtfDString\fR as -replacement, and make sure you compile your extension with -DTCL_UTF_MAX=3. -Beware: Those replacement functions don't initialize their Tcl_DString (you'll -have to do that yourself), and \fBTcl_UniCharToUtfDString\fR from Tcl 8.6 -doesn't accept -1 as length parameter. -.PP \fBTcl_GetEncodingName\fR is roughly the inverse of \fBTcl_GetEncoding\fR. Given an \fIencoding\fR, the return value is the \fIname\fR argument that was used to create the encoding. The string returned by @@ -320,7 +296,7 @@ the encoding name to it. The \fBTcl_DStringValue\fR is returned. \fBTcl_GetEncodingNames\fR sets the \fIinterp\fR result to a list consisting of the names of all the encodings that are currently defined or can be dynamically loaded, searching the encoding path specified by -\fBTcl_SetDefaultEncodingDir\fR. This procedure does not ensure that the +\fBTcl_SetEncodingSearchPath\fR. This procedure does not ensure that the dynamically-loadable encoding files contain valid data, but merely that they exist. .PP @@ -347,7 +323,7 @@ typedef struct Tcl_EncodingType { Tcl_EncodingConvertProc *\fItoUtfProc\fR; Tcl_EncodingConvertProc *\fIfromUtfProc\fR; Tcl_EncodingFreeProc *\fIfreeProc\fR; - ClientData \fIclientData\fR; + void *\fIclientData\fR; int \fInullSize\fR; } \fBTcl_EncodingType\fR; .CE @@ -378,7 +354,7 @@ type \fBTcl_EncodingConvertProc\fR: .PP .CS typedef int \fBTcl_EncodingConvertProc\fR( - ClientData \fIclientData\fR, + void *\fIclientData\fR, const char *\fIsrc\fR, int \fIsrcLen\fR, int \fIflags\fR, @@ -410,7 +386,7 @@ The callback procedure \fIfreeProc\fR, if non-NULL, should match the type .PP .CS typedef void \fBTcl_EncodingFreeProc\fR( - ClientData \fIclientData\fR); + void *\fIclientData\fR); .CE .PP This \fIfreeProc\fR function is called when the encoding is deleted. The @@ -435,15 +411,6 @@ are not verified as existing readable filesystem directories. When searching for encoding data files takes place, and non-existent or non-readable filesystem directories on the \fIsearchPath\fR are silently ignored. -.PP -\fBTcl_GetDefaultEncodingDir\fR and \fBTcl_SetDefaultEncodingDir\fR -are obsolete interfaces best replaced with calls to -\fBTcl_GetEncodingSearchPath\fR and \fBTcl_SetEncodingSearchPath\fR. -They are called to access and set the first element of the \fIsearchPath\fR -list. Since Tcl searches \fIsearchPath\fR for encoding data files in -list order, these routines establish the -.QW default -directory in which to find encoding data files. .SH "ENCODING FILES" Space would prohibit precompiling into Tcl every possible encoding algorithm, so many encodings are stored on disk as dynamically-loadable @@ -10,7 +10,7 @@ .so man.macros .BS .SH NAME -Tcl_EvalObjEx, Tcl_EvalFile, Tcl_EvalObjv, Tcl_Eval, Tcl_EvalEx, Tcl_GlobalEval, Tcl_GlobalEvalObj, Tcl_VarEval, Tcl_VarEvalVA \- execute Tcl scripts +Tcl_EvalObjEx, Tcl_EvalFile, Tcl_EvalObjv, Tcl_Eval, Tcl_EvalEx, Tcl_GlobalEval, Tcl_GlobalEvalObj, Tcl_VarEval \- execute Tcl scripts .SH SYNOPSIS .nf \fB#include <tcl.h>\fR @@ -38,9 +38,6 @@ int .sp int \fBTcl_VarEval\fR(\fIinterp, part, part, ... \fB(char *) NULL\fR) -.sp -int -\fBTcl_VarEvalVA\fR(\fIinterp, argList\fR) .SH ARGUMENTS .AS Tcl_Interp **termPtr .AP Tcl_Interp *interp in @@ -53,7 +50,7 @@ ORed 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 int objc in +.AP size_t 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 @@ -67,9 +64,6 @@ first null byte are used. Points to first byte of script to execute (null-terminated and UTF-8). .AP "const char" *part in String forming part of a Tcl script. -.AP va_list argList in -An argument list which must have been initialized using -\fBva_start\fR, and cleared using \fBva_end\fR. .BE .SH DESCRIPTION @@ -126,16 +120,10 @@ might be a UTF-8 special code. The string is parsed and executed directly bytecodes. In situations where it is known that the script will never be executed again, \fBTcl_Eval\fR may be faster than \fBTcl_EvalObjEx\fR. \fBTcl_Eval\fR returns a completion code and result just like -\fBTcl_EvalObjEx\fR. Note: for backward compatibility with versions before -Tcl 8.0, \fBTcl_Eval\fR copies the value result in \fIinterp\fR to -\fIinterp->result\fR (use is deprecated) where it can be accessed directly. - This makes \fBTcl_Eval\fR somewhat slower than \fBTcl_EvalEx\fR, which -does not do the copy. +\fBTcl_EvalObjEx\fR. .PP \fBTcl_EvalEx\fR is an extended version of \fBTcl_Eval\fR that takes -additional arguments \fInumBytes\fR and \fIflags\fR. For the -efficiency reason given above, \fBTcl_EvalEx\fR is generally preferred -over \fBTcl_Eval\fR. +additional arguments \fInumBytes\fR and \fIflags\fR. .PP \fBTcl_GlobalEval\fR and \fBTcl_GlobalEvalObj\fR are older procedures that are now deprecated. They are similar to \fBTcl_EvalEx\fR and @@ -151,11 +139,6 @@ It returns the result of the command and also modifies the interpreter result in the same way as \fBTcl_Eval\fR. The last argument to \fBTcl_VarEval\fR must be NULL to indicate the end of arguments. \fBTcl_VarEval\fR is now deprecated. -.PP -\fBTcl_VarEvalVA\fR is the same as \fBTcl_VarEval\fR except that -instead of taking a variable number of arguments it takes an argument -list. Interfaces using argument lists have been found to be nonportable -in practice. This function is deprecated and will be removed in Tcl 9.0. .SH "FLAG BITS" .PP @@ -42,7 +42,7 @@ usually means that an error occurred. Procedure to invoke before exiting application, or (for \fBTcl_SetExitProc\fR) NULL to uninstall the current application exit procedure. -.AP ClientData clientData in +.AP void *clientData in Arbitrary one-word value to pass to \fIproc\fR. .BE @@ -64,7 +64,7 @@ otherwise causes the application to terminate without calling returns control to its caller. If an application exit handler has been installed (see \fBTcl_SetExitProc\fR), that handler is invoked with an argument -consisting of the exit status (cast to ClientData); the application +consisting of the exit status (cast to void *); the application exit handler should not return control to Tcl. .PP \fBTcl_Finalize\fR is similar to \fBTcl_Exit\fR except that it does not @@ -93,7 +93,7 @@ and freeing global memory. .PP .CS typedef void \fBTcl_ExitProc\fR( - ClientData \fIclientData\fR); + void *\fIclientData\fR); .CE .PP The \fIclientData\fR parameter to \fIproc\fR is a @@ -133,10 +133,9 @@ installed, that exit handler takes over complete responsibility for finalization of Tcl's subsystems via \fBTcl_Finalize\fR at an appropriate time. The argument passed to \fIproc\fR when it is invoked will be the exit status code (as passed to \fBTcl_Exit\fR) -cast to a ClientData value. +cast to a void *value. .PP -\fBTcl_SetExitProc\fR can not be used in stub-enabled extensions. Its symbol -entry in the stub table is deprecated and it will be removed in Tcl 9.0. +\fBTcl_SetExitProc\fR can not be used in stub-enabled extensions. .SH "SEE ALSO" exit(n) .SH KEYWORDS diff --git a/doc/FileSystem.3 b/doc/FileSystem.3 index e7cc4ab..469af22 100644 --- a/doc/FileSystem.3 +++ b/doc/FileSystem.3 @@ -20,7 +20,7 @@ int int \fBTcl_FSUnregister\fR(\fIfsPtr\fR) .sp -ClientData +void * \fBTcl_FSData\fR(\fIfsPtr\fR) .sp void @@ -123,7 +123,7 @@ Tcl_Obj * int \fBTcl_FSConvertToPathType\fR(\fIinterp, pathPtr\fR) .sp -ClientData +void * \fBTcl_FSGetInternalRep\fR(\fIpathPtr, fsPtr\fR) .sp Tcl_Obj * @@ -210,7 +210,7 @@ this structure will be returned. This parameter may be NULL. .AP Tcl_Interp *interp in Interpreter to use either for results, evaluation, or reporting error messages. -.AP ClientData clientData in +.AP void *clientData in The native description of the path value to create. .AP Tcl_Obj *firstPtr in The first of two path values to compare. The value may be converted @@ -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 int elements in -If non-negative, the number of elements in the \fIlistObj\fR which should -be joined together. If negative, then all elements are joined. +.AP size_t elements in +The number of elements in the \fIlistObj\fR which should +be joined together. If TCL_INDEX_NONE, 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. @@ -251,7 +251,7 @@ Name of a procedure to look up in the file's symbol table Filled with the init function for this code. .AP Tcl_LibraryInitProc **proc2Ptr out Filled with the safe-init function for this code. -.AP ClientData *clientDataPtr out +.AP void **clientDataPtr out Filled with the clientData value to pass to this code's unload function when it is called. .AP Tcl_LoadHandle *loadHandlePtr out @@ -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 int *lenPtr out +.AP "size_t \&| 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 int objc in +.AP size_t objc in The number of elements in \fIobjv\fR. .AP "Tcl_Obj *const" objv[] in The elements to join to the given base path. @@ -720,7 +720,7 @@ better functions to use for most purposes. \fBTcl_FSGetTranslatedStringPath\fR does the same as \fBTcl_FSGetTranslatedPath\fR, but returns a character string or NULL. The string returned is dynamically allocated and owned by the caller, -which must store it or call \fBckfree\fR to ensure it is freed. Again, +which must store it or call \fBTcl_Free\fR to ensure it is freed. Again, \fBTcl_FSGetNormalizedPath\fR or \fBTcl_FSGetNativePath\fR are usually better functions to use for most purposes. .PP @@ -787,7 +787,7 @@ It returns one of \fBTCL_PATH_ABSOLUTE\fR, \fBTCL_PATH_RELATIVE\fR, or .SS "PORTABLE STAT RESULT API" .PP \fBTcl_AllocStatBuf\fR allocates a \fITcl_StatBuf\fR on the system heap (which -may be deallocated by being passed to \fBckfree\fR). This allows extensions to +may be deallocated by being passed to \fBTcl_Free\fR). This allows extensions to invoke \fBTcl_FSStat\fR and \fBTcl_FSLstat\fR without being dependent on the size of the buffer. That in turn depends on the flags used to build Tcl. .PP @@ -835,7 +835,7 @@ general that is not a good thing to do). \fBTCL_OK\fR will be returned. the list of known filesystems, if it is known, and returns \fBTCL_OK\fR. If the filesystem is not currently registered, \fBTCL_ERROR\fR is returned. .PP -\fBTcl_FSData\fR will return the ClientData associated with the given +\fBTcl_FSData\fR will return the clientData associated with the given filesystem, if that filesystem is registered. Otherwise it will return NULL. .PP @@ -850,7 +850,7 @@ The \fBTcl_Filesystem\fR structure contains the following fields: .CS typedef struct Tcl_Filesystem { const char *\fItypeName\fR; - int \fIstructureLength\fR; + size_t \fIstructureLength\fR; Tcl_FSVersion \fIversion\fR; Tcl_FSPathInFilesystemProc *\fIpathInFilesystemProc\fR; Tcl_FSDupInternalRepProc *\fIdupInternalRepProc\fR; @@ -1012,7 +1012,7 @@ Tcl's internal list of known filesystems. .CS typedef int \fBTcl_FSPathInFilesystemProc\fR( Tcl_Obj *\fIpathPtr\fR, - ClientData *\fIclientDataPtr\fR); + void **\fIclientDataPtr\fR); .CE .SS DUPINTERNALREPPROC .PP @@ -1022,8 +1022,8 @@ simply not copy the internal representation, which may then need to be regenerated later. .PP .CS -typedef ClientData \fBTcl_FSDupInternalRepProc\fR( - ClientData \fIclientData\fR); +typedef void *\fBTcl_FSDupInternalRepProc\fR( + void *\fIclientData\fR); .CE .SS FREEINTERNALREPPROC Free the internal representation. This must be implemented if internal @@ -1032,7 +1032,7 @@ internal representation is generated), but may otherwise be NULL. .PP .CS typedef void \fBTcl_FSFreeInternalRepProc\fR( - ClientData \fIclientData\fR); + void *\fIclientData\fR); .CE .SS INTERNALTONORMALIZEDPROC .PP @@ -1043,7 +1043,7 @@ representation is the normalized path. .PP .CS typedef Tcl_Obj *\fBTcl_FSInternalToNormalizedProc\fR( - ClientData \fIclientData\fR); + void *\fIclientData\fR); .CE .SS CREATEINTERNALREPPROC .PP @@ -1054,7 +1054,7 @@ the \fITcl_FSPathInFilesystemProc\fR for this filesystem always immediately creates an internal representation for paths it accepts. .PP .CS -typedef ClientData \fBTcl_FSCreateInternalRepProc\fR( +typedef void *\fBTcl_FSCreateInternalRepProc\fR( Tcl_Obj *\fIpathPtr\fR); .CE .SS NORMALIZEPATHPROC diff --git a/doc/FindExec.3 b/doc/FindExec.3 index 7f8c8a4..eed296c 100644 --- a/doc/FindExec.3 +++ b/doc/FindExec.3 @@ -35,8 +35,8 @@ Tcl. For example, it is needed on some platforms in the implementation of the \fBload\fR command. It is also returned by the \fBinfo nameofexecutable\fR command. .PP -The result of \fBTcl_FindExecutable\fR is the full Tcl version (e.g., -\fB8.7.0+abcdef...abcdef.gcc-1002.utf16\fR). +The result of \fBTcl_FindExecutable\fR is the full Tcl version with +build information (e.g., \fB9.0.0+abcdef...abcdef.gcc-1002\fR). .PP On UNIX platforms this procedure is typically invoked as the very first thing in the application's main program; it must be passed @@ -62,7 +62,6 @@ equivalent to the \fBinfo nameofexecutable\fR command. NULL is returned if the internal full path name has not been computed or unknown. .PP -\fBTcl_FindExecutable\fR can not be used in stub-enabled extensions. Its symbol -entry in the stub table is deprecated and it will be removed in Tcl 9.0. +\fBTcl_FindExecutable\fR can not be used in stub-enabled extensions. .SH KEYWORDS binary, executable file diff --git a/doc/GetInt.3 b/doc/GetInt.3 index f15c12d..1e8cd61 100644 --- a/doc/GetInt.3 +++ b/doc/GetInt.3 @@ -71,12 +71,9 @@ if the first such characters are then \fIsrc\fR is expected to be in octal form; otherwise, if the first such characters are .QW \fB0b\fR -then \fIsrc\fR is expected to be in binary form; otherwise, -if the first such character is -.QW \fB0\fR then \fIsrc\fR -is expected to be in octal form; otherwise, \fIsrc\fR -is expected to be in decimal form. +is expected to be in binary form; otherwise, \fIsrc\fR is +expected to be in decimal form. .PP \fBTcl_GetDouble\fR expects \fIsrc\fR to consist of a floating-point number, which is: white space; a sign; a sequence of digits; a diff --git a/doc/GetOpnFl.3 b/doc/GetOpnFl.3 index a450b02..5ac5391 100644 --- a/doc/GetOpnFl.3 +++ b/doc/GetOpnFl.3 @@ -28,7 +28,7 @@ be used for reading. .AP int checkUsage in If non-zero, then an error will be generated if the file was not opened for the access indicated by \fIwrite\fR. -.AP ClientData *filePtr out +.AP void **filePtr out Points to word in which to store pointer to FILE structure for the file given by \fIchanID\fR. .BE diff --git a/doc/GetTime.3 b/doc/GetTime.3 index 9dc4056..4aa8442 100644 --- a/doc/GetTime.3 +++ b/doc/GetTime.3 @@ -27,13 +27,13 @@ Pointer to handler function replacing \fBTcl_GetTime\fR's access to the OS. .AP Tcl_ScaleTimeProc scaleProc in Pointer to handler function for the conversion of time delays in the virtual domain to real-time. -.AP ClientData clientData in +.AP void *clientData in Value passed through to the two handler functions. .AP Tcl_GetTimeProc *getProcPtr out Pointer to place the currently registered get handler function into. .AP Tcl_ScaleTimeProc *scaleProcPtr out Pointer to place the currently registered scale handler function into. -.AP ClientData *clientDataPtr out +.AP void **clientDataPtr out Pointer to place the currently registered pass-through value into. .BE .SH DESCRIPTION @@ -83,10 +83,10 @@ The signatures of the handler functions are as follows: .CS typedef void \fBTcl_GetTimeProc\fR( Tcl_Time *\fItimebuf\fR, - ClientData \fIclientData\fR); + void *\fIclientData\fR); typedef void \fBTcl_ScaleTimeProc\fR( Tcl_Time *\fItimebuf\fR, - ClientData \fIclientData\fR); + void *\fIclientData\fR); .CE .PP The \fItimebuf\fR fields contain the time to manipulate, and the diff --git a/doc/GetVersion.3 b/doc/GetVersion.3 index 3672382..b973044 100644 --- a/doc/GetVersion.3 +++ b/doc/GetVersion.3 @@ -15,14 +15,13 @@ Tcl_GetVersion \- get the version of the library at runtime .sp \fBTcl_GetVersion\fR(\fImajor, minor, patchLevel, type\fR) .SH ARGUMENTS -.AS Tcl_ReleaseType *patchLevel out .AP int *major out Major version number of the Tcl library. .AP int *minor out Minor version number of the Tcl library. .AP int *patchLevel out The patch level of the Tcl library (or alpha or beta number). -.AP Tcl_ReleaseType *type out +.AP int *type out The type of release, also indicates the type of patch level. Can be one of \fBTCL_ALPHA_RELEASE\fR, \fBTCL_BETA_RELEASE\fR, or \fBTCL_FINAL_RELEASE\fR. @@ -30,7 +30,7 @@ Tcl_HashEntry * Tcl_HashEntry * \fBTcl_FindHashEntry\fR(\fItablePtr, key\fR) .sp -ClientData +void * \fBTcl_GetHashValue\fR(\fIentryPtr\fR) .sp \fBTcl_SetHashValue\fR(\fIentryPtr, value\fR) @@ -66,9 +66,8 @@ The word at \fI*newPtr\fR is set to 1 if a new entry was created and 0 if there was already an entry for \fIkey\fR. .AP Tcl_HashEntry *entryPtr in Pointer to hash table entry. -.AP ClientData value in -New value to assign to hash table entry. Need not have type -ClientData, but must fit in same space as ClientData. +.AP void *value in +New value to assign to hash table entry. .AP Tcl_HashSearch *searchPtr in Pointer to record to use to keep track of progress in enumerating all the entries in a hash table. @@ -186,11 +185,6 @@ instead, it returns NULL as result. .PP \fBTcl_GetHashValue\fR and \fBTcl_SetHashValue\fR are used to read and write an entry's value, respectively. -Values are stored and retrieved as type -.QW ClientData , -which is -large enough to hold a pointer value. On almost all machines this is -large enough to hold an integer value too. .PP \fBTcl_GetHashKey\fR returns the key for a given hash table entry, either as a pointer to a string, a one-word @@ -229,7 +223,7 @@ overall information about a hash table, such as the number of entries it contains, the number of buckets in its hash array, and the utilization of the buckets. It is the caller's responsibility to free the result string -by passing it to \fBckfree\fR. +by passing it to \fBTcl_Free\fR. .PP The header file \fBtcl.h\fR defines the actual data structures used to implement hash tables. @@ -2,7 +2,7 @@ '\" Copyright (c) 1998-2000 Scriptics Corporation. '\" All rights reserved. '\" -.TH Tcl_Init 3 8.7 Tcl "Tcl Library Procedures" +.TH Tcl_Init 3 9.0 Tcl "Tcl Library Procedures" .so man.macros .BS .SH NAME @@ -39,6 +39,10 @@ The pre-initialization script is executed by \fBTcl_Init\fR before accessing the file system. The purpose is to typically prepare a custom file system (like an embedded zip-file) to be activated before the search. +When used in stub-enabled embedders, the stubs table must be first initialized +using one of \fBTcl_InitSubsystems\fR, \fBTcl_SetPanicProc\fR, \fBTcl_FindExecutable\fR +or \fBTclZipfs_AppHook\fR before \fBTcl_SetPreInitScript\fR may be called. + .SH "SEE ALSO" Tcl_AppInit, Tcl_Main diff --git a/doc/InitStubs.3 b/doc/InitStubs.3 index 4423666..20105fe 100644 --- a/doc/InitStubs.3 +++ b/doc/InitStubs.3 @@ -63,9 +63,9 @@ Define the \fBUSE_TCL_STUBS\fR symbol. Typically, you would include the \fB\-DUSE_TCL_STUBS\fR flag when compiling the extension. .IP 3) 5 Link the extension with the Tcl stubs library instead of the standard -Tcl library. For example, to use the Tcl 8.6 ABI on Unix platforms, -the library name is \fIlibtclstub8.6.a\fR; on Windows platforms, the -library name is \fItclstub86.lib\fR. +Tcl library. For example, to use the Tcl 9.0 ABI on Unix platforms, +the library name is \fIlibtclstub9.0.a\fR; on Windows platforms, the +library name is \fItclstub90.lib\fR. .PP If the extension also requires the Tk API, it must also call \fBTk_InitStubs\fR to initialize the Tk stubs interface and link diff --git a/doc/InitSubSyst.3 b/doc/InitSubSyst.3 index 89f2b88..b7962c6 100644 --- a/doc/InitSubSyst.3 +++ b/doc/InitSubSyst.3 @@ -21,14 +21,14 @@ The \fBTcl_InitSubsystems\fR procedure initializes the Tcl library. This procedure is typically invoked as the very first thing in the application's main program. .PP -The result of \fBTcl_InitSubsystems\fR is the full Tcl version (e.g., -\fB8.7.0+abcdef...abcdef.gcc-1002.utf16\fR). +The result of \fBTcl_InitSubsystems\fR is the full Tcl version with +build information (e.g., \fB9.0.0+abcdef...abcdef.gcc-1002\fR). .PP \fBTcl_InitSubsystems\fR is very similar in use to \fBTcl_FindExecutable\fR. It can be used when Tcl is -used as utility library, no other encodings than utf8, +used as utility library, no other encodings than utf-8, iso8859-1 or utf-16 are used, and no interest exists in the value of \fBinfo nameofexecutable\fR. The system encoding will not -be extracted from the environment, but falls back to iso8859-1. +be extracted from the environment, but falls back to utf-8. .SH KEYWORDS binary, executable file diff --git a/doc/IntObj.3 b/doc/IntObj.3 index 18d867e..d2954c8 100644 --- a/doc/IntObj.3 +++ b/doc/IntObj.3 @@ -32,7 +32,7 @@ int \fBTcl_GetIntFromObj\fR(\fIinterp, objPtr, intPtr\fR) .sp int -\fBTcl_GetIntForIndex\fR(\fIinterp, objPtr, endValue, intPtr\fR) +\fBTcl_GetIntForIndex\fR(\fIinterp, objPtr, endValue, indexPtr\fR) .sp int \fBTcl_GetLongFromObj\fR(\fIinterp, objPtr, longPtr\fR) @@ -61,7 +61,7 @@ int \fBTcl_InitBignumFromDouble\fR(\fIinterp, doubleValue, bigValue\fR) .SH ARGUMENTS .AS Tcl_WideInt doubleValue in/out -.AP int endValue in +.AP size_t 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,6 +83,8 @@ 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_WideInt *widePtr out Points to place to store the wide integer value retrieved from \fIobjPtr\fR. .AP Tcl_WideUInt *uwidePtr out diff --git a/doc/Interp.3 b/doc/Interp.3 deleted file mode 100644 index c1b9803..0000000 --- a/doc/Interp.3 +++ /dev/null @@ -1,41 +0,0 @@ -'\" -'\" Copyright (c) 1989-1993 The Regents of the University of California. -'\" Copyright (c) 1994-1996 Sun Microsystems, Inc. -'\" -'\" See the file "license.terms" for information on usage and redistribution -'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" -.TH Tcl_Interp 3 8.7 Tcl "Tcl Library Procedures" -.so man.macros -.BS -.SH NAME -Tcl_Interp \- client-visible fields of interpreter structures -.SH SYNOPSIS -.nf -\fB#include <tcl.h>\fR -.sp -typedef struct { - char *\fIresult\fR; /* NO LONGER AVAILABLE */ - Tcl_FreeProc *\fIfreeProc\fR; /* NO LONGER AVAILABLE */ - int \fIerrorLine\fR; /* NO LONGER AVAILABLE */ -} \fBTcl_Interp\fR; - -typedef void \fBTcl_FreeProc\fR( - char *\fIblockPtr\fR); -.BE -.SH DESCRIPTION -.PP -The \fBTcl_CreateInterp\fR procedure returns a pointer to a \fBTcl_Interp\fR -structure. Callers of \fBTcl_CreateInterp\fR should use this pointer -as an opaque token, suitable for nothing other than passing back to -other routines in the Tcl interface from the same thread that called -\fBTcl_CreateInterp\fR. The \fBTcl_Interp\fR struct no longer has any -supported client-visible fields. Supported public routines such as -\fBTcl_SetResult\fR, \fBTcl_GetResult\fR, \fBTcl_SetErrorLine\fR, -\fBTcl_GetErrorLine\fR must be used instead. -.PP -Any legacy programs and extensions trying to access the fields above -in their source code will need conversion to compile for Tcl 8.7 and later. - -.SH KEYWORDS -interpreter, result diff --git a/doc/Limit.3 b/doc/Limit.3 index 3d202fc..43e92f0 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 int commandLimit in +.AP size_t 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 @@ -83,7 +83,7 @@ the handler returns. Many handlers may be attached to the same interpreter limit; their order of execution is not defined, and they must be identified by \fIhandlerProc\fR and \fIclientData\fR when they are deleted. -.AP ClientData clientData in +.AP void *clientData in Arbitrary pointer-sized word used to pass some context to the \fIhandlerProc\fR function. .AP Tcl_LimitHandlerDeleteProc *deleteProc in @@ -162,7 +162,7 @@ following prototype: .PP .CS typedef void \fBTcl_LimitHandlerProc\fR( - ClientData \fIclientData\fR, + void *\fIclientData\fR, Tcl_Interp *\fIinterp\fR); .CE .PP @@ -179,7 +179,7 @@ following prototype: .PP .CS typedef void \fBTcl_LimitHandlerDeleteProc\fR( - ClientData \fIclientData\fR); + void *\fIclientData\fR); .CE .PP A limit handler may be deleted using \fBTcl_LimitRemoveHandler\fR; the diff --git a/doc/LinkVar.3 b/doc/LinkVar.3 index f5e97b4..f7ce3a3 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 int size in +.AP size_t size in .VS "TIP 312" The number of elements in the C array. Must be greater than zero. .VE "TIP 312" @@ -263,7 +263,7 @@ Tcl errors. . The C variable is of type \fBchar *\fR. If its value is not NULL then it must be a pointer to a string -allocated with \fBTcl_Alloc\fR or \fBckalloc\fR. +allocated with \fBTcl_Alloc\fR. Whenever the Tcl variable is modified the current C string will be freed and new memory will be allocated to hold a copy of the variable's new value. diff --git a/doc/ListObj.3 b/doc/ListObj.3 index c5c1dc7..a0ed5c9 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 int *objcPtr in +.AP "size_t \&| 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 int objc in +.AP size_t 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 int *lengthPtr out +.AP "size_t \&| int" *lengthPtr out Points to location where \fBTcl_ListObjLength\fR stores the length of the list. -.AP int index in +.AP size_t 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 int first in +.AP size_t first in Index of the starting list element that \fBTcl_ListObjReplace\fR is to replace. The list's first element has index 0. -.AP int count in +.AP size_t count in The number of elements that \fBTcl_ListObjReplace\fR is to replace. .BE @@ -153,7 +153,9 @@ address \fIobjcPtr\fR. Similarly, it returns the array pointer by storing it in the address \fIobjvPtr\fR. The memory pointed to is managed by Tcl and should not be freed or written to by the caller. If the list is empty, 0 is stored at \fIobjcPtr\fR -and NULL at \fIobjvPtr\fR. +and NULL at \fIobjvPtr\fR. If \fIobjcPtr\fR points to a variable +of type \fBint\fR and the list contains more than 2**31 elements, the +function returns \fBTCL_ERROR\fR. If \fIlistPtr\fR is not already a list value, \fBTcl_ListObjGetElements\fR will attempt to convert it to one; if the conversion fails, it returns \fBTCL_ERROR\fR and leaves an error message in the interpreter's result @@ -162,7 +164,9 @@ Otherwise it returns \fBTCL_OK\fR after storing the count and array pointer. .PP \fBTcl_ListObjLength\fR returns the number of elements in the list value referenced by \fIlistPtr\fR. -It returns this count by storing an integer in the address \fIlengthPtr\fR. +It returns this count by storing a value in the address \fIlengthPtr\fR. +If \fIlengthPtr\fR points to a variable of type \fBint\fR and the list +contains more than 2**31 elements, the function returns \fBTCL_ERROR\fR. If the value is not already a list value, \fBTcl_ListObjLength\fR will attempt to convert it to one; if the conversion fails, it returns \fBTCL_ERROR\fR @@ -180,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 negative or +that is, \fIindex\fR is TCL_INDEX_NONE 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. @@ -199,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 negative, +If the argument \fIfirst\fR is zero or TCL_INDEX_NONE, 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 negative then no elements are deleted; +If \fIcount\fR is zero or TCL_INDEX_NONE 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 577cd54..c3a6b64 100644 --- a/doc/Method.3 +++ b/doc/Method.3 @@ -58,10 +58,10 @@ Tcl_Method Tcl_Object \fBTcl_ObjectContextObject\fR(\fIcontext\fR) .sp -int +size_t \fBTcl_ObjectContextSkippedArgs\fR(\fIcontext\fR) .SH ARGUMENTS -.AS ClientData clientData in +.AS void *clientData in .AP Tcl_Interp *interp in/out The interpreter holding the object or class to create or update a method in. .AP Tcl_Object object in @@ -83,10 +83,10 @@ and \fBTCL_OO_METHOD_PRIVATE\fR for a private method. .AP Tcl_MethodType *methodTypePtr in A description of the type of the method to create, or the type of method to compare against. -.AP ClientData clientData in +.AP void *clientData in A piece of data that is passed to the implementation of the method without interpretation. -.AP ClientData *clientDataPtr out +.AP void **clientDataPtr out A pointer to a variable in which to write the \fIclientData\fR value supplied when the method was created. If NULL, the \fIclientData\fR value will not be retrieved. @@ -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 int objc in +.AP size_t 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 int skip in +.AP size_t skip in The number of arguments passed to the method implementation that do not represent "real" arguments. .BE @@ -213,7 +213,7 @@ Functions matching this signature are called when the method is invoked. .PP .CS typedef int \fBTcl_MethodCallProc\fR( - ClientData \fIclientData\fR, + void *\fIclientData\fR, Tcl_Interp *\fIinterp\fR, Tcl_ObjectContext \fIobjectContext\fR, int \fIobjc\fR, @@ -234,7 +234,7 @@ through a new method being created or because the object or class is deleted. .PP .CS typedef void \fBTcl_MethodDeleteProc\fR( - ClientData \fIclientData\fR); + void *\fIclientData\fR); .CE .PP The \fIclientData\fR argument to a Tcl_MethodDeleteProc will be the same as @@ -248,8 +248,8 @@ class is copied using \fBTcl_CopyObjectInstance\fR (or \fBoo::copy\fR). .CS typedef int \fBTcl_CloneProc\fR( Tcl_Interp *\fIinterp\fR, - ClientData \fIoldClientData\fR, - ClientData *\fInewClientDataPtr\fR); + void *\fIoldClientData\fR, + void **\fInewClientDataPtr\fR); .CE .PP The \fIinterp\fR argument gives a place to write an error message when the @@ -63,13 +63,13 @@ in the same way as the \fIproc2\fR argument to \fBTcl_CreateObjCommand2\fR(3) Called instead of \fIproc\fR when a trampoline is already in use. .AP Tcl_ObjCmdProc2 *nreProc2 in Called instead of \fIproc2\fR when a trampoline is already in use. -.AP ClientData clientData in +.AP void *clientData in Arbitrary one-word value passed to \fIproc\fR, \fInreProc\fR, \fIdeleteProc\fR 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 int objc in +.AP size_t objc in Number of items in \fIobjv\fR. .AP Tcl_Obj **objv in Words in the command. @@ -86,10 +86,10 @@ Pointer to an unshared Tcl_Obj where the result of the evaluation is stored if the return code is TCL_OK. .AP Tcl_NRPostProc *postProcPtr in A function to push. -.AP ClientData data0 in -.AP ClientData data1 in -.AP ClientData data2 in -.AP ClientData data3 in +.AP void *data0 in +.AP void *data1 in +.AP void *data2 in +.AP void *data3 in \fIdata0\fR through \fIdata3\fR are four one-word values that will be passed to the function designated by \fIpostProcPtr\fR when it is invoked. .BE @@ -147,7 +147,7 @@ a message as the interpreter's result. .CS typedef int \fBTcl_NRPostProc\fR( - \fBClientData\fR \fIdata\fR[], + \fBvoid *\fR \fIdata\fR[], \fBTcl_Interp\fR *\fIinterp\fR, int \fIresult\fR); .CE @@ -163,7 +163,7 @@ stack, to evalute a script: .CS int \fITheCmdOldObjProc\fR( - ClientData clientData, + void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) @@ -194,7 +194,7 @@ call \fITheCmdNRObjProc\fR: .CS int \fITheCmdOldObjProc\fR( - ClientData clientData, + void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) @@ -207,7 +207,7 @@ int .CS int \fITheCmdNRObjProc\fR - ClientData clientData, + void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) @@ -228,7 +228,7 @@ int .CS int \fITheCmdNRPostProc\fR( - ClientData data[], + void *data[], Tcl_Interp *interp, int result) { diff --git a/doc/Namespace.3 b/doc/Namespace.3 index 49b772c..c4c893a 100644 --- a/doc/Namespace.3 +++ b/doc/Namespace.3 @@ -57,7 +57,7 @@ The interpreter in which the namespace exists and where name lookups are performed. Also where error result messages are written. .AP "const char" *name in The name of the namespace or command to be created or accessed. -.AP ClientData clientData in +.AP void *clientData in A context pointer by the creator of the namespace. Not interpreted by Tcl at all. .AP Tcl_NamespaceDeleteProc *deleteProc in @@ -117,7 +117,7 @@ the global namespace.) .PP .CS typedef void \fBTcl_NamespaceDeleteProc\fR( - ClientData \fIclientData\fR); + void *\fIclientData\fR); .CE .PP \fBTcl_DeleteNamespace\fR deletes a namespace, calling the diff --git a/doc/Notifier.3 b/doc/Notifier.3 index 7cb02f6..e01abc4 100644 --- a/doc/Notifier.3 +++ b/doc/Notifier.3 @@ -38,7 +38,7 @@ Tcl_ThreadId void \fBTcl_DeleteEvents\fR(\fIdeleteProc, clientData\fR) .sp -ClientData +void * \fBTcl_InitNotifier\fR() .sp void @@ -78,7 +78,7 @@ Procedure to invoke to prepare for event wait in \fBTcl_DoOneEvent\fR. Procedure for \fBTcl_DoOneEvent\fR to invoke after waiting for events. Checks to see if any events have occurred and, if so, queues them. -.AP ClientData clientData in +.AP void *clientData in Arbitrary one-word value to pass to \fIsetupProc\fR, \fIcheckProc\fR, or \fIdeleteProc\fR. .AP "const Tcl_Time" *timePtr in @@ -89,7 +89,7 @@ is NULL, it means there is no maximum wait time: wait forever if necessary. .AP Tcl_Event *evPtr in An event to add to the event queue. The storage for the event must -have been allocated by the caller using \fBTcl_Alloc\fR or \fBckalloc\fR. +have been allocated by the caller using \fBTcl_Alloc\fR. .AP int position in Where to add the new event in the queue: \fBTCL_QUEUE_TAIL\fR, \fBTCL_QUEUE_HEAD\fR, \fBTCL_QUEUE_MARK\fR, and whether to do @@ -226,7 +226,7 @@ the event source. .PP .CS typedef void \fBTcl_EventSetupProc\fR( - ClientData \fIclientData\fR, + void *\fIclientData\fR, int \fIflags\fR); .CE .PP @@ -304,7 +304,7 @@ following prototype: .PP .CS typedef void \fBTcl_EventCheckProc\fR( - ClientData \fIclientData\fR, + void *\fIclientData\fR, int \fIflags\fR); .CE .PP @@ -399,7 +399,7 @@ of window events. When \fIproc\fR returns 1, \fBTcl_ServiceEvent\fR will remove the event from the event queue and free its storage. Note that the storage for an event must be allocated by -the event source (using \fBTcl_Alloc\fR or the Tcl macro \fBckalloc\fR) +the event source (using \fBTcl_Alloc\fR) before calling \fBTcl_QueueEvent\fR, but it will be freed by \fBTcl_ServiceEvent\fR, not by the event source. .PP @@ -424,7 +424,7 @@ queue. \fIProc\fR should match the following prototype: .CS typedef int \fBTcl_EventDeleteProc\fR( Tcl_Event *\fIevPtr\fR, - ClientData \fIclientData\fR); + void *\fIclientData\fR); .CE .PP The \fIclientData\fR argument will be the same as the \fIclientData\fR diff --git a/doc/Object.3 b/doc/Object.3 index 2099552..91ee397 100644 --- a/doc/Object.3 +++ b/doc/Object.3 @@ -111,9 +111,9 @@ which is defined as follows. .PP .CS typedef struct Tcl_Obj { - int \fIrefCount\fR; + size_t \fIrefCount\fR; char *\fIbytes\fR; - int \fIlength\fR; + size_t \fIlength\fR; const Tcl_ObjType *\fItypePtr\fR; union { long \fIlongValue\fR; diff --git a/doc/ObjectType.3 b/doc/ObjectType.3 index 7e3cc12..3e6d0c2 100644 --- a/doc/ObjectType.3 +++ b/doc/ObjectType.3 @@ -109,6 +109,7 @@ typedef struct Tcl_ObjType { Tcl_DupInternalRepProc *\fIdupIntRepProc\fR; Tcl_UpdateStringProc *\fIupdateStringProc\fR; Tcl_SetFromAnyProc *\fIsetFromAnyProc\fR; + size_t \fIversion\fR; } \fBTcl_ObjType\fR; .CE .SS "THE NAME FIELD" @@ -184,8 +185,8 @@ to be treated as conventional null character-terminated C strings. These restrictions are easily met by using Tcl's internal UTF encoding for the string representation, same as one would do for other Tcl routines accepting string values as arguments. -Storage for the byte array must be allocated in the heap by \fBTcl_Alloc\fR -or \fBckalloc\fR. Note that \fIupdateStringProc\fRs must allocate +Storage for the byte array must be allocated in the heap by \fBTcl_Alloc\fR. +Note that \fIupdateStringProc\fRs must allocate enough storage for the string's bytes and the terminating null byte. .PP The \fIupdateStringProc\fR for Tcl's built-in double type, for example, @@ -253,6 +254,10 @@ Note that if a subsidiary value has its reference count reduced to zero during the running of a \fIfreeIntRepProc\fR, that value may be not freed immediately, in order to limit stack usage. However, the value will be freed before the outermost current \fBTcl_DecrRefCount\fR returns. +.SS "THE VERSION FIELD" +.PP +The \fIversion\fR member provides for future extensibility of the structure +and should be set to \fITCL_OBJTYPE_V0\fR. .SH "REFERENCE COUNT MANAGEMENT" .PP The \fIobjPtr\fR argument to \fBTcl_AppendAllObjTypes\fR should be an unshared diff --git a/doc/OpenFileChnl.3 b/doc/OpenFileChnl.3 index e8ed521..1b9d5d3 100644 --- a/doc/OpenFileChnl.3 +++ b/doc/OpenFileChnl.3 @@ -53,28 +53,28 @@ int int \fBTcl_Read\fR(\fIchannel, readBuf, bytesToRead\fR) .sp -int +size_t \fBTcl_GetsObj\fR(\fIchannel, lineObjPtr\fR) .sp -int +size_t \fBTcl_Gets\fR(\fIchannel, lineRead\fR) .sp -int +size_t \fBTcl_Ungets\fR(\fIchannel, input, inputLen, addAtEnd\fR) .sp -int +size_t \fBTcl_WriteObj\fR(\fIchannel, writeObjPtr\fR) .sp -int +size_t \fBTcl_WriteChars\fR(\fIchannel, charBuf, bytesToWrite\fR) .sp -int +size_t \fBTcl_Write\fR(\fIchannel, byteBuf, bytesToWrite\fR) .sp -int +size_t \fBTcl_ReadRaw\fR(\fIchannel, readBuf, bytesToRead\fR) .sp -int +size_t \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 int argc in +.AP size_t 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 @@ -134,7 +134,7 @@ input of the invoking process; likewise for \fBTCL_STDOUT\fR and redirect stdio handles to override the stdio handles for which \fBTCL_STDIN\fR, \fBTCL_STDOUT\fR and \fBTCL_STDERR\fR have been set. If it is set, then such redirections cause an error. -.AP ClientData handle in +.AP void *handle in Operating system specific handle for I/O to a file. For Unix this is a file descriptor, for Windows it is a HANDLE. .AP int readOrWrite in @@ -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 int charsToRead in +.AP size_t 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 int bytesToRead in +.AP size_t 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 int inputLen in +.AP size_t 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 int bytesToWrite in +.AP size_t bytesToWrite in The number of bytes to consume from \fIcharBuf\fR or \fIbyteBuf\fR and output to the channel. .AP "long long" offset in diff --git a/doc/OpenTcp.3 b/doc/OpenTcp.3 index ca26b59..5a0f559 100644 --- a/doc/OpenTcp.3 +++ b/doc/OpenTcp.3 @@ -52,12 +52,12 @@ Length of OS listen backlog queue. Use -1 for default value. .AP "unsigned int" flags in ORed combination of \fBTCL_TCPSERVER\fR flags that specify additional informations about the socket being created. -.AP ClientData sock in +.AP void *sock in Platform-specific handle for client TCP socket. .AP Tcl_TcpAcceptProc *proc in Pointer to a procedure to invoke each time a new connection is accepted via the socket. -.AP ClientData clientData in +.AP void *clientData in Arbitrary one-word value to pass to \fIproc\fR. .BE .SH DESCRIPTION @@ -129,7 +129,7 @@ the channel. \fIProc\fR must match the following prototype: .PP .CS typedef void \fBTcl_TcpAcceptProc\fR( - ClientData \fIclientData\fR, + void *\fIclientData\fR, Tcl_Channel \fIchannel\fR, char *\fIhostName\fR, int \fIport\fR); diff --git a/doc/Panic.3 b/doc/Panic.3 index bd019db..e8a5cb8 100644 --- a/doc/Panic.3 +++ b/doc/Panic.3 @@ -7,7 +7,7 @@ .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME -Tcl_Panic, Tcl_PanicVA, Tcl_SetPanicProc, Tcl_ConsolePanic \- report fatal error and abort +Tcl_Panic, Tcl_SetPanicProc, Tcl_ConsolePanic \- report fatal error and abort .SH SYNOPSIS .nf \fB#include <tcl.h>\fR @@ -15,9 +15,6 @@ Tcl_Panic, Tcl_PanicVA, Tcl_SetPanicProc, Tcl_ConsolePanic \- report fatal error void \fBTcl_Panic\fR(\fIformat\fR, \fIarg\fR, \fIarg\fR, \fI...\fR) .sp -void -\fBTcl_PanicVA\fR(\fIformat\fR, \fIargList\fR) -.sp const char * \fBTcl_SetPanicProc\fR(\fIpanicProc\fR) .sp @@ -82,15 +79,14 @@ making calls into the Tcl library, or into other libraries that may call the Tcl library, since the original call to \fBTcl_Panic\fR indicates the Tcl library is not in a state of reliable operation. .PP -The result of \fBTcl_SetPanicProc\fR is the full Tcl version (e.g., -\fB8.7.0+abcdef...abcdef.gcc-1002.utf16\fR). +The result of \fBTcl_SetPanicProc\fR is the full Tcl version with build +information (e.g., \fB9.0.0+abcdef...abcdef.gcc-1002\fR). .PP The typical use of \fBTcl_SetPanicProc\fR arranges for the error message to be displayed or reported in a manner more suitable for the application or the platform. .PP -\fBTcl_SetPanicProc\fR can not be used in stub-enabled extensions. Its symbol -entry in the stub table is deprecated and it will be removed in Tcl 9.0. +\fBTcl_SetPanicProc\fR can not be used in stub-enabled extensions. .PP Although the primary callers of \fBTcl_Panic\fR are the procedures of the Tcl library, \fBTcl_Panic\fR is a public function and may be called @@ -98,10 +94,6 @@ by any extension or application that wishes to abort the process and have a panic message displayed the same way that panic messages from Tcl will be displayed. .PP -\fBTcl_PanicVA\fR is the same as \fBTcl_Panic\fR except that instead of -taking a variable number of arguments it takes an argument list. Interfaces -using argument lists have been found to be nonportable in practice. This -function is deprecated and will be removed in Tcl 9.0. .SH "SEE ALSO" abort(3), printf(3), exec(n), format(n) .SH KEYWORDS diff --git a/doc/ParseArgs.3 b/doc/ParseArgs.3 index f29f161..6a5184f 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 int *objcPtr in/out +.AP "size_t \&| 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. @@ -31,7 +31,7 @@ The array of arguments to be parsed. Pointer to a variable that will hold the array of unprocessed arguments. Should be NULL if no return of unprocessed arguments is required. If \fIobjcPtr\fR is updated to a non-zero value, the array returned through this -must be deallocated using \fBckfree\fR. +must be deallocated using \fBTcl_Free\fR. .BE .SH DESCRIPTION .PP @@ -84,7 +84,7 @@ typedef struct { void *\fIsrcPtr\fR; void *\fIdstPtr\fR; const char *\fIhelpStr\fR; - ClientData \fIclientData\fR; + void *\fIclientData\fR; } \fBTcl_ArgvInfo\fR; .CE .PP @@ -127,7 +127,7 @@ have the following signature: .PP .CS typedef int (\fBTcl_ArgvFuncProc\fR)( - ClientData \fIclientData\fR, + void *\fIclientData\fR, Tcl_Obj *\fIobjPtr\fR, void *\fIdstPtr\fR); .CE @@ -149,7 +149,7 @@ function will have the following signature: .PP .CS typedef int (\fBTcl_ArgvGenFuncProc\fR)( - ClientData \fIclientData\fR, + void *\fIclientData\fR, Tcl_Interp *\fIinterp\fR, int \fIobjc\fR, Tcl_Obj *const *\fIobjv\fR, diff --git a/doc/ParseCmd.3 b/doc/ParseCmd.3 index 03b97f7..5235325 100644 --- a/doc/ParseCmd.3 +++ b/doc/ParseCmd.3 @@ -8,7 +8,7 @@ .so man.macros .BS .SH NAME -Tcl_ParseCommand, Tcl_ParseExpr, Tcl_ParseBraces, Tcl_ParseQuotedString, Tcl_ParseVarName, Tcl_ParseVar, Tcl_FreeParse, Tcl_EvalTokens, Tcl_EvalTokensStandard \- parse Tcl scripts and expressions +Tcl_ParseCommand, Tcl_ParseExpr, Tcl_ParseBraces, Tcl_ParseQuotedString, Tcl_ParseVarName, Tcl_ParseVar, Tcl_FreeParse, Tcl_EvalTokensStandard \- parse Tcl scripts and expressions .SH SYNOPSIS .nf \fB#include <tcl.h>\fR @@ -33,23 +33,19 @@ const char * .sp \fBTcl_FreeParse\fR(\fIusedParsePtr\fR) .sp -Tcl_Obj * -\fBTcl_EvalTokens\fR(\fIinterp, tokenPtr, numTokens\fR) -.sp int \fBTcl_EvalTokensStandard\fR(\fIinterp, tokenPtr, numTokens\fR) .SH ARGUMENTS .AS Tcl_Interp *usedParsePtr out .AP Tcl_Interp *interp out -For procedures other than \fBTcl_FreeParse\fR, \fBTcl_EvalTokens\fR -and \fBTcl_EvalTokensStandard\fR, used only for error reporting; +For procedures other than \fBTcl_FreeParse\fR and +\fBTcl_EvalTokensStandard\fR, used only for error reporting; if NULL, then no error messages are left after errors. -For \fBTcl_EvalTokens\fR and \fBTcl_EvalTokensStandard\fR, -determines the context for evaluating the -script and also is used for error reporting; must not be NULL. +For \fBTcl_EvalTokensStandard\fR, determines the context for evaluating +the script and also is used for error reporting; must not be NULL. .AP "const char" *start in Pointer to first character in string to parse. -.AP int numBytes in +.AP size_t 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. @@ -191,17 +187,6 @@ code with one of the values \fBTCL_OK\fR, \fBTCL_ERROR\fR, some other integer value originating in an extension. In addition, a result value or error message is left in \fIinterp\fR's result; it can be retrieved using \fBTcl_GetObjResult\fR. -.SS "DEPRECATED FUNCTIONS" -.PP -\fBTcl_EvalTokens\fR differs from \fBTcl_EvalTokensStandard\fR only in -the return convention used: it returns the result in a new Tcl_Obj. -The reference count of the value returned as result has been -incremented, so the caller must -invoke \fBTcl_DecrRefCount\fR when it is finished with the value. -If an error or other exception occurs while evaluating the tokens -(such as a reference to a non-existent variable) then the return value -is NULL and an error message is left in \fIinterp\fR's result. The use -of \fBTcl_EvalTokens\fR is deprecated. .SH "TCL_PARSE STRUCTURE" .PP \fBTcl_ParseCommand\fR, \fBTcl_ParseExpr\fR, \fBTcl_ParseBraces\fR, @@ -211,20 +196,20 @@ return parse information in two data structures, Tcl_Parse and Tcl_Token: .CS typedef struct Tcl_Parse { const char *\fIcommentStart\fR; - int \fIcommentSize\fR; + size_t \fIcommentSize\fR; const char *\fIcommandStart\fR; - int \fIcommandSize\fR; - int \fInumWords\fR; + size_t \fIcommandSize\fR; + size_t \fInumWords\fR; Tcl_Token *\fItokenPtr\fR; - int \fInumTokens\fR; + size_t \fInumTokens\fR; ... } \fBTcl_Parse\fR; typedef struct Tcl_Token { int \fItype\fR; const char *\fIstart\fR; - int \fIsize\fR; - int \fInumComponents\fR; + size_t \fIsize\fR; + size_t \fInumComponents\fR; } \fBTcl_Token\fR; .CE .PP @@ -464,12 +449,5 @@ There are additional fields in the Tcl_Parse structure after the \fBTcl_ParseCommand\fR, \fBTcl_ParseExpr\fR, \fBTcl_ParseBraces\fR, \fBTcl_ParseQuotedString\fR, and \fBTcl_ParseVarName\fR; they should not be referenced by code outside of these procedures. -.SH "REFERENCE COUNT MANAGEMENT" -.PP -The result of \fBTcl_EvalTokens\fR is an unshared value with a reference count -of 1; the caller of that function should call \fBTcl_DecrRefCount\fR on the -result value to dispose of it. (The equivalent with -\fBTcl_EvalTokenStandard\fR is just the interpreter result, which can be -retrieved with \fBTcl_GetObjResult\fR.) .SH KEYWORDS backslash substitution, braces, command, expression, parse, token, variable substitution diff --git a/doc/PkgRequire.3 b/doc/PkgRequire.3 index 77e73f1..8932135 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 int objc in +.AP size_t objc in Number of requirements. .AP Tcl_Obj* objv[] in Array of requirements. diff --git a/doc/Preserve.3 b/doc/Preserve.3 index c8f34a2..eb50a5f 100644 --- a/doc/Preserve.3 +++ b/doc/Preserve.3 @@ -21,7 +21,7 @@ Tcl_Preserve, Tcl_Release, Tcl_EventuallyFree \- avoid freeing storage while it \fBTcl_EventuallyFree\fR(\fIclientData, freeProc\fR) .SH ARGUMENTS .AS Tcl_FreeProc clientData -.AP ClientData clientData in +.AP void *clientData in Token describing structure to be freed or reallocated. Usually a pointer to memory for structure. .AP Tcl_FreeProc *freeProc in @@ -91,7 +91,7 @@ reasons, but the value is the same. .PP When the \fIclientData\fR argument to \fBTcl_EventuallyFree\fR refers to storage allocated and returned by a prior call to -\fBTcl_Alloc\fR, \fBckalloc\fR, or another function of the Tcl library, +\fBTcl_Alloc\fR or another function of the Tcl library, then the \fIfreeProc\fR argument should be given the special value of \fBTCL_DYNAMIC\fR. .PP diff --git a/doc/PrintDbl.3 b/doc/PrintDbl.3 index 896b6eb..42b258c 100644 --- a/doc/PrintDbl.3 +++ b/doc/PrintDbl.3 @@ -18,10 +18,7 @@ Tcl_PrintDouble \- Convert floating value to string .SH ARGUMENTS .AS Tcl_Interp *interp out .AP Tcl_Interp *interp in -Before Tcl 8.0, the \fBtcl_precision\fR variable in this interpreter -controlled the conversion. As of Tcl 8.0, this argument is ignored and -the conversion is controlled by the \fBtcl_precision\fR variable -that is now shared by all interpreters. +This argument is ignored. .AP double value in Floating-point value to be converted. .AP char *dst out @@ -41,9 +38,7 @@ so that it does not look like an integer. Where \fB%g\fR would generate an integer with no decimal point, \fBTcl_PrintDouble\fR adds .QW .0 . .PP -If the \fBtcl_precision\fR value is non-zero, the result will have -precisely that many digits of significance. If the value is zero -(the default), the result will have the fewest digits needed to +The result will have the fewest digits needed to represent the number in such a way that \fBTcl_NewDoubleObj\fR will generate the same number when presented with the given string. IEEE semantics of rounding to even apply to the conversion. diff --git a/doc/RecEvalObj.3 b/doc/RecEvalObj.3 index e68f4b5..0835904 100644 --- a/doc/RecEvalObj.3 +++ b/doc/RecEvalObj.3 @@ -31,7 +31,7 @@ the command at global level instead of the current stack level. .SH DESCRIPTION .PP \fBTcl_RecordAndEvalObj\fR is invoked to record a command as an event -on the history list and then execute it using \fBTcl_EvalObjEx\fR +on the history list and then execute it using \fBTcl_EvalObjEx\fR. It returns a completion code such as \fBTCL_OK\fR just like \fBTcl_EvalObjEx\fR, as well as a result value containing additional information (a result value or error message) diff --git a/doc/RegExp.3 b/doc/RegExp.3 index 40429c9..86c3a55 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 int index in +.AP size_t 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 int offset in +.AP size_t 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 int nmatches in +.AP size_t 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 \-1, then +information will be computed. If the value is TCL_INDEX_NONE, 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 { - int \fInsubs\fR; + size_t \fInsubs\fR; Tcl_RegExpIndices *\fImatches\fR; - long \fIextendStart\fR; + size_t \fIextendStart\fR; } \fBTcl_RegExpInfo\fR; .CE .PP @@ -355,8 +355,8 @@ follows: .PP .CS typedef struct Tcl_RegExpIndices { - long \fIstart\fR; - long \fIend\fR; + size_t \fIstart\fR; + size_t \fIend\fR; } \fBTcl_RegExpIndices\fR; .CE .PP diff --git a/doc/SaveInterpState.3 b/doc/SaveInterpState.3 index 804f9ec..da70c4d 100644 --- a/doc/SaveInterpState.3 +++ b/doc/SaveInterpState.3 @@ -6,12 +6,11 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.TH Tcl_SaveResult 3 8.1 Tcl "Tcl Library Procedures" +.TH Tcl_SaveInterpState 3 8.1 Tcl "Tcl Library Procedures" .so man.macros .BS .SH NAME -Tcl_SaveInterpState, Tcl_RestoreInterpState, Tcl_DiscardInterpState, -Tcl_SaveResult, Tcl_RestoreResult, Tcl_DiscardResult \- Save and restore the +Tcl_SaveInterpState, Tcl_RestoreInterpState, Tcl_DiscardInterpState \- Save and restore the state of an an interpreter. .SH SYNOPSIS .nf @@ -24,12 +23,6 @@ int \fBTcl_RestoreInterpState\fR(\fIinterp, state\fR) .sp \fBTcl_DiscardInterpState\fR(\fIstate\fR) -.sp -\fBTcl_SaveResult\fR(\fIinterp, savedPtr\fR) -.sp -\fBTcl_RestoreResult\fR(\fIinterp, savedPtr\fR) -.sp -\fBTcl_DiscardResult\fR(\fIsavedPtr\fR) .SH ARGUMENTS .AS Tcl_InterpState savedPtr .AP Tcl_Interp *interp in @@ -38,8 +31,6 @@ The interpreter for the operation. The return code for the state. .AP Tcl_InterpState state in A token for saved state. -.AP Tcl_SavedResult *savedPtr in -A pointer to storage for saved state. .BE .SH DESCRIPTION .PP @@ -59,27 +50,5 @@ returns the \fIstatus\fR originally passed in the corresponding call to If a saved state is not restored, \fBTcl_DiscardInterpState\fR must be called to release it. A token used to discard or restore state must not be used again. -.PP -\fBTcl_SaveResult\fR, \fBTcl_RestoreResult\fR, and \fBTcl_DiscardResult\fR are -deprecated. Instead use \fBTcl_SaveInterpState\fR, -\fBTcl_RestoreInterpState\fR, and \fBTcl_DiscardInterpState\fR, which are more -capable. -.PP -\fBTcl_SaveResult\fR moves the result of \fIinterp\fR to the location -\fIstatePtr\fR points to and returns the interpreter result to its initial -state. It does not save options such as \fB\-errorcode\fR or -\fB\-errorinfo\fR. -.PP -\fBTcl_RestoreResult\fR clears any existing result or error in \fIinterp\fR and -moves the result from \fIstatePtr\fR back to \fIinterp\fR. \fIstatePtr\fR is -then in an undefined state and must not be used until passed again to -\fBTcl_SaveResult\fR. -.PP -\fBTcl_DiscardResult\fR releases the state stored at \fBstatePtr\fR, which is -then in an undefined state and must not be used until passed again to -\fBTcl_SaveResult\fR. -.PP -If a saved result is not restored, \fBTcl_DiscardResult\fR must be called to -release it. .SH KEYWORDS result, state, interp diff --git a/doc/SetChanErr.3 b/doc/SetChanErr.3 index 473b61c..72157c6 100644 --- a/doc/SetChanErr.3 +++ b/doc/SetChanErr.3 @@ -87,14 +87,10 @@ the value. Which functions of a channel driver are allowed to use which bypass function is listed below, as is which functions of the public channel API may leave a messages in the bypass areas. -.IP \fBTcl_DriverCloseProc\fR -May use \fBTcl_SetChannelErrorInterp\fR, and only this function. .IP \fBTcl_DriverInputProc\fR May use \fBTcl_SetChannelError\fR, and only this function. .IP \fBTcl_DriverOutputProc\fR May use \fBTcl_SetChannelError\fR, and only this function. -.IP \fBTcl_DriverSeekProc\fR -May use \fBTcl_SetChannelError\fR, and only this function. .IP \fBTcl_DriverWideSeekProc\fR May use \fBTcl_SetChannelError\fR, and only this function. .IP \fBTcl_DriverSetOptionProc\fR diff --git a/doc/SetRecLmt.3 b/doc/SetRecLmt.3 index ec55794..0358cc9 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 <tcl.h>\fR .sp -int +size_t \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 int depth in +.AP size_t depth in New limit for nested calls to \fBTcl_Eval\fR for \fIinterp\fR. .BE @@ -29,7 +29,7 @@ New limit for nested calls to \fBTcl_Eval\fR for \fIinterp\fR. .PP At any given time Tcl enforces a limit on the number of recursive calls that may be active for \fBTcl_Eval\fR and related procedures -such as \fBTcl_GlobalEval\fR. +such as \fBTcl_EvalEx\fR. Any call to \fBTcl_Eval\fR that exceeds this depth is aborted with an error. By default the recursion limit is 1000. diff --git a/doc/SetResult.3 b/doc/SetResult.3 index 04a4b7f..42e3ce0 100644 --- a/doc/SetResult.3 +++ b/doc/SetResult.3 @@ -9,7 +9,7 @@ .so man.macros .BS .SH NAME -Tcl_SetObjResult, Tcl_GetObjResult, Tcl_SetResult, Tcl_GetStringResult, Tcl_AppendResult, Tcl_AppendResultVA, Tcl_AppendElement, Tcl_ResetResult, Tcl_TransferResult, Tcl_FreeResult \- manipulate Tcl result +Tcl_SetObjResult, Tcl_GetObjResult, Tcl_SetResult, Tcl_GetStringResult, Tcl_AppendResult, Tcl_AppendElement, Tcl_ResetResult, Tcl_TransferResult \- manipulate Tcl result .SH SYNOPSIS .nf \fB#include <tcl.h>\fR @@ -26,15 +26,11 @@ const char * .sp \fBTcl_AppendResult\fR(\fIinterp, result, result, ... , \fB(char *) NULL\fR) .sp -\fBTcl_AppendResultVA\fR(\fIinterp, argList\fR) -.sp \fBTcl_ResetResult\fR(\fIinterp\fR) .sp \fBTcl_TransferResult\fR(\fIsourceInterp, code, targetInterp\fR) .sp \fBTcl_AppendElement\fR(\fIinterp, element\fR) -.sp -\fBTcl_FreeResult\fR(\fIinterp\fR) .SH ARGUMENTS .AS Tcl_FreeProc sourceInterp out .AP Tcl_Interp *interp out @@ -143,11 +139,6 @@ extensions. Any number of \fIresult\fR arguments may be passed in a single call; the last argument in the list must be a NULL pointer. .PP -\fBTcl_AppendResultVA\fR is the same as \fBTcl_AppendResult\fR except that -instead of taking a variable number of arguments it takes an argument list. -Interfaces using argument lists have been found to be nonportable in practice. -This function is deprecated and will be removed in Tcl 9.0. -.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, @@ -184,22 +175,6 @@ single character or ends in the characters .QW " {" ) then no space is added. -.PP -\fBTcl_FreeResult\fR performs part of the work -of \fBTcl_ResetResult\fR. -It frees up the memory associated with \fIinterp\fR's result. -It also sets \fIinterp->freeProc\fR to zero, but does not -change \fIinterp->result\fR or clear error state. -\fBTcl_FreeResult\fR is most commonly used when a procedure -is about to replace one result value with another. -.SS "DIRECT ACCESS TO INTERP->RESULT" -.PP -It used to be legal for programs to -directly read and write \fIinterp->result\fR -to manipulate the interpreter result. The Tcl headers no longer -permit this access. C code still doing this must -be updated to use supported routines \fBTcl_GetObjResult\fR, -\fBTcl_GetStringResult\fR, \fBTcl_SetObjResult\fR, and \fBTcl_SetResult\fR. .SH "THE TCL_FREEPROC ARGUMENT TO TCL_SETRESULT" .PP \fBTcl_SetResult\fR's \fIfreeProc\fR argument specifies how diff --git a/doc/SplitList.3 b/doc/SplitList.3 index 863e322..6d9a9aa 100644 --- a/doc/SplitList.3 +++ b/doc/SplitList.3 @@ -20,16 +20,16 @@ int char * \fBTcl_Merge\fR(\fIargc, argv\fR) .sp -int +size_t \fBTcl_ScanElement\fR(\fIsrc, flagsPtr\fR) .sp -int +size_t \fBTcl_ScanCountedElement\fR(\fIsrc, length, flagsPtr\fR) .sp -int +size_t \fBTcl_ConvertElement\fR(\fIsrc, dst, flags\fR) .sp -int +size_t \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 int *argcPtr out +.AP "size_t \&| 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 int argc in +.AP size_t 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 int length in +.AP size_t 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,8 @@ For example, suppose that you have called \fBTcl_SplitList\fR with the following code: .PP .CS -int argc, code; +size_t argc; +int code; char *string; char **argv; \&... @@ -92,12 +93,13 @@ Then you should eventually free the storage with a call like the following: .PP .CS -Tcl_Free((char *) argv); +Tcl_Free(argv); .CE .PP \fBTcl_SplitList\fR normally returns \fBTCL_OK\fR, which means the list was -successfully parsed. -If there was a syntax error in \fIlist\fR, then \fBTCL_ERROR\fR is returned +successfully parsed. If \fIsizePtr\fR points to a variable of type +\fBint\fR and the list contains more than 2**31 key/value pairs, or there was +a syntax error in \fIlist\fR, then \fBTCL_ERROR\fR is returned and the interpreter's result will point to an error message describing the problem (if \fIinterp\fR was not NULL). If \fBTCL_ERROR\fR is returned then no memory is allocated and \fI*argvPtr\fR diff --git a/doc/SplitPath.3 b/doc/SplitPath.3 index c011194..10e84f5 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 int *argcPtr out +.AP "size_t \&| 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 int argc in +.AP size_t 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 -int argc; +size_t argc; char *path; char **argv; \&... @@ -72,7 +72,7 @@ Then you should eventually free the storage with a call like the following: .PP .CS -Tcl_Free((char *) argv); +Tcl_Free(argv); .CE .PP \fBTcl_JoinPath\fR is the inverse of \fBTcl_SplitPath\fR: it takes a diff --git a/doc/StaticLibrary.3 b/doc/StaticLibrary.3 index 9a77ab7..c5bd364 100644 --- a/doc/StaticLibrary.3 +++ b/doc/StaticLibrary.3 @@ -24,8 +24,8 @@ already been incorporated (i.e., the caller has already invoked the appropriate initialization procedure). NULL means the library has not yet been incorporated into any interpreter. .AP "const char" *prefix in -Prefix for library initialization function; should be properly -capitalized (first letter upper-case, all others lower-case). +Prefix for library initialization function. Normally in titlecase (first +letter upper-case, all others lower-case), but this is no longer required. .AP Tcl_LibraryInitProc *initProc in Procedure to invoke to incorporate this library into a trusted interpreter. @@ -70,8 +70,7 @@ initialization procedure to be invoked. \fBTcl_StaticLibrary\fR was named \fBTcl_StaticPackage\fR in Tcl 8.6 and earlier, but the old name is deprecated now. .PP -\fBTcl_StaticLibrary\fR can not be used in stub-enabled extensions. Its symbol -entry in the stub table is deprecated and it will be removed in Tcl 9.0. +\fBTcl_StaticLibrary\fR can not be used in stub-enabled extensions. .SH KEYWORDS initialization procedure, package, static linking .SH "SEE ALSO" diff --git a/doc/StringObj.3 b/doc/StringObj.3 index 6118a2d..2d41018 100644 --- a/doc/StringObj.3 +++ b/doc/StringObj.3 @@ -8,7 +8,7 @@ .so man.macros .BS .SH NAME -Tcl_NewStringObj, Tcl_NewUnicodeObj, Tcl_SetStringObj, Tcl_SetUnicodeObj, Tcl_GetStringFromObj, Tcl_GetString, Tcl_GetUnicodeFromObj, Tcl_GetUnicode, Tcl_GetUniChar, Tcl_GetCharLength, Tcl_GetRange, Tcl_AppendToObj, Tcl_AppendUnicodeToObj, Tcl_AppendObjToObj, Tcl_AppendStringsToObj, Tcl_AppendStringsToObjVA, Tcl_AppendLimitedToObj, Tcl_Format, Tcl_AppendFormatToObj, Tcl_ObjPrintf, Tcl_AppendPrintfToObj, Tcl_SetObjLength, Tcl_AttemptSetObjLength, Tcl_ConcatObj \- manipulate Tcl values as strings +Tcl_NewStringObj, Tcl_NewUnicodeObj, Tcl_SetStringObj, Tcl_SetUnicodeObj, Tcl_GetStringFromObj, Tcl_GetString, Tcl_GetUnicodeFromObj, Tcl_GetUnicode, Tcl_GetUniChar, Tcl_GetCharLength, Tcl_GetRange, Tcl_AppendToObj, Tcl_AppendUnicodeToObj, Tcl_AppendObjToObj, Tcl_AppendStringsToObj, Tcl_AppendLimitedToObj, Tcl_Format, Tcl_AppendFormatToObj, Tcl_ObjPrintf, Tcl_AppendPrintfToObj, Tcl_SetObjLength, Tcl_AttemptSetObjLength, Tcl_ConcatObj \- manipulate Tcl values as strings .SH SYNOPSIS .nf \fB#include <tcl.h>\fR @@ -40,7 +40,7 @@ Tcl_UniChar * int \fBTcl_GetUniChar\fR(\fIobjPtr, index\fR) .sp -int +size_t \fBTcl_GetCharLength\fR(\fIobjPtr\fR) .sp Tcl_Obj * @@ -59,9 +59,6 @@ void \fBTcl_AppendStringsToObj\fR(\fIobjPtr, string, string, ... \fB(char *) NULL\fR) .sp void -\fBTcl_AppendStringsToObjVA\fR(\fIobjPtr, argList\fR) -.sp -void \fBTcl_AppendLimitedToObj\fR(\fIobjPtr, bytes, length, limit, ellipsis\fR) .sp Tcl_Obj * @@ -90,38 +87,38 @@ 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 negative. (Applications needing null bytes +unless \fInumChars\fR is \fBTCL_INDEX_NONE\fR. (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 int length in +.AP size_t length in The number of bytes to copy from \fIbytes\fR when initializing, setting, or appending to a string value. -If negative, all bytes up to the first null are used. +If \fBTCL_INDEX_NONE\fR, 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 negative. -.AP int numChars in +unless \fInumChars\fR is \fBTCL_INDEX_NONE\fR. +.AP size_t numChars in The number of Unicode characters to copy from \fIunicode\fR when initializing, setting, or appending to a string value. -If negative, all characters up to the first null character are used. -.AP int index in +If \fBTCL_INDEX_NONE\fR, all characters up to the first null character are used. +.AP size_t index in The index of the Unicode character to return. -.AP int first in +.AP size_t first in The index of the first Unicode character in the Unicode range to be -returned as a new value. If negative, behave the same as if the +returned as a new value. If \fBTCL_INDEX_NONE\fR, behave the same as if the value was 0. -.AP int last in +.AP size_t last in The index of the last Unicode character in the Unicode range to be -returned as a new value. If negative, take all characters up to +returned as a new value. If \fBTCL_INDEX_NONE\fR, take all characters up to the last one available. .AP Tcl_Obj *objPtr in/out Points to a value to manipulate. .AP Tcl_Obj *appendObjPtr in The value to append to \fIobjPtr\fR in \fBTcl_AppendObjToObj\fR. -.AP int *lengthPtr out +.AP "size_t \&| 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 @@ -129,7 +126,7 @@ 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 int limit in +.AP size_t limit in Maximum number of bytes to be appended. .AP "const char" *ellipsis in Suffix to append when the limit leads to string truncation. @@ -138,11 +135,11 @@ If NULL is passed then the suffix is used. .AP "const char" *format in Format control string including % conversion specifiers. -.AP int objc in +.AP size_t objc in The number of elements to format or concatenate. .AP Tcl_Obj *objv[] in The array of values to format or concatenate. -.AP int newLength in +.AP size_t newLength in New length for the string value of \fIobjPtr\fR, not including the final null character. .BE @@ -191,7 +188,9 @@ Even in the limited situations where writing to this pointer is acceptable, one should take care to respect the copy-on-write semantics required by \fBTcl_Obj\fR's, with appropriate calls to \fBTcl_IsShared\fR and \fBTcl_DuplicateObj\fR prior to any -in-place modification of the string representation. +in-place modification of the string representation. If \fIlengthPtr\fR +points to an \fBint\fR variable, and the string has more than 2^31 bytes, +a panic will result. The procedure \fBTcl_GetString\fR is used in the common case where the caller does not need the length of the string representation. @@ -203,18 +202,19 @@ value as a Unicode string. This is given by the returned pointer and byte pointer is owned by the value manager and should not be modified by the caller. The procedure \fBTcl_GetUnicode\fR is used in the common case where the caller does not need the length of the unicode string -representation. +representation. If \fIlengthPtr\fR points to an \fBint\fR variable, +and the string has more than 2^31 unicode characters, a panic will result. .PP \fBTcl_GetUniChar\fR returns the \fIindex\fR'th character in the value's Unicode representation. If the index is out of range or it references a low surrogate preceded by a high surrogate, it returns -1; .PP \fBTcl_GetRange\fR returns a newly created value comprised of the -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 < 0, then -the returned string starts at the beginning of the value. If \fIlast\fR < 0, +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, then the returned string ends at the end of the value. .PP \fBTcl_GetCharLength\fR returns the number of characters (as opposed @@ -251,12 +251,6 @@ values may contain internal null characters). Any number of \fIstring\fR arguments may be provided, but the last argument must be a NULL pointer to indicate the end of the list. .PP -\fBTcl_AppendStringsToObjVA\fR is the same as \fBTcl_AppendStringsToObj\fR -except that instead of taking a variable number of arguments it takes an -argument list. Interfaces using argument lists have been found to be -nonportable in practice. This function is deprecated and will be removed -in Tcl 9.0. -.PP \fBTcl_AppendLimitedToObj\fR is similar to \fBTcl_AppendToObj\fR except that it imposes a limit on how many bytes are appended. This can be handy when the string to be appended might be @@ -269,7 +263,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 \fB-1\fR, all bytes up to the first zero byte are appended, +When \fIlength\fR is \fBTCL_INDEX_NONE\fR, 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. @@ -312,7 +306,7 @@ functionality is needed. .CS char buf[SOME_SUITABLE_LENGTH]; sprintf(buf, format, ...); -\fBTcl_NewStringObj\fR(buf, -1); +\fBTcl_NewStringObj\fR(buf, \fBTCL_INDEX_NONE\fR); .CE .PP but with greater convenience and no need to diff --git a/doc/TCL_MEM_DEBUG.3 b/doc/TCL_MEM_DEBUG.3 index 59af6ba..6bd03c9 100644 --- a/doc/TCL_MEM_DEBUG.3 +++ b/doc/TCL_MEM_DEBUG.3 @@ -34,7 +34,7 @@ and the Tcl \fBmemory\fR command can be used to validate and examine memory usage. .SH "GUARD ZONES" .PP -When memory debugging is enabled, whenever a call to \fBckalloc\fR is +When memory debugging is enabled, whenever a call to \fBTcl_Alloc\fR is made, slightly more memory than requested is allocated so the memory debugging code can keep track of the allocated memory, and eight-byte .QW "guard zones" @@ -44,7 +44,7 @@ C #define \fBLOW_GUARD_SIZE\fR and #define \fBHIGH_GUARD_SIZE\fR in the file \fIgeneric/tclCkalloc.c\fR \(em it can be extended if you suspect large overwrite problems, at some cost in performance.) A known pattern is written into the guard zones and, on -a call to \fBckfree\fR, the guard zones of the space being freed are +a call to \fBTcl_Free\fR, the guard zones of the space being freed are checked to see if either zone has been modified in any way. If one has been, the guard bytes and their new contents are identified, and a .QW "low guard failed" @@ -53,7 +53,7 @@ or message is issued. The .QW "guard failed" message includes the address of the memory packet and -the file name and line number of the code that called \fBckfree\fR. +the file name and line number of the code that called \fBTcl_Free\fR. This allows you to detect the common sorts of one-off problems, where not enough space was allocated to contain the data written, for example. @@ -66,15 +66,15 @@ suspect (or know) that corruption is occurring before the Tcl interpreter comes up far enough for you to issue commands, you can set \fBMEM_VALIDATE\fR define, recompile tclCkalloc.c and rebuild Tcl. This will enable memory validation from the first call to -\fBckalloc\fR, again, at a large performance impact. +\fBTcl_Alloc\fR, again, at a large performance impact. .PP If you are desperate and validating memory on every call to -\fBckalloc\fR and \fBckfree\fR is not enough, you can explicitly call +\fBTcl_Alloc\fR and \fBTcl_Free\fR is not enough, you can explicitly call \fBTcl_ValidateAllMemory\fR directly at any point. It takes a \fIchar *\fR and an \fIint\fR which are normally the filename and line number of the caller, but they can actually be anything you want. Remember to remove the calls after you find the problem. .SH "SEE ALSO" -ckalloc, memory, Tcl_ValidateAllMemory, Tcl_DumpActiveMemory +Tcl_Alloc, memory, Tcl_ValidateAllMemory, Tcl_DumpActiveMemory .SH KEYWORDS memory, debug diff --git a/doc/TclZlib.3 b/doc/TclZlib.3 index 4d06923..bd37f9c 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 int length in +.AP size_t length in The number of bytes in the array. .AP int mode in What mode to operate the stream in. Should be either @@ -107,9 +107,9 @@ 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 int 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 size_t count in +The maximum number of bytes to get from the stream, or TCL_INDEX_NONE 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. Note that this is \fInot a Tcl dictionary\fR, and it is recommended that this diff --git a/doc/Tcl_Main.3 b/doc/Tcl_Main.3 index 6a37cda..c208711 100644 --- a/doc/Tcl_Main.3 +++ b/doc/Tcl_Main.3 @@ -6,7 +6,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.TH Tcl_Main 3 8.4 Tcl "Tcl Library Procedures" +.TH Tcl_Main 3 9.0 Tcl "Tcl Library Procedures" .so man.macros .BS .SH NAME @@ -29,7 +29,7 @@ Tcl_Obj * \fBTcl_SetMainLoop\fR(\fImainLoopProc\fR) .SH ARGUMENTS .AS Tcl_MainLoopProc *mainLoopProc -.AP int argc in +.AP size_t argc in Number of elements in \fIargv\fR. .AP char *argv[] in Array of strings containing command-line arguments. On Windows, when @@ -203,6 +203,11 @@ procedure (if any) returns, \fBTcl_Main\fR will also evaluate the \fBexit\fR command. .PP \fBTcl_Main\fR can not be used in stub-enabled extensions. +.PP +The difference between Tcl_MainEx and Tcl_MainExW is that the arguments +are passed as characters or wide characters. When used in stub-enabled +embedders, the stubs table must be first initialized using one of +\fBTcl_InitSubsystems\fR, \fBTcl_SetPanicProc\fR, \fBTcl_FindExecutable\fR or \fBTclZipfs_AppHook\fR. .SH "REFERENCE COUNT MANAGEMENT" .PP \fBTcl_SetStartupScript\fR takes a value (or NULL) for its \fIpath\fR diff --git a/doc/Thread.3 b/doc/Thread.3 index 2005c93..51df5bb 100644 --- a/doc/Thread.3 +++ b/doc/Thread.3 @@ -67,7 +67,7 @@ Id of the thread waited upon. .AP Tcl_ThreadCreateProc *proc in This procedure will act as the \fBmain()\fR of the newly created thread. The specified \fIclientData\fR will be its sole argument. -.AP ClientData clientData in +.AP void *clientData in Arbitrary information. Passed as sole argument to the \fIproc\fR. .AP int stackSize in The size of the stack given to the new thread. @@ -208,7 +208,7 @@ value and then finishes. .CS static \fBTcl_ThreadCreateType\fR MyThreadImplFunc( - ClientData clientData) + void *clientData) { int i, limit = (int) clientData; for (i=0 ; i<limit ; i++) { @@ -223,7 +223,7 @@ would do this: .PP .CS int limit = 1000000000; -ClientData limitData = (void*)((intptr_t) limit); +void *limitData = (void*)((intptr_t) limit); Tcl_ThreadId id; \fI/* holds identity of thread created */\fR int result; diff --git a/doc/ToUpper.3 b/doc/ToUpper.3 index 37ebd2b..86d2f98 100644 --- a/doc/ToUpper.3 +++ b/doc/ToUpper.3 @@ -22,13 +22,13 @@ int int \fBTcl_UniCharToTitle\fR(\fIch\fR) .sp -int +size_t \fBTcl_UtfToUpper\fR(\fIstr\fR) .sp -int +size_t \fBTcl_UtfToLower\fR(\fIstr\fR) .sp -int +size_t \fBTcl_UtfToTitle\fR(\fIstr\fR) .SH ARGUMENTS .AS char *str in/out diff --git a/doc/TraceCmd.3 b/doc/TraceCmd.3 index 99914a6..8ae946e 100644 --- a/doc/TraceCmd.3 +++ b/doc/TraceCmd.3 @@ -13,7 +13,7 @@ Tcl_CommandTraceInfo, Tcl_TraceCommand, Tcl_UntraceCommand \- monitor renames an .nf \fB#include <tcl.h>\fR .sp -ClientData +void * \fBTcl_CommandTraceInfo(\fIinterp, cmdName, flags, proc, prevClientData\fB)\fR .sp int @@ -32,9 +32,9 @@ OR'ed collection of the values \fBTCL_TRACE_RENAME\fR and \fBTCL_TRACE_DELETE\fR. .AP Tcl_CommandTraceProc *proc in Procedure to call when specified operations occur to \fIcmdName\fR. -.AP ClientData clientData in +.AP void *clientData in Arbitrary argument to pass to \fIproc\fR. -.AP ClientData prevClientData in +.AP void *prevClientData in If non-NULL, gives last value returned by \fBTcl_CommandTraceInfo\fR, so this call will return information about next trace. If NULL, this call will return information about first trace. @@ -65,7 +65,7 @@ match the type \fBTcl_CommandTraceProc\fR: .PP .CS typedef void \fBTcl_CommandTraceProc\fR( - ClientData \fIclientData\fR, + void *\fIclientData\fR, Tcl_Interp *\fIinterp\fR, const char *\fIoldName\fR, const char *\fInewName\fR, @@ -74,7 +74,7 @@ typedef void \fBTcl_CommandTraceProc\fR( .PP The \fIclientData\fR and \fIinterp\fR parameters will have the same values as those passed to \fBTcl_TraceCommand\fR when the trace was -created. \fIClientData\fR typically points to an application-specific +created. \fIclientData\fR typically points to an application-specific data structure that describes what to do when \fIproc\fR is invoked. \fIOldName\fR gives the name of the command being renamed, and \fInewName\fR gives the name that the command is being renamed to (or diff --git a/doc/TraceVar.3 b/doc/TraceVar.3 index 5de6a44..90c90b9 100644 --- a/doc/TraceVar.3 +++ b/doc/TraceVar.3 @@ -5,7 +5,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.TH Tcl_TraceVar 3 8.7 Tcl "Tcl Library Procedures" +.TH Tcl_TraceVar 3 9.0 Tcl "Tcl Library Procedures" .so man.macros .BS .SH NAME @@ -24,13 +24,13 @@ int .sp \fBTcl_UntraceVar2(\fIinterp, name1, name2, flags, proc, clientData\fB)\fR .sp -ClientData +void * \fBTcl_VarTraceInfo(\fIinterp, varName, flags, proc, prevClientData\fB)\fR .sp -ClientData +void * \fBTcl_VarTraceInfo2(\fIinterp, name1, name2, flags, proc, prevClientData\fB)\fR .SH ARGUMENTS -.AS Tcl_VarTraceProc prevClientData +.AS void *prevClientData .AP Tcl_Interp *interp in Interpreter containing variable. .AP "const char" *varName in @@ -46,7 +46,7 @@ Not all flags are used by all procedures. See below for more information. .AP Tcl_VarTraceProc *proc in Procedure to invoke whenever one of the traced operations occurs. -.AP ClientData clientData in +.AP void *clientData in Arbitrary one-word value to pass to \fIproc\fR. .AP "const char" *name1 in Name of scalar or array variable (without array index). @@ -54,7 +54,7 @@ Name of scalar or array variable (without array index). For a trace on an element of an array, gives the index of the element. For traces on scalar variables or on whole arrays, is NULL. -.AP ClientData prevClientData in +.AP void *prevClientData in If non-NULL, gives last value returned by \fBTcl_VarTraceInfo\fR or \fBTcl_VarTraceInfo2\fR, so this call will return information about next trace. If NULL, this call will return information about first @@ -107,7 +107,7 @@ before an array set, but that will trigger write traces. \fBTCL_TRACE_RESULT_DYNAMIC\fR The result of invoking the \fIproc\fR is a dynamically allocated string that will be released by the Tcl library via a call to -\fBckfree\fR. Must not be specified at the same time as +\fBTcl_Free\fR. Must not be specified at the same time as \fBTCL_TRACE_RESULT_OBJECT\fR. .TP \fBTCL_TRACE_RESULT_OBJECT\fR @@ -124,7 +124,7 @@ It should have arguments and result that match the type .PP .CS typedef char *\fBTcl_VarTraceProc\fR( - ClientData \fIclientData\fR, + void *\fIclientData\fR, Tcl_Interp *\fIinterp\fR, const char *\fIname1\fR, const char *\fIname2\fR, @@ -134,12 +134,14 @@ typedef char *\fBTcl_VarTraceProc\fR( The \fIclientData\fR and \fIinterp\fR parameters will have the same values as those passed to \fBTcl_TraceVar\fR when the trace was created. -\fIClientData\fR typically points to an application-specific +\fIclientData\fR typically points to an application-specific data structure that describes what to do when \fIproc\fR is invoked. -\fIName1\fR and \fIname2\fR give the name of the traced variable -in the normal two-part form (see the description of \fBTcl_TraceVar2\fR -below for details). +\fIName1\fR and \fIname2\fR give the name of the variable that +triggered the callback in the normal two-part form (see the description +of \fBTcl_TraceVar2\fR below for details). In case \fIname1\fR is an +alias to an array element (created through facilities such as \fBupvar\fR), +\fIname2\fR holds the index of the array element, rather than NULL. \fIFlags\fR is an OR-ed combination of bits providing several pieces of information. One of the bits \fBTCL_TRACE_READS\fR, \fBTCL_TRACE_WRITES\fR, @@ -308,7 +310,7 @@ The return value must be a pointer to a static character string containing an error message, unless (\fIexactly\fR one of) the \fBTCL_TRACE_RESULT_DYNAMIC\fR and \fBTCL_TRACE_RESULT_OBJECT\fR flags is set, which specify that the result is -either a dynamic string (to be released with \fBckfree\fR) or a +either a dynamic string (to be released with \fBTcl_Free\fR) or a Tcl_Obj* (cast to char* and to be released with \fBTcl_DecrRefCount\fR) containing the error message. If a trace procedure returns an error, no further traces are @@ -333,7 +335,8 @@ The routine \fBTcl_InterpDeleted\fR is an important tool for this. When \fBTcl_InterpDeleted\fR returns 1, \fIproc\fR will not be able to invoke any scripts in \fIinterp\fR. You may encounter old code using a deprecated flag value \fBTCL_INTERP_DESTROYED\fR to signal this -condition, but any supported code should be converted to stop using it. +condition, but Tcl 9 no longer supports this. Any supported code +must be converted to stop using it. .PP A trace procedure can be called at any time, even when there are partially formed results stored in the interpreter. If diff --git a/doc/Translate.3 b/doc/Translate.3 index 38831d3..256baec 100644 --- a/doc/Translate.3 +++ b/doc/Translate.3 @@ -9,7 +9,7 @@ .so man.macros .BS .SH NAME -Tcl_TranslateFileName \- convert file name to native form and replace tilde with home directory +Tcl_TranslateFileName \- convert file name to native form .SH SYNOPSIS .nf \fB#include <tcl.h>\fR @@ -34,7 +34,7 @@ anything stored here. This utility procedure translates a file name to a platform-specific form which, after being converted to the appropriate encoding, is suitable for passing to the local operating system. In particular, it converts -network names into native form and does tilde substitution. +network names into native form. .PP However, with the advent of the newer \fBTcl_FSGetNormalizedPath\fR and \fBTcl_FSGetNativePath\fR, there is no longer any need to use this @@ -45,7 +45,7 @@ Finally \fBTcl_FSGetNativePath\fR does not require you to free anything afterwards. .PP If -\fBTcl_TranslateFileName\fR has to do tilde substitution or translate +\fBTcl_TranslateFileName\fR has to translate the name then it uses the dynamic string at \fI*bufferPtr\fR to hold the new string it generates. @@ -68,4 +68,4 @@ has its default empty value when \fBTcl_TranslateFileName\fR is invoked. .SH "SEE ALSO" filename(n) .SH KEYWORDS -file name, home directory, tilde, translate, user +file name, home directory, translate, user @@ -15,16 +15,16 @@ Tcl_UniChar, Tcl_UniCharToUtf, Tcl_UtfToUniChar, Tcl_UtfToChar16, Tcl_UtfToWChar .sp typedef ... \fBTcl_UniChar\fR; .sp -int +size_t \fBTcl_UniCharToUtf\fR(\fIch, buf\fR) .sp -int +size_t \fBTcl_UtfToUniChar\fR(\fIsrc, chPtr\fR) .sp -int +size_t \fBTcl_UtfToChar16\fR(\fIsrc, uPtr\fR) .sp -int +size_t \fBTcl_UtfToWChar\fR(\fIsrc, wPtr\fR) .sp char * @@ -55,19 +55,19 @@ int \fBTcl_UniCharLen\fR(\fIuniStr\fR) .sp int -\fBTcl_UniCharNcmp\fR(\fIucs, uct, numChars\fR) +\fBTcl_UniCharNcmp\fR(\fIucs, uct, uniLength\fR) .sp int -\fBTcl_UniCharNcasecmp\fR(\fIucs, uct, numChars\fR) +\fBTcl_UniCharNcasecmp\fR(\fIucs, uct, uniLength\fR) .sp int \fBTcl_UniCharCaseMatch\fR(\fIuniStr, uniPattern, nocase\fR) .sp int -\fBTcl_UtfNcmp\fR(\fIcs, ct, numChars\fR) +\fBTcl_UtfNcmp\fR(\fIcs, ct, length\fR) .sp int -\fBTcl_UtfNcasecmp\fR(\fIcs, ct, numChars\fR) +\fBTcl_UtfNcasecmp\fR(\fIcs, ct, length\fR) .sp int \fBTcl_UtfCharComplete\fR(\fIsrc, length\fR) @@ -93,7 +93,7 @@ int const char * \fBTcl_UtfAtIndex\fR(\fIsrc, index\fR) .sp -int +size_t \fBTcl_UtfBackslash\fR(\fIsrc, readPtr, dst\fR) .SH ARGUMENTS .AS "const Tcl_UniChar" *uniPattern in/out @@ -132,18 +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 int length in +.AP size_t length in The length of the UTF-8 string in bytes (not UTF-8 characters). If -negative, all bytes up to the first null byte are used. -.AP int uniLength in +TCL_INDEX_NONE, all bytes up to the first null byte are used. +.AP size_t 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 "unsigned long" numChars in -The number of characters to compare. .AP "const char" *start in Pointer to the beginning of a UTF-8 string. -.AP int index in +.AP size_t 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, @@ -168,11 +166,12 @@ can consume in a single call. .PP \fBTcl_UniCharToUtf\fR stores the character \fIch\fR as a UTF-8 string in starting at \fIbuf\fR. The return value is the number of bytes stored -in \fIbuf\fR. If ch is a high surrogate (range U+D800 - U+DBFF), then -the return value will be 1 and a single byte in the range 0xF0 - 0xF4 -will be stored. If you still want to produce UTF-8 output for it (even -though knowing it's an illegal code-point on its own), just call -\fBTcl_UniCharToUtf\fR again specifying ch = -1. +in \fIbuf\fR. The character \fIch\fR can be or'ed with the value TCL_COMBINE +to enable special behavior, compatible with Tcl 8.x. Then, if ch is a high +surrogate (range U+D800 - U+DBFF), the return value will be 1 and a single +byte in the range 0xF0 - 0xF4 will be stored. If \fIch\fR is a low surrogate +(range U+DC00 - U+DFFF), an attempt is made to combine the result with +the earlier produced bytes, resulting in a 4-byte UTF-8 byte sequence. .PP \fBTcl_UtfToUniChar\fR reads one UTF-8 character starting at \fIsrc\fR and stores it as a Tcl_UniChar in \fI*chPtr\fR. The return value is the @@ -219,7 +218,7 @@ the number of Unicode characters (not bytes) in that string. \fBTcl_UniCharNcmp\fR and \fBTcl_UniCharNcasecmp\fR correspond to \fBstrncmp\fR and \fBstrncasecmp\fR, respectively, for Unicode characters. They accept two null-terminated Unicode strings and the number of characters -to compare. Both strings are assumed to be at least \fInumChars\fR characters +to compare. Both strings are assumed to be at least \fIuniLength\fR characters long. \fBTcl_UniCharNcmp\fR compares the two strings character-by-character according to the Unicode character ordering. It returns an integer greater than, equal to, or less than 0 if the first string is greater than, equal @@ -233,7 +232,7 @@ be case sensitive and returns whether the string matches the pattern. .PP \fBTcl_UtfNcmp\fR corresponds to \fBstrncmp\fR for UTF-8 strings. It accepts two null-terminated UTF-8 strings and the number of characters -to compare. (Both strings are assumed to be at least \fInumChars\fR +to compare. (Both strings are assumed to be at least \fIlength\fR characters long.) \fBTcl_UtfNcmp\fR compares the two strings character-by-character according to the Unicode character ordering. It returns an integer greater than, equal to, or less than 0 if the @@ -255,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 negative, all bytes up to the first null byte are used. +length is TCL_INDEX_NONE, 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 @@ -300,17 +299,14 @@ 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 a negative \fIindex\fR is given or \fIindex\fR points +characters. If \fIindex\fR is TCL_INDEX_NONE 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, except if that would return -a pointer to the second byte of a valid 4-byte UTF-8 sequence, in which -case, \fBTcl_UtfToUniChar\fR will be called once more to find the end -of the sequence. If a negative \fIindex\fR is given, the returned pointer -points to the first character in the source string. +\fBTcl_UtfToUniChar\fR \fIindex\fR times. If \fIindex\fR is TCL_INDEX_NONE, +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 commands. It parses a backslash sequence and stores the properly formed diff --git a/doc/WrongNumArgs.3 b/doc/WrongNumArgs.3 index 533cb4f..b501d36 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 int objc in +.AP size_t objc in Number of leading arguments from \fIobjv\fR to include in error message. .AP "Tcl_Obj *const" objv[] in diff --git a/doc/binary.n b/doc/binary.n index 70f569b..c54bcc9 100644 --- a/doc/binary.n +++ b/doc/binary.n @@ -44,8 +44,9 @@ the range \eu0000\-\eu00FF. When encoding binary data as a readable string, the starting binary data is passed to the \fBbinary encode\fR command, together with the name of the encoding to use and any encoding-specific options desired. Data which has been -encoded can be converted back to binary form using \fBbinary decode\fR. The -following formats and options are supported. +encoded can be converted back to binary form using \fBbinary decode\fR. +The \fBbinary encode\fR command raises an error if the \fIdata\fR argument +is not binary data. The following formats and options are supported. .TP \fBbase64\fR . @@ -609,9 +610,9 @@ will return .PP The \fBbinary scan\fR command parses fields from a binary string, returning the number of conversions performed. \fIString\fR gives the -input bytes to be parsed (one byte per character, and characters not -representable as a byte have their high bits chopped) -and \fIformatString\fR indicates how to parse it. +input bytes to be parsed and \fIformatString\fR indicates how to parse it. +An error is raised if \fIstring\fR is anything other than a valid binary +data value. Each \fIvarName\fR gives the name of a variable; when a field is scanned from \fIstring\fR the result is assigned to the corresponding variable. diff --git a/doc/case.n b/doc/case.n deleted file mode 100644 index c48d634..0000000 --- a/doc/case.n +++ /dev/null @@ -1,60 +0,0 @@ -'\" -'\" Copyright (c) 1993 The Regents of the University of California. -'\" Copyright (c) 1994-1996 Sun Microsystems, Inc. -'\" -'\" See the file "license.terms" for information on usage and redistribution -'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" -.TH case n 7.0 Tcl "Tcl Built-In Commands" -.so man.macros -.BS -'\" Note: do not modify the .SH NAME line immediately below! -.SH NAME -case \- Evaluate one of several scripts, depending on a given value -.SH SYNOPSIS -\fBcase\fI string \fR?\fBin\fR? \fIpatList body \fR?\fIpatList body \fR...? -.sp -\fBcase\fI string \fR?\fBin\fR? {\fIpatList body \fR?\fIpatList body \fR...?} -.BE - -.SH DESCRIPTION -.PP -\fINote: the \fBcase\fI command is obsolete and is supported only -for backward compatibility. At some point in the future it may be -removed entirely. You should use the \fBswitch\fI command instead.\fR -.PP -The \fBcase\fR command matches \fIstring\fR against each of -the \fIpatList\fR arguments in order. -Each \fIpatList\fR argument is a list of one or -more patterns. If any of these patterns matches \fIstring\fR then -\fBcase\fR evaluates the following \fIbody\fR argument -by passing it recursively to the Tcl interpreter and returns the result -of that evaluation. -Each \fIpatList\fR argument consists of a single -pattern or list of patterns. Each pattern may contain any of the wild-cards -described under \fBstring match\fR. If a \fIpatList\fR -argument is \fBdefault\fR, the corresponding body will be evaluated -if no \fIpatList\fR matches \fIstring\fR. If no \fIpatList\fR argument -matches \fIstring\fR and no default is given, then the \fBcase\fR -command returns an empty string. -.PP -Two syntaxes are provided for the \fIpatList\fR and \fIbody\fR arguments. -The first uses a separate argument for each of the patterns and commands; -this form is convenient if substitutions are desired on some of the -patterns or commands. -The second form places all of the patterns and commands together into -a single argument; the argument must have proper list structure, with -the elements of the list being the patterns and commands. -The second form makes it easy to construct multi-line case commands, -since the braces around the whole list make it unnecessary to include a -backslash at the end of each line. -Since the \fIpatList\fR arguments are in braces in the second form, -no command or variable substitutions are performed on them; this makes -the behavior of the second form different than the first form in some -cases. - -.SH "SEE ALSO" -switch(n) - -.SH KEYWORDS -case, match, regular expression @@ -143,18 +143,12 @@ interface with the operating system, .RE .TP \fB\-eofchar\fR \fIchar\fR -.TP -\fB\-eofchar\fR \fB{\fIchar outChar\fB}\fR . \fIchar\fR signals the end of the data when it is encountered in the input. -For output, \fIoutChar\fR is added when the channel is closed. If \fIchar\fR -is the empty string, there is no special character that marks the end of the -data. For read-write channels, one end-of-file character for input and another -for output may be given. When only one end-of-file character is given it is -applied to input only. +If \fIchar\fR is the empty string, there is no special character that marks +the end of the data. -The default value is the empty string, except that under Windows the default -value for reading is Control-z (\ex1A). The acceptable range is \ex01 - +The default value is the empty string. The acceptable range is \ex01 - \ex7f. A value outside this range results in an error. .TP \fB\-translation\fR \fItranslation\fR diff --git a/doc/define.n b/doc/define.n index 19969da..f1e799b 100644 --- a/doc/define.n +++ b/doc/define.n @@ -588,7 +588,7 @@ for reading from slots is via \fBinfo class\fR and \fBinfo object\fR). .SH EXAMPLES This example demonstrates how to use both forms of the \fBoo::define\fR and \fBoo::objdefine\fR commands (they work in the same way), as well as -illustrating four of the subcommands of them. +illustrating four of their subcommands. .PP .CS oo::class create c diff --git a/doc/encoding.n b/doc/encoding.n index bbe197d..4e18798 100644 --- a/doc/encoding.n +++ b/doc/encoding.n @@ -38,22 +38,20 @@ system encoding is used. .VS "TCL8.7 TIP346, TIP607, TIP601" .PP .RS -The command does not fail on encoding errors. Instead, any not convertable bytes -(like incomplete UTF-8 sequences, see example below) are put as byte values into -the output stream. +If the option \fB-nocomplain\fR is given, the command does not fail on +encoding errors. Instead, any not convertable bytes (like incomplete UTF-8 + sequences, see example below) are put as byte values into the output stream. +If the option \fB-nocomplain\fR is not given, the command will fail with an +appropriate error message. .PP If the option \fB-failindex\fR with a variable name is given, the error reporting is changed in the following manner: in case of a conversion error, the position of the input byte causing the error is returned in the given variable. The return value of the command are the -converted characters until the first error position. +converted characters until the first error position. No error condition is raised. In case of no error, the value \fI-1\fR is written to the variable. This option may not be used together with \fB-nocomplain\fR. .PP -The option \fB-nocomplain\fR has no effect and is available for compatibility with -TCL 9. In TCL 9, the encoding command fails with an error on any encoding issue. -This switch restores the TCL8.7 behaviour. -.PP The \fB-strict\fR option followes more strict rules in conversion. Currently, only the sequence \fB\\xC0\\x80\fR in \fButf-8\fR encoding is disallowed. Additional rules may follow. @@ -71,9 +69,12 @@ specified, the current system encoding is used. .VS "TCL8.7 TIP346, TIP607, TIP601" .PP .RS -The command does not fail on encoding errors. Instead, the replacement character -\fB?\fR is output for any not representable character (like the dot \fB\\U2022\fR +If the option \fB-nocomplain\fR is given, the command does not fail on +encoding errors. Instead, the replacement character \fB?\fR is output +for any not representable character (like the dot \fB\\U2022\fR in \fBiso-8859-1\fR encoding, see example below). +If the option \fB-nocomplain\fR is not given, the command will fail with an +appropriate error message. .PP If the option \fB-failindex\fR with a variable name is given, the error reporting is changed in the following manner: @@ -83,10 +84,6 @@ converted bytes until the first error position. No error condition is raised. In case of no error, the value \fI-1\fR is written to the variable. This option may not be used together with \fB-nocomplain\fR. .PP -The option \fB-nocomplain\fR has no effect and is available for compatibility with -TCL 9. In TCL 9, the encoding command fails with an error on any encoding issue. -This switch restores the TCL8.7 behaviour. -.PP The \fB-strict\fR option followes more strict rules in conversion. Currently, it has no effect but may be used in future to add additional encoding checks. .VE "TCL8.7 TIP346, TIP607, TIP601" @@ -146,8 +143,7 @@ Example 3: return the incomplete UTF-8 sequence by raw bytes: .CS % set s [\fBencoding convertfrom\fR -nocomplain utf-8 "A\exC3"] .CE -The result is "A" followed by the byte \exC3. The option \fB-nocomplain\fR -has no effect, but assures to get the same result with TCL9. +The result is "A" followed by the byte \exC3. .PP Example 4: detect the error location while transforming to ISO8859-1 (ISO-Latin 1): @@ -165,8 +161,6 @@ Example 5: replace a not representable character by the replacement character: % set s [\fBencoding convertto\fR -nocomplain utf-8 "A\eu0141"] A? .CE -The option \fB-nocomplain\fR has no effect, but assures to get the same result -with TCL9. .VE "TCL8.7 TIP346, TIP607, TIP601" .PP .SH "SEE ALSO" @@ -198,7 +198,7 @@ the commands in the pipeline will go to the application's standard error file unless redirected. .PP The first word in each command is taken as the command name; -tilde-substitution is performed on it, and if the result contains +if the result contains no slashes then the directories in the PATH environment variable are searched for an executable by the given name. @@ -62,9 +62,7 @@ A \fBnumeric value\fR . Either integer or floating-point. The first two characters of an integer may also be \fB0d\fR for decimal, \fB0b\fR for binary, \fB0o\fR for octal or -\fB0x\fR for hexadicimal. For compatibility with older Tcl releases, an -operand that begins with \fB0\fR is interpreted as an octal integer even if the -second character is not \fBo\fR. +\fB0x\fR for hexadicimal. .PP A floating-point number may be take any of several common decimal formats, and may use the decimal point \fB.\fR, diff --git a/doc/fconfigure.n b/doc/fconfigure.n index 9061161..912702f 100644 --- a/doc/fconfigure.n +++ b/doc/fconfigure.n @@ -102,40 +102,32 @@ system, as returned by \fBencoding system\fR. .RE .TP \fB\-eofchar\fR \fIchar\fR -.TP -\fB\-eofchar\fR \fB{\fIchar outChar\fB}\fR . This option supports DOS file systems that use Control-z (\ex1A) as an end of file marker. If \fIchar\fR is not an empty string, then this -character signals end-of-file when it is encountered during input. For -output, the end-of-file character is output when the channel is closed. +character signals end-of-file when it is encountered during input. If \fIchar\fR is the empty string, then there is no special end of file -character marker. For read-write channels, a two-element list specifies -the end of file marker for input and output, respectively. As a -convenience, when setting the end-of-file character for a read-write -channel you can specify a single value that will apply to both reading -and writing. When querying the end-of-file character of a read-write -channel, a two-element list will always be returned. The default value -for \fB\-eofchar\fR is the empty string in all cases except for files -under Windows. In that case the \fB\-eofchar\fR is Control-z (\ex1A) for -reading and the empty string for writing. +character marker. The default value for \fB\-eofchar\fR is the empty +string. The acceptable range for \fB\-eofchar\fR values is \ex01 - \ex7F; attempting to set \fB\-eofchar\fR to a value outside of this range will generate an error. -.VS "TCL8.7 TIP633" +.VS "TCL9.0 TIP633" .TP \fB\-nocomplainencoding\fR \fIbool\fR . Reporting mode of encoding errors. If set to a \fItrue\fR value, encoding errors are resolved by a replacement character (output) or verbatim bytes (input). No error is thrown. -This is the only available mode in Tcl 8.7. +If set to a \fIfalse\fR value, errors are thrown in case of encoding errors. .RS .PP -Starting from TCL 9.0, this value may be set to a \fIfalse\fR value to throw errors -in case of encoding errors. +The default value is \fIfalse\fR starting from TCL 9.0 and \fItrue\fR on TCL 8.7. +This option was introduced with TCL 8.7 and has the fix value \fItrue\fR. +.PP +See the \fI\-nocomplain\fR option of the \fBencoding\fR command for more information. .RE -.VE "TCL8.7 TIP633" +.VE "TCL9.0 TIP633" .VS "TCL8.7 TIP346" .TP \fB\-strictencoding\fR \fIbool\fR @@ -303,10 +295,10 @@ set data [read $f $numDataBytes] close $f .CE .SH "SEE ALSO" -close(n), flush(n), gets(n), open(n), puts(n), read(n), socket(n), +close(n), encoding(n), flush(n), gets(n), open(n), puts(n), read(n), socket(n), Tcl_StandardChannels(3) .SH KEYWORDS -blocking, buffering, carriage return, end of line, flushing, linemode, +blocking, buffering, carriage return, end of line, encoding, flushing, linemode, newline, nonblocking, platform, translation, encoding, filter, byte array, binary '\" Local Variables: @@ -16,12 +16,10 @@ file \- Manipulate file names and attributes .BE .SH DESCRIPTION .PP -This command provides several operations on a file's name or attributes. -\fIName\fR is the name of a file; if it starts with a tilde, then tilde -substitution is done before executing the command (see the manual entry for -\fBfilename\fR for details). \fIOption\fR indicates what to do with the -file name. Any unique abbreviation for \fIoption\fR is acceptable. The -valid options are: +This command provides several operations on a file's name or attributes. The +\fIname\fR argument is the name of a file in most cases. The \fIoption\fR +argument indicates what to do with the file name. Any unique abbreviation for +\fIoption\fR is acceptable. The valid options are: .TP \fBfile atime \fIname\fR ?\fItime\fR? . @@ -145,21 +143,6 @@ returned. For example, .CE .PP returns \fBc:/\fR. -.PP -Note that tilde substitution will only be -performed if it is necessary to complete the command. For example, -.PP -.CS -\fBfile dirname\fR ~/src/foo.c -.CE -.PP -returns \fB~/src\fR, whereas -.PP -.CS -\fBfile dirname\fR ~ -.CE -.PP -returns \fB/home\fR (or something similar). .RE .TP \fBfile executable \fIname\fR @@ -397,19 +380,6 @@ Returns a list whose elements are the path components in \fIname\fR. The first element of the list will have the same path type as \fIname\fR. All other elements will be relative. Path separators will be discarded unless they are needed to ensure that an element is unambiguously relative. -For example, under Unix -.RS -.PP -.CS -\fBfile split\fR /foo/~bar/baz -.CE -.PP -returns -.QW \fB/\0\0foo\0\0./~bar\0\0baz\fR -to ensure that later commands -that use the third component do not attempt to perform tilde -substitution. -.RE .TP \fBfile stat \fIname ?varName?\fR . @@ -507,11 +477,11 @@ native APIs and external programs that require a filename. Returns the result of performing tilde substitution on \fIname\fR. If the name begins with a tilde, then the file name will be interpreted as if the first element is replaced with the location of the home directory for the given user. -If the tilde is followed immediately by a path separator, the \fBHOME\fR +If the tilde is followed immediately by a path separator, the \fB$HOME\fR environment variable is substituted. Otherwise the characters between the tilde and the next separator are taken as a user name, which is used to retrieve the user's home directory for substitution. An error is raised if the -\fBHOME\fR environment variable or user does not exist. +\fB$HOME\fR environment variable or user does not exist. .RS .PP If the file name does not begin with a tilde, it is returned unmodified. diff --git a/doc/filename.n b/doc/filename.n index 335d8c7..628b2bb 100644 --- a/doc/filename.n +++ b/doc/filename.n @@ -119,26 +119,6 @@ Volume-relative path to a file \fBfoo\fR in the root directory of the current volume. This is not a valid UNC path, so the assumption is that the extra backslashes are superfluous. .RE -.SH "TILDE SUBSTITUTION" -.PP -In addition to the file name rules described above, Tcl also supports -\fIcsh\fR-style tilde substitution. If a file name starts with a tilde, -then the file name will be interpreted as if the first element is -replaced with the location of the home directory for the given user. If -the tilde is followed immediately by a separator, then the \fB$HOME\fR -environment variable is substituted. Otherwise the characters between -the tilde and the next separator are taken as a user name, which is used -to retrieve the user's home directory for substitution. This works on -Unix, MacOS X and Windows (except very old releases). -.PP -Old Windows platforms do not support tilde substitution when a user name -follows the tilde. On these platforms, attempts to use a tilde followed -by a user name will generate an error that the user does not exist when -Tcl attempts to interpret that part of the path or otherwise access the -file. The behaviour of these paths when not trying to interpret them is -the same as on Unix. File names that have a tilde without a user name -will be correctly substituted using the \fB$HOME\fR environment -variable, just like for Unix. .SH "PORTABILITY ISSUES" .PP Not all file systems are case sensitive, so scripts should avoid code diff --git a/doc/fpclassify.n b/doc/fpclassify.n index 22d365e..b6eb0e6 100644 --- a/doc/fpclassify.n +++ b/doc/fpclassify.n @@ -76,7 +76,7 @@ This command depends on the \fBfpclassify\fR() C macro conforming to (i.e., to ISO/IEC 9899:1999). .SH COPYRIGHT .nf -Copyright \(co 2018 by Kevin B. Kenny <kennykb@acm.org>. All rights reserved +Copyright \(co 2018 Kevin B. Kenny <kennykb@acm.org>. All rights reserved .fi '\" Local Variables: '\" mode: nroff @@ -46,8 +46,8 @@ separators. .TP \fB\-nocomplain\fR . -Allows an empty list to be returned without error; without this -switch an error is returned if the result list would be empty. +Allows an empty list to be returned without error; This is the +default behavior in Tcl 9.0, so this switch has no effect any more. .TP \fB\-path\fR \fIpathPrefix\fR . @@ -185,16 +185,6 @@ command if you want the list sorted). Second, \fBglob\fR only returns the names of files that actually exist; in csh no check for existence is made unless a pattern contains a ?, *, or [] construct. -.LP -When the \fBglob\fR command returns relative paths whose filenames -start with a tilde -.QW ~ -(for example through \fBglob *\fR or \fBglob \-tails\fR, the returned -list will not quote the tilde with -.QW ./ . -This means care must be taken if those names are later to -be used with \fBfile join\fR, to avoid them being interpreted as -absolute paths pointing to a given user's home directory. .SH "WINDOWS PORTABILITY ISSUES" .PP For Windows UNC names, the servername and sharename components of the path diff --git a/doc/interp.n b/doc/interp.n index 08bed1c..7037c65 100644 --- a/doc/interp.n +++ b/doc/interp.n @@ -375,10 +375,6 @@ Returns a Tcl list of the names of all the child interpreters associated with the interpreter identified by \fIpath\fR. If \fIpath\fR is omitted, the invoking interpreter is used. .TP -\fBinterp\fR \fBslaves\fR ?\fIpath\fR? -. -Synonym for . \fBinterp\fR \fBchildren\fR ?\fIpath\fR? -.TP \fBinterp\fR \fBtarget\fR \fIpath alias\fR . Returns a Tcl list describing the target interpreter for an alias. The @@ -38,17 +38,14 @@ Tcl interpreter. The name of the initialization procedure is determined by \fIprefix\fR and whether or not the target interpreter is a safe one. For normal interpreters the name of the initialization -procedure will have the form \fIpfx\fB_Init\fR, where \fIpfx\fR -is the same as \fIprefix\fR except that the first letter is -converted to upper case and all other letters -are converted to lower case. For example, if \fIprefix\fR is -\fBfoo\fR or \fBFOo\fR, the initialization procedure's name will +procedure will have the form \fIprefix\fB_Init\fR. For example, if +\fIprefix\fR is \fBFoo\fR, the initialization procedure's name will be \fBFoo_Init\fR. .PP If the target interpreter is a safe interpreter, then the name -of the initialization procedure will be \fIpfx\fB_SafeInit\fR -instead of \fIpfx\fB_Init\fR. -The \fIpfx\fB_SafeInit\fR function should be written carefully, so that it +of the initialization procedure will be \fIprefix\fB_SafeInit\fR +instead of \fIprefix\fB_Init\fR. +The \fIprefix\fB_SafeInit\fR function should be written carefully, so that it initializes the safe interpreter only with partial functionality provided by the library that is safe for use by untrusted code. For more information on Safe\-Tcl, see the \fBsafe\fR manual entry. @@ -84,13 +81,11 @@ If \fIfileName\fR is an empty string, then \fIprefix\fR must be specified. .PP If \fIprefix\fR is omitted or specified as an empty string, -Tcl tries to guess the prefix. This may be done differently on -different platforms. The default guess, which is used on most -UNIX platforms, is to take the last element of +Tcl tries to guess the prefix by taking the last element of \fIfileName\fR, strip off the first three characters if they -are \fBlib\fR, then strip off the next three characters if they -are \fBtcl\fR, and use any following alphabetic and -underline characters, converted to titlecase as the prefix. +are \fBlib\fR, then strip off the next three characters if +they are \fBtcl9\fR, and use any following wordchars but not digits, +converted to titlecase as the prefix. For example, the command \fBload libxyz4.2.so\fR uses the prefix \fBXyz\fR and the command \fBload bin/last.so {}\fR uses the prefix \fBLast\fR. diff --git a/doc/lsearch.n b/doc/lsearch.n index dc6d1f7..c8d2ec9 100644 --- a/doc/lsearch.n +++ b/doc/lsearch.n @@ -65,8 +65,8 @@ These options may be given with all matching styles. . Changes the result to be the list of all matching indices (or all matching values if \fB\-inline\fR is specified as well.) If indices are returned, the -indices will be in numeric order. If values are returned, the order of the -values will be the order of those values within the input \fIlist\fR. +indices will be in ascending numeric order. If values are returned, the order +of the values will be the order of those values within the input \fIlist\fR. .TP \fB\-inline\fR . @@ -116,6 +116,8 @@ The indicated return value also becomes the new value of \fIx\fR \fBlset\fR x {2 1} j \fI\(-> {a b c} {d e f} {g j i}\fR \fBlset\fR x {2 3} j + \fI\(-> {a b c} {d e f} {g h i j}\fR +\fBlset\fR x {2 4} j \fI\(-> list index out of range\fR .CE .PP diff --git a/doc/mathfunc.n b/doc/mathfunc.n index 004b7e3..805cf82 100644 --- a/doc/mathfunc.n +++ b/doc/mathfunc.n @@ -124,10 +124,7 @@ of which work solely with floating-point numbers unless otherwise noted: In addition to these predefined functions, applications may define additional functions by using \fBproc\fR (or any other method, such as \fBinterp alias\fR or \fBTcl_CreateObjCommand\fR) to define -new commands in the \fBtcl::mathfunc\fR namespace. In addition, an -obsolete interface named \fBTcl_CreateMathFunc\fR() is available to -extensions that are written in C. The latter interface is not recommended -for new implementations. +new commands in the \fBtcl::mathfunc\fR namespace. .SS "DETAILED DEFINITIONS" .TP \fBabs \fIarg\fR diff --git a/doc/memory.n b/doc/memory.n index 4d6a7d1..dc58502 100644 --- a/doc/memory.n +++ b/doc/memory.n @@ -25,7 +25,7 @@ Write a list of all currently allocated memory to the specified \fIfile\fR. .TP \fBmemory break_on_malloc\fR \fIcount\fR . -After the \fIcount\fR allocations have been performed, \fBckalloc\fR +After the \fIcount\fR allocations have been performed, \fBTcl_Alloc\fR outputs a message to this effect and that it is now attempting to enter the C debugger. Tcl will then issue a \fISIGINT\fR signal against itself. If you are running Tcl under a C debugger, it should then enter the debugger @@ -35,8 +35,8 @@ command mode. . Returns a report containing the total allocations and frees since Tcl began, the current packets allocated (the current -number of calls to \fBckalloc\fR not met by a corresponding call -to \fBckfree\fR), the current bytes allocated, and the maximum number +number of calls to \fBTcl_Alloc\fR not met by a corresponding call +to \fBTcl_Free\fR), the current bytes allocated, and the maximum number of packets and bytes allocated. .TP \fBmemory init \fR[\fBon\fR|\fBoff\fR] @@ -59,34 +59,34 @@ that memory is properly cleaned up during process exit. .TP \fBmemory tag\fR \fIstring\fR . -Each packet of memory allocated by \fBckalloc\fR can have associated +Each packet of memory allocated by \fBTcl_Alloc\fR can have associated with it a string-valued tag. In the lists of allocated memory generated by \fBmemory active\fR and \fBmemory onexit\fR, the tag for each packet is printed along with other information about the packet. The \fBmemory tag\fR command sets the tag value for subsequent calls -to \fBckalloc\fR to be \fIstring\fR. +to \fBTcl_Alloc\fR to be \fIstring\fR. .TP \fBmemory trace \fR[\fBon\fR|\fBoff\fR] . Turns memory tracing on or off. When memory tracing is on, every call -to \fBckalloc\fR causes a line of trace information to be written to -\fIstderr\fR, consisting of the word \fIckalloc\fR, followed by the +to \fBTcl_Alloc\fR causes a line of trace information to be written to +\fIstderr\fR, consisting of the word \fITcl_Alloc\fR, followed by the address returned, the amount of memory allocated, and the C filename and line number of the code performing the allocation. For example: .RS .PP .CS -ckalloc 40e478 98 tclProc.c 1406 +Tcl_Alloc 40e478 98 tclProc.c 1406 .CE .PP -Calls to \fBckfree\fR are traced in the same manner. +Calls to \fBTcl_Free\fR are traced in the same manner. .RE .TP \fBmemory trace_on_at_malloc\fR \fIcount\fR . -Enable memory tracing after \fIcount\fR \fBckalloc\fRs have been performed. +Enable memory tracing after \fIcount\fR \fBTcl_Alloc\fRs have been performed. For example, if you enter \fBmemory trace_on_at_malloc 100\fR, -after the 100th call to \fBckalloc\fR, memory trace information will begin +after the 100th call to \fBTcl_Alloc\fR, memory trace information will begin being displayed for all allocations and frees. Since there can be a lot of memory activity before a problem occurs, judicious use of this option can reduce the slowdown caused by tracing (and the amount of trace information @@ -97,17 +97,17 @@ occurred since Tcl started is printed on a guard zone failure. \fBmemory validate \fR[\fBon\fR|\fBoff\fR] . Turns memory validation on or off. When memory validation is enabled, -on every call to \fBckalloc\fR or \fBckfree\fR, the guard zones are +on every call to \fBTcl_Alloc\fR or \fBTcl_Free\fR, the guard zones are checked for every piece of memory currently in existence that was -allocated by \fBckalloc\fR. This has a large performance impact and +allocated by \fBTcl_Alloc\fR. This has a large performance impact and should only be used when overwrite problems are strongly suspected. The advantage of enabling memory validation is that a guard zone -overwrite can be detected on the first call to \fBckalloc\fR or -\fBckfree\fR after the overwrite occurred, rather than when the +overwrite can be detected on the first call to \fBTcl_Alloc\fR or +\fBTcl_Free\fR after the overwrite occurred, rather than when the specific memory with the overwritten guard zone(s) is freed, which may occur long after the overwrite occurred. .SH "SEE ALSO" -ckalloc, ckfree, Tcl_ValidateAllMemory, Tcl_DumpActiveMemory, TCL_MEM_DEBUG +Tcl_Alloc, Tcl_Free, Tcl_ValidateAllMemory, Tcl_DumpActiveMemory, TCL_MEM_DEBUG .SH KEYWORDS memory, debug '\"Local Variables: diff --git a/doc/re_syntax.n b/doc/re_syntax.n index ef8c570..f68135e 100644 --- a/doc/re_syntax.n +++ b/doc/re_syntax.n @@ -390,7 +390,7 @@ value of \fBU+\fI10ffff\fR. .TP \fB\ev\fR . -vertical tab, as in C are all available. +vertical tab, as in C .TP \fB\ex\fIhh\fR . @@ -224,12 +224,10 @@ set string "#08D03F" \fBscan\fR $string "#%2x%2x%2x" r g b .CE .PP -Parse a \fIHH:MM\fR time string, noting that this avoids problems with -octal numbers by forcing interpretation as decimals (if we did not -care, we would use the \fB%i\fR conversion instead): +Parse a \fIHH:MM\fR time string: .PP .CS -set string "08:08" ;# *Not* octal! +set string "08:08" if {[\fBscan\fR $string "%d:%d" hours minutes] != 2} { error "not a valid time string" } diff --git a/doc/string.n b/doc/string.n index aefe485..5c493f5 100644 --- a/doc/string.n +++ b/doc/string.n @@ -383,42 +383,8 @@ for which \fBstring is space\fR returns 1, and "\e0"). These subcommands are currently supported, but are likely to go away in a future release as their functionality is either virtually never used or highly misleading. -.TP -\fBstring bytelength \fIstring\fR -. -Returns a decimal string giving the number of bytes used to represent -\fIstring\fR in memory when encoded as Tcl's internal modified UTF\-8; -Tcl may use other encodings for \fIstring\fR as well, and does not -guarantee to only use a single encoding for a particular \fIstring\fR. -Because UTF\-8 uses a variable number of bytes to represent Unicode -characters, the byte length will not be the same as the character -length in general. The cases where a script cares about the byte -length are rare. .RS .PP -In almost all cases, you should use the -\fBstring length\fR operation (including determining the length of a -Tcl byte array value). Refer to the \fBTcl_NumUtfChars\fR manual -entry for more details on the UTF\-8 representation. -.PP -Formally, the \fBstring bytelength\fR operation returns the content of -the \fIlength\fR field of the \fBTcl_Obj\fR structure, after calling -\fBTcl_GetString\fR to ensure that the \fIbytes\fR field is populated. -This is highly unlikely to be useful to Tcl scripts, as Tcl's internal -encoding is not strict UTF\-8, but rather a modified WTF\-8 with a -denormalized NUL (identical to that used in a number of places by -Java's serialization mechanism) to enable basic processing with -non-Unicode-aware C functions. As this representation should only -ever be used by Tcl's implementation, the number of bytes used to -store the representation is of very low value (except to C extension -code, which has direct access for the purpose of memory management, -etc.) -.PP -\fICompatibility note:\fR This subcommand is deprecated and will -be removed in Tcl 9.0. It is better to use the \fBencoding convertto\fR -command to convert a string to a known encoding (e.g. "utf-8" or "cesu-8") -and then apply \fBstring length\fR to that. -.PP .CS \fBstring length\fR [encoding convertto utf-8 $theString] .CE diff --git a/doc/tclvars.n b/doc/tclvars.n index 4d1413c..8214473 100644 --- a/doc/tclvars.n +++ b/doc/tclvars.n @@ -10,7 +10,7 @@ .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME -argc, argv, argv0, auto_path, env, errorCode, errorInfo, tcl_interactive, tcl_library, tcl_nonwordchars, tcl_patchLevel, tcl_pkgPath, tcl_platform, tcl_precision, tcl_rcFileName, tcl_traceCompile, tcl_traceExec, tcl_wordchars, tcl_version \- Variables used by Tcl +argc, argv, argv0, auto_path, env, errorCode, errorInfo, tcl_interactive, tcl_library, tcl_nonwordchars, tcl_patchLevel, tcl_pkgPath, tcl_platform, tcl_rcFileName, tcl_traceCompile, tcl_traceExec, tcl_wordchars, tcl_version \- Variables used by Tcl .BE .SH DESCRIPTION .PP @@ -354,70 +354,6 @@ This gives the size of the native-machine word in bytes (strictly, it is same as the result of evaluating \fIsizeof(long)\fR in C.) .RE .TP -\fBtcl_precision\fR -. -This variable controls the number of digits to generate -when converting floating-point values to strings. It defaults -to 0. \fIApplications should not change this value;\fR it is -provided for compatibility with legacy code. -.PP -.RS -The default value of 0 is special, meaning that Tcl should -convert numbers using as few digits as possible while still -distinguishing any floating point number from its nearest -neighbours. It differs from using an arbitrarily high value -for \fItcl_precision\fR in that an inexact number like \fI1.4\fR -will convert as \fI1.4\fR rather than \fI1.3999999999999999\fR -even though the latter is nearer to the exact value of the -binary number. -.RE -.PP -.RS -If \fBtcl_precision\fR is not zero, then when Tcl converts a floating -point number, it creates a decimal representation of at most -\fBtcl_precision\fR significant digits; the result may be shorter if -the shorter result represents the original number exactly. If no -result of at most \fBtcl_precision\fR digits is an exact representation -of the original number, the one that is closest to the original -number is chosen. -If the original number lies precisely between two equally accurate -decimal representations, then the one with an even value for the least -significant digit is chosen; for instance, if \fBtcl_precision\fR is 3, then -0.3125 will convert to 0.312, not 0.313, while 0.6875 will convert to -0.688, not 0.687. Any string of trailing zeroes that remains is trimmed. -.RE -.PP -.RS -a \fBtcl_precision\fR value of 17 digits is -.QW perfect -for IEEE floating-point in that it allows -double-precision values to be converted to strings and back to -binary with no loss of information. For this reason, you will often -see it as a value in legacy code that must run on Tcl versions before -8.5. It is no longer recommended; as noted above, a zero value is the -preferred method. -.RE -.PP -.RS -All interpreters in a thread share a single \fBtcl_precision\fR value: -changing it in one interpreter will affect all other interpreters as -well. Safe interpreters are not allowed to modify the -variable. -.RE -.PP -.RS -Valid values for \fBtcl_precision\fR range from 0 to 17. -.RE -.TP -\fBtcl_rcFileName\fR -. -This variable is used during initialization to indicate the name of a -user-specific startup file. If it is set by application-specific -initialization, then the Tcl startup code will check for the existence -of this file and \fBsource\fR it if it exists. For example, for \fBwish\fR -the variable is set to \fB~/.wishrc\fR for Unix and \fB~/wishrc.tcl\fR -for Windows. -.TP \fBtcl_traceCompile\fR . The value of this variable can be set to control diff --git a/doc/trace.n b/doc/trace.n index 570b263..959acc2 100644 --- a/doc/trace.n +++ b/doc/trace.n @@ -229,18 +229,18 @@ When the trace triggers, three arguments are appended to \fIcommandPrefix name1 name2 op\fR .CE .PP -\fIName1\fR and \fIname2\fR give the name(s) for the variable -being accessed: if the variable is a scalar then \fIname1\fR -gives the variable's name and \fIname2\fR is an empty string; -if the variable is an array element then \fIname1\fR gives the -name of the array and name2 gives the index into the array; -if an entire array is being deleted and the trace was registered +\fIName1\fR gives the name for the variable being accessed. +This is not necessarily the same as the name used in the +\fBtrace variable\fR command: the \fBupvar\fR command allows a +procedure to reference a variable under a different name. +If the trace was originally set on an array or array element, +\fIname2\fR provides which index into the array was affected. +This information is present even when \fIname1\fR refers to a +scalar, which may happen if the \fBupvar\fR command was used to +create a reference to a single array element. +If an entire array is being deleted and the trace was registered on the overall array, rather than a single element, then \fIname1\fR gives the array name and \fIname2\fR is an empty string. -\fIName1\fR and \fIname2\fR are not necessarily the same as the -name used in the \fBtrace variable\fR command: the \fBupvar\fR -command allows a procedure to reference a variable under a -different name. \fIOp\fR indicates what operation is being performed on the variable, and is one of \fBread\fR, \fBwrite\fR, or \fBunset\fR as defined above. diff --git a/doc/unload.n b/doc/unload.n index 00b709b..d5bbde8 100644 --- a/doc/unload.n +++ b/doc/unload.n @@ -123,8 +123,8 @@ different platforms. The default guess, which is used on most UNIX platforms, is to take the last element of \fIfileName\fR, strip off the first three characters if they are \fBlib\fR, then strip off the next three characters if they -are \fBtcl\fR, and use any following alphabetic and -underline characters, converted to titlecase as the prefix. +are \fBtcl9\fR, and use any following wordchars but not digits, +converted to titlecase as the prefix. For example, the command \fBunload libxyz4.2.so\fR uses the prefix \fBXyz\fR and the command \fBunload bin/last.so {}\fR uses the prefix \fBLast\fR. diff --git a/doc/upvar.n b/doc/upvar.n index 91defe6..b0324b2 100644 --- a/doc/upvar.n +++ b/doc/upvar.n @@ -98,11 +98,9 @@ trace variable originalVar w \fItraceproc\fR \fIsetByUpvar\fR originalVar 2 .CE .PP -If \fIotherVar\fR refers to an element of an array, then variable -traces set for the entire array will not be invoked when \fImyVar\fR -is accessed (but traces on the particular element will still be -invoked). In particular, if the array is \fBenv\fR, then changes -made to \fImyVar\fR will not be passed to subprocesses correctly. +If \fIotherVar\fR refers to an element of an array, then the element +name is passed as the second argument to the trace procedure. This +may be important information in case of traces set on an entire array. .SH EXAMPLE A \fBdecr\fR command that works like \fBincr\fR except it subtracts the value from the variable instead of adding it: diff --git a/doc/zipfs.3 b/doc/zipfs.3 index 3b13cd9..4d62ddf 100644 --- a/doc/zipfs.3 +++ b/doc/zipfs.3 @@ -87,8 +87,8 @@ it uses WCHAR instead of char. As a result, it requires your application to be compiled with the UNICODE preprocessor symbol defined (e.g., via the \fB-DUNICODE\fR compiler flag). .PP -The result of \fBTclZipfs_AppHook\fR is the full Tcl version (e.g., -\fB8.7.0+abcdef...abcdef.gcc-1002.utf16\fR). +The result of \fBTclZipfs_AppHook\fR is the full Tcl version with build +information (e.g., \fB9.0.0+abcdef...abcdef.gcc-1002\fR). The function \fImay\fR modify the variables pointed to by \fIargcPtr\fR and \fIargvPtr\fR to remove arguments; the current implementation does not do so, but callers \fIshould not\fR assume that this will be true in the future. diff --git a/generic/regc_cvec.c b/generic/regc_cvec.c index 3b4f1e4..dc699cf 100644 --- a/generic/regc_cvec.c +++ b/generic/regc_cvec.c @@ -36,14 +36,14 @@ /* - newcvec - allocate a new cvec - ^ static struct cvec *newcvec(int, int); + ^ static struct cvec *newcvec(size_t, size_t); */ static struct cvec * newcvec( - int nchrs, /* to hold this many chrs... */ - int nranges) /* ... and this many ranges... */ + size_t nchrs, /* to hold this many chrs... */ + size_t nranges) /* ... and this many ranges... */ { - size_t nc = (size_t)nchrs + (size_t)nranges*2; + size_t nc = nchrs + nranges*2; size_t n = sizeof(struct cvec) + nc*sizeof(chr); struct cvec *cv = (struct cvec *) MALLOC(n); @@ -108,8 +108,8 @@ addrange( static struct cvec * getcvec( struct vars *v, /* context */ - int nchrs, /* to hold this many chrs... */ - int nranges) /* ... and this many ranges... */ + size_t nchrs, /* to hold this many chrs... */ + size_t nranges) /* ... and this many ranges... */ { if ((v->cv != NULL) && (nchrs <= v->cv->chrspace) && (nranges <= v->cv->rangespace)) { diff --git a/generic/regc_lex.c b/generic/regc_lex.c index eb068b4..d28e582 100644 --- a/generic/regc_lex.c +++ b/generic/regc_lex.c @@ -894,7 +894,7 @@ lexescape( * Ugly heuristic (first test is "exactly 1 digit?") */ - if (v->now - save == 0 || ((int) c > 0 && (int)c <= v->nsubexp)) { + if (v->now - save == 0 || ((int) c > 0 && (size_t)c <= v->nsubexp)) { NOTE(REG_UBACKREF); RETV(BACKREF, (chr)c); } diff --git a/generic/regc_locale.c b/generic/regc_locale.c index 1ac04ef..7d182e4 100644 --- a/generic/regc_locale.c +++ b/generic/regc_locale.c @@ -110,7 +110,7 @@ static const struct cname { {"right-brace", '}'}, {"right-curly-bracket", '}'}, {"tilde", '~'}, - {"DEL", '\177'}, + {"DEL", '\x7F'}, {NULL, 0} }; @@ -826,8 +826,6 @@ static const chr graphCharTable[] = { /* * End of auto-generated Unicode character ranges declarations. */ - -#define CH NOCELT /* - element - map collating-element name to celt @@ -920,9 +918,9 @@ range( for (c=a; c<=b; c++) { addchr(cv, c); - lc = Tcl_UniCharToLower((chr)c); - uc = Tcl_UniCharToUpper((chr)c); - tc = Tcl_UniCharToTitle((chr)c); + lc = Tcl_UniCharToLower(c); + uc = Tcl_UniCharToUpper(c); + tc = Tcl_UniCharToTitle(c); if (c != lc) { addchr(cv, lc); } @@ -971,11 +969,11 @@ eclass( if ((v->cflags®_FAKE) && c == 'x') { cv = getcvec(v, 4, 0); - addchr(cv, (chr)'x'); - addchr(cv, (chr)'y'); + addchr(cv, 'x'); + addchr(cv, 'y'); if (cases) { - addchr(cv, (chr)'X'); - addchr(cv, (chr)'Y'); + addchr(cv, 'X'); + addchr(cv, 'Y'); } return cv; } @@ -989,7 +987,7 @@ eclass( } cv = getcvec(v, 1, 0); assert(cv != NULL); - addchr(cv, (chr)c); + addchr(cv, c); return cv; } @@ -1005,12 +1003,11 @@ cclass( const chr *endp, /* just past the end of the name */ int cases) /* case-independent? */ { - size_t len; + size_t i, len; struct cvec *cv = NULL; Tcl_DString ds; const char *np; const char *const *namePtr; - int i, index; /* * The following arrays define the valid character class names. @@ -1022,9 +1019,10 @@ cclass( }; enum classes { + CC_NULL = -1, CC_ALNUM, CC_ALPHA, CC_ASCII, CC_BLANK, CC_CNTRL, CC_DIGIT, CC_GRAPH, CC_LOWER, CC_PRINT, CC_PUNCT, CC_SPACE, CC_UPPER, CC_XDIGIT - }; + } index; /* @@ -1033,24 +1031,20 @@ cclass( len = endp - startp; Tcl_DStringInit(&ds); - np = Tcl_UniCharToUtfDString(startp, (int)len, &ds); + np = Tcl_UniCharToUtfDString(startp, len, &ds); /* * Map the name to the corresponding enumerated value. */ - index = -1; + index = CC_NULL; for (namePtr=classNames,i=0 ; *namePtr!=NULL ; namePtr++,i++) { if ((strlen(*namePtr) == len) && (strncmp(*namePtr, np, len) == 0)) { - index = i; + index = (enum classes)i; break; } } Tcl_DStringFree(&ds); - if (index == -1) { - ERR(REG_ECTYPE); - return NULL; - } /* * Remap lower and upper to alpha if the match is case insensitive. @@ -1064,18 +1058,21 @@ cclass( * Now compute the character class contents. */ - switch((enum classes) index) { + switch (index) { + case CC_NULL: + ERR(REG_ECTYPE); + return NULL; case CC_ALNUM: cv = getcvec(v, NUM_ALPHA_CHAR, NUM_DIGIT_RANGE + NUM_ALPHA_RANGE); if (cv) { - for (i=0 ; (size_t)i<NUM_ALPHA_CHAR ; i++) { + for (i=0 ; i<NUM_ALPHA_CHAR ; i++) { addchr(cv, alphaCharTable[i]); } - for (i=0 ; (size_t)i<NUM_ALPHA_RANGE ; i++) { + for (i=0 ; i<NUM_ALPHA_RANGE ; i++) { addrange(cv, alphaRangeTable[i].start, alphaRangeTable[i].end); } - for (i=0 ; (size_t)i<NUM_DIGIT_RANGE ; i++) { + for (i=0 ; i<NUM_DIGIT_RANGE ; i++) { addrange(cv, digitRangeTable[i].start, digitRangeTable[i].end); } @@ -1084,11 +1081,11 @@ cclass( case CC_ALPHA: cv = getcvec(v, NUM_ALPHA_CHAR, NUM_ALPHA_RANGE); if (cv) { - for (i=0 ; (size_t)i<NUM_ALPHA_RANGE ; i++) { + for (i=0 ; i<NUM_ALPHA_RANGE ; i++) { addrange(cv, alphaRangeTable[i].start, alphaRangeTable[i].end); } - for (i=0 ; (size_t)i<NUM_ALPHA_CHAR ; i++) { + for (i=0 ; i<NUM_ALPHA_CHAR ; i++) { addchr(cv, alphaCharTable[i]); } } @@ -1107,11 +1104,11 @@ cclass( case CC_CNTRL: cv = getcvec(v, NUM_CONTROL_CHAR, NUM_CONTROL_RANGE); if (cv) { - for (i=0 ; (size_t)i<NUM_CONTROL_RANGE ; i++) { + for (i=0 ; i<NUM_CONTROL_RANGE ; i++) { addrange(cv, controlRangeTable[i].start, controlRangeTable[i].end); } - for (i=0 ; (size_t)i<NUM_CONTROL_CHAR ; i++) { + for (i=0 ; i<NUM_CONTROL_CHAR ; i++) { addchr(cv, controlCharTable[i]); } } @@ -1119,7 +1116,7 @@ cclass( case CC_DIGIT: cv = getcvec(v, 0, NUM_DIGIT_RANGE); if (cv) { - for (i=0 ; (size_t)i<NUM_DIGIT_RANGE ; i++) { + for (i=0 ; i<NUM_DIGIT_RANGE ; i++) { addrange(cv, digitRangeTable[i].start, digitRangeTable[i].end); } @@ -1128,11 +1125,11 @@ cclass( case CC_PUNCT: cv = getcvec(v, NUM_PUNCT_CHAR, NUM_PUNCT_RANGE); if (cv) { - for (i=0 ; (size_t)i<NUM_PUNCT_RANGE ; i++) { + for (i=0 ; i<NUM_PUNCT_RANGE ; i++) { addrange(cv, punctRangeTable[i].start, punctRangeTable[i].end); } - for (i=0 ; (size_t)i<NUM_PUNCT_CHAR ; i++) { + for (i=0 ; i<NUM_PUNCT_CHAR ; i++) { addchr(cv, punctCharTable[i]); } } @@ -1157,11 +1154,11 @@ cclass( case CC_SPACE: cv = getcvec(v, NUM_SPACE_CHAR, NUM_SPACE_RANGE); if (cv) { - for (i=0 ; (size_t)i<NUM_SPACE_RANGE ; i++) { + for (i=0 ; i<NUM_SPACE_RANGE ; i++) { addrange(cv, spaceRangeTable[i].start, spaceRangeTable[i].end); } - for (i=0 ; (size_t)i<NUM_SPACE_CHAR ; i++) { + for (i=0 ; i<NUM_SPACE_CHAR ; i++) { addchr(cv, spaceCharTable[i]); } } @@ -1169,11 +1166,11 @@ cclass( case CC_LOWER: cv = getcvec(v, NUM_LOWER_CHAR, NUM_LOWER_RANGE); if (cv) { - for (i=0 ; (size_t)i<NUM_LOWER_RANGE ; i++) { + for (i=0 ; i<NUM_LOWER_RANGE ; i++) { addrange(cv, lowerRangeTable[i].start, lowerRangeTable[i].end); } - for (i=0 ; (size_t)i<NUM_LOWER_CHAR ; i++) { + for (i=0 ; i<NUM_LOWER_CHAR ; i++) { addchr(cv, lowerCharTable[i]); } } @@ -1181,11 +1178,11 @@ cclass( case CC_UPPER: cv = getcvec(v, NUM_UPPER_CHAR, NUM_UPPER_RANGE); if (cv) { - for (i=0 ; (size_t)i<NUM_UPPER_RANGE ; i++) { + for (i=0 ; i<NUM_UPPER_RANGE ; i++) { addrange(cv, upperRangeTable[i].start, upperRangeTable[i].end); } - for (i=0 ; (size_t)i<NUM_UPPER_CHAR ; i++) { + for (i=0 ; i<NUM_UPPER_CHAR ; i++) { addchr(cv, upperCharTable[i]); } } @@ -1193,18 +1190,18 @@ cclass( case CC_PRINT: cv = getcvec(v, NUM_SPACE_CHAR + NUM_GRAPH_CHAR, NUM_SPACE_RANGE + NUM_GRAPH_RANGE - 1); if (cv) { - for (i=1 ; (size_t)i<NUM_SPACE_RANGE ; i++) { + for (i=1 ; i<NUM_SPACE_RANGE ; i++) { addrange(cv, spaceRangeTable[i].start, spaceRangeTable[i].end); } - for (i=0 ; (size_t)i<NUM_SPACE_CHAR ; i++) { + for (i=0 ; i<NUM_SPACE_CHAR ; i++) { addchr(cv, spaceCharTable[i]); } - for (i=0 ; (size_t)i<NUM_GRAPH_RANGE ; i++) { + for (i=0 ; i<NUM_GRAPH_RANGE ; i++) { addrange(cv, graphRangeTable[i].start, graphRangeTable[i].end); } - for (i=0 ; (size_t)i<NUM_GRAPH_CHAR ; i++) { + for (i=0 ; i<NUM_GRAPH_CHAR ; i++) { addchr(cv, graphCharTable[i]); } } @@ -1212,11 +1209,11 @@ cclass( case CC_GRAPH: cv = getcvec(v, NUM_GRAPH_CHAR, NUM_GRAPH_RANGE); if (cv) { - for (i=0 ; (size_t)i<NUM_GRAPH_RANGE ; i++) { + for (i=0 ; i<NUM_GRAPH_RANGE ; i++) { addrange(cv, graphRangeTable[i].start, graphRangeTable[i].end); } - for (i=0 ; (size_t)i<NUM_GRAPH_CHAR ; i++) { + for (i=0 ; i<NUM_GRAPH_CHAR ; i++) { addchr(cv, graphCharTable[i]); } } @@ -1243,9 +1240,9 @@ allcases( chr c = (chr)pc; chr lc, uc, tc; - lc = Tcl_UniCharToLower((chr)c); - uc = Tcl_UniCharToUpper((chr)c); - tc = Tcl_UniCharToTitle((chr)c); + lc = Tcl_UniCharToLower(c); + uc = Tcl_UniCharToUpper(c); + tc = Tcl_UniCharToTitle(c); if (tc != uc) { cv = getcvec(v, 3, 0); diff --git a/generic/regc_nfa.c b/generic/regc_nfa.c index f676a45..94a9f99 100644 --- a/generic/regc_nfa.c +++ b/generic/regc_nfa.c @@ -108,7 +108,7 @@ freenfa( } nfa->slast = NULL; - nfa->nstates = -1; + nfa->nstates = FREESTATE; nfa->pre = NULL; nfa->post = NULL; FREE(nfa); @@ -143,7 +143,7 @@ newstate( s->noas = 0; } - assert(nfa->nstates >= 0); + assert(nfa->nstates != FREESTATE); s->no = nfa->nstates++; s->flag = 0; if (nfa->states == NULL) { @@ -2494,7 +2494,7 @@ clonesuccessorstates( struct arc * refarc, char *curdonemap, char *outerdonemap, - int nstates) + size_t nstates) { char *donemap; struct arc *a; @@ -2691,7 +2691,7 @@ cleanup( { struct state *s; struct state *nexts; - int n; + size_t n; /* * Clear out unreachable or dead-end states. Use pre to mark reachable, @@ -2847,7 +2847,7 @@ compact( ca = cnfa->arcs; for (s = nfa->states; s != NULL; s = s->next) { - assert((size_t) s->no < nstates); + assert(s->no < nstates); cnfa->stflags[s->no] = 0; cnfa->states[s->no] = ca; first = ca; @@ -2951,10 +2951,10 @@ dumpnfa( { #ifdef REG_DEBUG struct state *s; - int nstates = 0; - int narcs = 0; + size_t nstates = 0; + size_t narcs = 0; - fprintf(f, "pre %d, post %d", nfa->pre->no, nfa->post->no); + fprintf(f, "pre %" TCL_Z_MODIFIER "u, post %" TCL_Z_MODIFIER "u", nfa->pre->no, nfa->post->no); if (nfa->bos[0] != COLORLESS) { fprintf(f, ", bos [%ld]", (long) nfa->bos[0]); } @@ -2973,7 +2973,7 @@ dumpnfa( nstates++; narcs += s->nouts; } - fprintf(f, "total of %d states, %d arcs\n", nstates, narcs); + fprintf(f, "total of %" TCL_Z_MODIFIER "u states, %" TCL_Z_MODIFIER "u arcs\n", nstates, narcs); if (nfa->parent == NULL) { dumpcolors(nfa->cm, f); } @@ -3000,7 +3000,7 @@ dumpstate( { struct arc *a; - fprintf(f, "%d%s%c", s->no, (s->tmp != NULL) ? "T" : "", + fprintf(f, "%" TCL_Z_MODIFIER "u%s%c", s->no, (s->tmp != NULL) ? "T" : "", (s->flag) ? s->flag : '.'); if (s->prev != NULL && s->prev->next != s) { fprintf(f, "\tstate chain bad\n"); @@ -3013,7 +3013,7 @@ dumpstate( fflush(f); for (a = s->ins; a != NULL; a = a->inchain) { if (a->to != s) { - fprintf(f, "\tlink from %d to %d on %d's in-chain\n", + fprintf(f, "\tlink from %" TCL_Z_MODIFIER "u to %" TCL_Z_MODIFIER "u on %" TCL_Z_MODIFIER "u's in-chain\n", a->from->no, a->to->no, s->no); } } @@ -3091,7 +3091,7 @@ dumparc( break; } if (a->from != s) { - fprintf(f, "?%d?", a->from->no); + fprintf(f, "?%" TCL_Z_MODIFIER "u?", a->from->no); } for (ab = &a->from->oas; ab != NULL; ab = ab->next) { for (aa = &ab->a[0]; aa < &ab->a[ABSIZE]; aa++) { @@ -3111,7 +3111,7 @@ dumparc( fprintf(f, "NULL"); return; } - fprintf(f, "%d", a->to->no); + fprintf(f, "%" TCL_Z_MODIFIER "u", a->to->no); for (aa = a->to->ins; aa != NULL; aa = aa->inchain) { if (aa == a) { break; /* NOTE BREAK OUT */ @@ -3137,9 +3137,9 @@ dumpcnfa( FILE *f) { #ifdef REG_DEBUG - int st; + size_t st; - fprintf(f, "pre %d, post %d", cnfa->pre, cnfa->post); + fprintf(f, "pre %" TCL_Z_MODIFIER "u, post %" TCL_Z_MODIFIER "u", cnfa->pre, cnfa->post); if (cnfa->bos[0] != COLORLESS) { fprintf(f, ", bos [%ld]", (long) cnfa->bos[0]); } @@ -3182,15 +3182,15 @@ dumpcstate( FILE *f) { struct carc *ca; - int pos; + size_t pos; fprintf(f, "%d%s", st, (cnfa->stflags[st] & CNFA_NOPROGRESS) ? ":" : "."); pos = 1; for (ca = cnfa->states[st]; ca->co != COLORLESS; ca++) { if (ca->co < cnfa->ncolors) { - fprintf(f, "\t[%ld]->%d", (long) ca->co, ca->to); + fprintf(f, "\t[%d]->%" TCL_Z_MODIFIER "u", ca->co, ca->to); } else { - fprintf(f, "\t:%ld:->%d", (long) (ca->co - cnfa->ncolors), ca->to); + fprintf(f, "\t:%d:->%" TCL_Z_MODIFIER "u", ca->co - cnfa->ncolors, ca->to); } if (pos == 5) { fprintf(f, "\n"); diff --git a/generic/regcomp.c b/generic/regcomp.c index c1ceb51..9ecc8c6 100644 --- a/generic/regcomp.c +++ b/generic/regcomp.c @@ -39,7 +39,7 @@ /* automatically gathered by fwd; do not hand-edit */ /* === regcomp.c === */ int compile(regex_t *, const chr *, size_t, int); -static void moresubs(struct vars *, int); +static void moresubs(struct vars *, size_t); static int freev(struct vars *, int); static void makesearch(struct vars *, struct nfa *); static struct subre *parse(struct vars *, int, int, struct state *, struct state *); @@ -156,7 +156,7 @@ static void fixconstraintloops(struct nfa *, FILE *); static int findconstraintloop(struct nfa *, struct state *); static void breakconstraintloop(struct nfa *, struct state *); static void clonesuccessorstates(struct nfa *, struct state *, struct state *, - struct state *, struct arc *, char *, char *, int); + struct state *, struct arc *, char *, char *, size_t); static void cleanup(struct nfa *); static void markreachable(struct nfa *, struct state *, struct state *, struct state *); static void markcanreach(struct nfa *, struct state *, struct state *, struct state *); @@ -179,8 +179,8 @@ static void dumpcstate(int, struct cnfa *, FILE *); static struct cvec *clearcvec(struct cvec *); static void addchr(struct cvec *, pchr); static void addrange(struct cvec *, pchr, pchr); -static struct cvec *newcvec(int, int); -static struct cvec *getcvec(struct vars *, int, int); +static struct cvec *newcvec(size_t, size_t); +static struct cvec *getcvec(struct vars *, size_t, size_t); static void freecvec(struct cvec *); /* === regc_locale.c === */ static celt element(struct vars *, const chr *, const chr *); @@ -205,11 +205,11 @@ struct vars { int cflags; /* copy of compile flags */ int lasttype; /* type of previous token */ int nexttype; /* type of next token */ - int nextvalue; /* value (if any) of next token */ + size_t nextvalue; /* value (if any) of next token */ int lexcon; /* lexical context type (see lex.c) */ - int nsubexp; /* subexpression count */ + size_t nsubexp; /* subexpression count */ struct subre **subs; /* subRE pointer vector */ - int nsubs; /* length of vector */ + size_t nsubs; /* length of vector */ struct subre *sub10[10]; /* initial vector, enough for most */ struct nfa *nfa; /* the NFA */ struct colormap *cm; /* character color map */ @@ -222,7 +222,7 @@ struct vars { struct cvec *cv; /* interface cvec */ struct cvec *cv2; /* utility cvec */ struct subre *lacons; /* lookahead-constraint vector */ - int nlacons; /* size of lacons */ + size_t nlacons; /* size of lacons */ size_t spaceused; /* approx. space used for compilation */ }; @@ -287,7 +287,7 @@ compile( { AllocVars(v); struct guts *g; - int i, j; + size_t i, j; FILE *debug = (flags®_PROGRESS) ? stdout : NULL; #define CNOERR() { if (ISERR()) return freev(v, v->err); } @@ -338,7 +338,6 @@ compile( v->spaceused = 0; re->re_magic = REMAGIC; re->re_info = 0; /* bits get set during parse */ - re->re_csize = sizeof(chr); re->re_guts = NULL; re->re_fns = (void*)(&functions); @@ -411,7 +410,7 @@ compile( assert(v->nlacons == 0 || v->lacons != NULL); for (i = 1; i < v->nlacons; i++) { if (debug != NULL) { - fprintf(debug, "\n\n\n========= LA%d ==========\n", i); + fprintf(debug, "\n\n\n========= LA%" TCL_Z_MODIFIER "u ==========\n", i); } nfanode(v, &v->lacons[i], debug); } @@ -467,15 +466,15 @@ compile( /* - moresubs - enlarge subRE vector - ^ static void moresubs(struct vars *, int); + ^ static void moresubs(struct vars *, size_t); */ static void moresubs( struct vars *v, - int wanted) /* want enough room for this one */ + size_t wanted) /* want enough room for this one */ { struct subre **p; - int n; + size_t n; assert(wanted > 0 && wanted >= v->nsubs); n = wanted * 3 / 2 + 1; @@ -795,7 +794,7 @@ parseqatom( struct subre *t; int cap; /* capturing parens? */ int pos; /* positive lookahead? */ - int subno; /* capturing-parens or backref number */ + size_t subno; /* capturing-parens or backref number */ int atomtype; int qprefer; /* quantifier short/long preference */ int f; @@ -2048,7 +2047,7 @@ dump( { #ifdef REG_DEBUG struct guts *g; - int i; + size_t i; if (re->re_magic != REMAGIC) { fprintf(f, "bad magic number (0x%x not 0x%x)\n", @@ -2065,8 +2064,8 @@ dump( } fprintf(f, "\n\n\n========= DUMP ==========\n"); - fprintf(f, "nsub %d, info 0%lo, csize %d, ntree %d\n", - (int) re->re_nsub, re->re_info, re->re_csize, g->ntree); + fprintf(f, "nsub %" TCL_Z_MODIFIER "u, info 0%lo, ntree %" TCL_Z_MODIFIER "u\n", + re->re_nsub, re->re_info, g->ntree); dumpcolors(&g->cmap, f); if (!NULLCNFA(g->search)) { @@ -2074,7 +2073,7 @@ dump( dumpcnfa(&g->search, f); } for (i = 1; i < g->nlacons; i++) { - fprintf(f, "\nla%d (%s):\n", i, + fprintf(f, "\nla%" TCL_Z_MODIFIER "u (%s):\n", i, (g->lacons[i].subno) ? "positive" : "negative"); dumpcnfa(&g->lacons[i].cnfa, f); } @@ -2146,7 +2145,7 @@ stdump( fprintf(f, "}"); } if (nfapresent) { - fprintf(f, " %d-%d", t->begin->no, t->end->no); + fprintf(f, " %" TCL_Z_MODIFIER "u-%" TCL_Z_MODIFIER "u", t->begin->no, t->end->no); } if (t->left != NULL) { fprintf(f, " L:%s", stid(t->left, idbuf, sizeof(idbuf))); diff --git a/generic/regcustom.h b/generic/regcustom.h index 5bda852..1d55671 100644 --- a/generic/regcustom.h +++ b/generic/regcustom.h @@ -36,9 +36,9 @@ * Overrides for regguts.h definitions, if any. */ -#define MALLOC(n) (void*)(attemptckalloc(n)) -#define FREE(p) ckfree((void*)(p)) -#define REALLOC(p,n) (void*)(attemptckrealloc((void*)(p),n)) +#define MALLOC(n) Tcl_AttemptAlloc(n) +#define FREE(p) Tcl_Free(p) +#define REALLOC(p,n) Tcl_AttemptRealloc(p,n) /* * Do not insert extras between the "begin" and "end" lines - this chunk is @@ -56,9 +56,6 @@ #ifdef __REG_WIDE_EXEC #undef __REG_WIDE_EXEC #endif -#ifdef __REG_REGOFF_T -#undef __REG_REGOFF_T -#endif #ifdef __REG_NOFRONT #undef __REG_NOFRONT #endif @@ -67,7 +64,6 @@ #endif /* Interface types */ #define __REG_WIDE_T Tcl_UniChar -#define __REG_REGOFF_T long /* Not really right, but good enough... */ /* Names and declarations */ #define __REG_WIDE_COMPILE TclReComp #define __REG_WIDE_EXEC TclReExec diff --git a/generic/rege_dfa.c b/generic/rege_dfa.c index eddfea2..5d49aa5 100644 --- a/generic/rege_dfa.c +++ b/generic/rege_dfa.c @@ -47,7 +47,7 @@ longest( color co; struct sset *css, *ss; chr *post; - int i; + size_t i; struct colormap *cm = d->cm; /* @@ -292,7 +292,7 @@ lastCold( { struct sset *ss; chr *nopr = d->lastnopr; - int i; + size_t i; if (nopr == NULL) { nopr = v->start; @@ -319,7 +319,7 @@ newDFA( { struct dfa *d; size_t nss = cnfa->nstates * 2; - int wordsper = (cnfa->nstates + UBITS - 1) / UBITS; + size_t wordsper = (cnfa->nstates + UBITS - 1) / UBITS; struct smalldfa *smallwas = sml; assert(cnfa != NULL && cnfa->nstates != 0); @@ -442,7 +442,7 @@ initialize( chr *const start) { struct sset *ss; - int i; + size_t i; /* * Is previous one still there? @@ -492,7 +492,8 @@ miss( unsigned h; struct carc *ca; struct sset *p; - int i, isPost, noProgress, gotState, doLAConstraints, sawLAConstraints; + size_t i; + int isPost, noProgress, gotState, doLAConstraints, sawLAConstraints; /* * For convenience, we can be called even if it might not be a miss. @@ -526,7 +527,7 @@ miss( if (!(cnfa->stflags[ca->to] & CNFA_NOPROGRESS)) { noProgress = 0; } - FDEBUG(("%d -> %d\n", i, ca->to)); + FDEBUG(("%" TCL_Z_MODIFIER "u -> %" TCL_Z_MODIFIER "u\n", i, ca->to)); } } } @@ -556,7 +557,7 @@ miss( if (!(cnfa->stflags[ca->to] & CNFA_NOPROGRESS)) { noProgress = 0; } - FDEBUG(("%d :> %d\n", i, ca->to)); + FDEBUG(("%" TCL_Z_MODIFIER "u :> %" TCL_Z_MODIFIER"u\n", i, ca->to)); } } } @@ -615,7 +616,7 @@ checkLAConstraint( chr *const cp, const pcolor co) /* "color" of the lookahead constraint */ { - int n; + size_t n; struct subre *sub; struct dfa *d; struct smalldfa sd; @@ -623,7 +624,7 @@ checkLAConstraint( n = co - pcnfa->ncolors; assert(n < v->g->nlacons && v->g->lacons != NULL); - FDEBUG(("=== testing lacon %d\n", n)); + FDEBUG(("=== testing lacon %" TCL_Z_MODIFIER "u\n", n)); sub = &v->g->lacons[n]; d = newDFA(v, &sub->cnfa, &v->g->cmap, &sd); if (d == NULL) { @@ -632,7 +633,7 @@ checkLAConstraint( } end = longest(v, d, cp, v->stop, NULL); freeDFA(d); - FDEBUG(("=== lacon %d match %d\n", n, (end != NULL))); + FDEBUG(("=== lacon %" TCL_Z_MODIFIER "u match %d\n", n, (end != NULL))); return (sub->subno) ? (end != NULL) : (end == NULL); } @@ -738,21 +739,21 @@ pickNextSS( */ if (d->nssused < d->nssets) { - i = d->nssused; + size_t j = d->nssused; d->nssused++; - ss = &d->ssets[i]; - FDEBUG(("new c%d\n", i)); + ss = &d->ssets[j]; + FDEBUG(("new c%" TCL_Z_MODIFIER "u\n", j)); /* * Set up innards. */ - ss->states = &d->statesarea[i * d->wordsper]; + ss->states = &d->statesarea[j * d->wordsper]; ss->flags = 0; ss->ins.ss = NULL; ss->ins.co = WHITE; /* give it some value */ - ss->outs = &d->outsarea[i * d->ncolors]; - ss->inchain = &d->incarea[i * d->ncolors]; + ss->outs = &d->outsarea[j * d->ncolors]; + ss->inchain = &d->incarea[j * d->ncolors]; for (i = 0; i < d->ncolors; i++) { ss->outs[i] = NULL; ss->inchain[i].ss = NULL; @@ -764,7 +765,7 @@ pickNextSS( * Look for oldest, or old enough anyway. */ - if (cp - start > d->nssets*2/3) { /* oldest 33% are expendable */ + if ((size_t)(cp - start) > d->nssets*2/3) { /* oldest 33% are expendable */ ancient = cp - d->nssets*2/3; } else { ancient = start; @@ -773,7 +774,7 @@ pickNextSS( if ((ss->lastseen == NULL || ss->lastseen < ancient) && !(ss->flags&LOCKED)) { d->search = ss + 1; - FDEBUG(("replacing c%d\n", (int) (ss - d->ssets))); + FDEBUG(("replacing c%" TCL_Z_MODIFIER "u\n", (size_t)(ss - d->ssets))); return ss; } } @@ -781,7 +782,7 @@ pickNextSS( if ((ss->lastseen == NULL || ss->lastseen < ancient) && !(ss->flags&LOCKED)) { d->search = ss + 1; - FDEBUG(("replacing c%d\n", (int) (ss - d->ssets))); + FDEBUG(("replacing c%" TCL_Z_MODIFIER "u\n", (size_t)(ss - d->ssets))); return ss; } } diff --git a/generic/regerror.c b/generic/regerror.c index 6606d41..a53a0fd 100644 --- a/generic/regerror.c +++ b/generic/regerror.c @@ -86,7 +86,7 @@ regerror( if (r->code >= 0) { msg = r->name; } else { /* Unknown; tell him the number */ - sprintf(convbuf, "REG_%u", (unsigned)icode); + sprintf(convbuf, "REG_%u", icode); msg = convbuf; } break; diff --git a/generic/regex.h b/generic/regex.h index dba3ab4..72f7037 100644 --- a/generic/regex.h +++ b/generic/regex.h @@ -89,9 +89,6 @@ extern "C" { #ifdef __REG_WIDE_EXEC #undef __REG_WIDE_EXEC #endif -#ifdef __REG_REGOFF_T -#undef __REG_REGOFF_T -#endif #ifdef __REG_NOFRONT #undef __REG_NOFRONT #endif @@ -100,7 +97,6 @@ extern "C" { #endif /* interface types */ #define __REG_WIDE_T Tcl_UniChar -#define __REG_REGOFF_T long /* not really right, but good enough... */ /* names and declarations */ #define __REG_WIDE_COMPILE TclReComp #define __REG_WIDE_EXEC TclReExec @@ -115,25 +111,14 @@ extern "C" { */ /* - * regoff_t has to be large enough to hold either off_t or ssize_t, and must - * be signed; it's only a guess that long is suitable, so we offer - * <sys/types.h> an override. - */ -#ifdef __REG_REGOFF_T -typedef __REG_REGOFF_T regoff_t; -#else -typedef long regoff_t; -#endif - -/* * other interface types */ /* the biggie, a compiled RE (or rather, a front end to same) */ typedef struct { int re_magic; /* magic number */ - size_t re_nsub; /* number of subexpressions */ long re_info; /* information about RE */ + size_t re_nsub; /* number of subexpressions */ #define REG_UBACKREF 000001 #define REG_ULOOKAHEAD 000002 #define REG_UBOUNDS 000004 @@ -148,7 +133,6 @@ typedef struct { #define REG_UEMPTYMATCH 004000 #define REG_UIMPOSSIBLE 010000 #define REG_USHORTEST 020000 - int re_csize; /* sizeof(character) */ char *re_endp; /* backward compatibility kludge */ /* the rest is opaque pointers to hidden innards */ void *re_guts; @@ -157,8 +141,8 @@ typedef struct { /* result reporting (may acquire more fields later) */ typedef struct { - regoff_t rm_so; /* start of substring */ - regoff_t rm_eo; /* end of substring */ + size_t rm_so; /* start of substring */ + size_t rm_eo; /* end of substring */ } regmatch_t; /* supplementary control and reporting */ diff --git a/generic/regexec.c b/generic/regexec.c index 7ef048e..7b84f0f 100644 --- a/generic/regexec.c +++ b/generic/regexec.c @@ -57,11 +57,12 @@ struct sset { /* state set */ }; struct dfa { - int nssets; /* size of cache */ - int nssused; /* how many entries occupied yet */ - int nstates; /* number of states */ + size_t nssets; /* size of cache */ + size_t nssused; /* how many entries occupied yet */ + size_t nstates; /* number of states */ + size_t wordsper; /* length of state-set bitvectors */ int ncolors; /* length of outarc and inchain vectors */ - int wordsper; /* length of state-set bitvectors */ + int cptsmalloced; /* were the areas individually malloced? */ struct sset *ssets; /* state-set cache */ unsigned *statesarea; /* bitvector storage */ unsigned *work; /* pointer to work area within statesarea */ @@ -72,7 +73,6 @@ struct dfa { chr *lastpost; /* location of last cache-flushed success */ chr *lastnopr; /* location of last cache-flushed NOPROGRESS */ struct sset *search; /* replacement-search-pointer memory */ - int cptsmalloced; /* were the areas individually malloced? */ char *mallocarea; /* self, or malloced area, or NULL */ }; @@ -186,10 +186,6 @@ exec( FreeVars(v); return REG_INVARG; } - if (re->re_csize != sizeof(chr)) { - FreeVars(v); - return REG_MIXED; - } /* * Setup. @@ -554,8 +550,8 @@ zapallsubs( size_t i; for (i = n-1; i > 0; i--) { - p[i].rm_so = -1; - p[i].rm_eo = -1; + p[i].rm_so = FREESTATE; + p[i].rm_eo = FREESTATE; } } @@ -569,11 +565,11 @@ zaptreesubs( struct subre *const t) { if (t->op == '(') { - int n = t->subno; + size_t n = t->subno; assert(n > 0); - if ((size_t) n < v->nmatch) { - v->pmatch[n].rm_so = -1; - v->pmatch[n].rm_eo = -1; + if (n < v->nmatch) { + v->pmatch[n].rm_so = FREESTATE; + v->pmatch[n].rm_eo = FREESTATE; } } @@ -893,7 +889,7 @@ cbrdissect( MDEBUG(("cbackref n%d %d{%d-%d}\n", t->id, n, min, max)); /* get the backreferenced string */ - if (v->pmatch[n].rm_so == TCL_INDEX_NONE) { + if (v->pmatch[n].rm_so == FREESTATE) { return REG_NOMATCH; } brstring = v->start + v->pmatch[n].rm_so; diff --git a/generic/regguts.h b/generic/regguts.h index de5d18e..b9af7ac 100644 --- a/generic/regguts.h +++ b/generic/regguts.h @@ -203,11 +203,11 @@ struct colormap { /* Representation of a set of characters. */ struct cvec { - int nchrs; /* number of chrs */ - int chrspace; /* number of chrs possible */ + size_t nchrs; /* number of chrs */ + size_t chrspace; /* number of chrs possible */ chr *chrs; /* pointer to vector of chrs */ - int nranges; /* number of ranges (chr pairs) */ - int rangespace; /* number of chrs possible */ + size_t nranges; /* number of ranges (chr pairs) */ + size_t rangespace; /* number of chrs possible */ chr *ranges; /* pointer to vector of chr pairs */ }; @@ -242,19 +242,19 @@ struct arcbatch { /* for bulk allocation of arcs */ }; struct state { - int no; -#define FREESTATE (-1) + size_t no; +#define FREESTATE ((size_t)-1) char flag; /* marks special states */ - int nins; /* number of inarcs */ + size_t nins; /* number of inarcs */ struct arc *ins; /* chain of inarcs */ - int nouts; /* number of outarcs */ + size_t nouts; /* number of outarcs */ struct arc *outs; /* chain of outarcs */ struct arc *free; /* chain of free arcs */ struct state *tmp; /* temporary for traversal algorithms */ struct state *next; /* chain for traversing all */ struct state *prev; /* back chain */ struct arcbatch oas; /* first arcbatch, avoid malloc in easy case */ - int noas; /* number of arcs used in first arcbatch */ + size_t noas; /* number of arcs used in first arcbatch */ }; struct nfa { @@ -262,7 +262,7 @@ struct nfa { struct state *init; /* initial state */ struct state *final; /* final state */ struct state *post; /* post-final state */ - int nstates; /* for numbering states */ + size_t nstates; /* for numbering states */ struct state *states; /* state-chain header */ struct state *slast; /* tail of the chain */ struct state *free; /* free list */ @@ -290,16 +290,16 @@ struct nfa { struct carc { color co; /* COLORLESS is list terminator */ - int to; /* next-state number */ + size_t to; /* next-state number */ }; struct cnfa { - int nstates; /* number of states */ + size_t nstates; /* number of states */ int ncolors; /* number of colors */ int flags; #define HASLACONS 01 /* uses lookahead constraints */ - int pre; /* setup state number */ - int post; /* teardown state number */ + size_t pre; /* setup state number */ + size_t post; /* teardown state number */ color bos[2]; /* colors, if any, assigned to BOS and BOL */ color eos[2]; /* colors, if any, assigned to EOS and EOL */ char *stflags; /* vector of per-state flags bytes */ @@ -396,11 +396,11 @@ struct guts { size_t nsub; /* copy of re_nsub */ struct subre *tree; struct cnfa search; /* for fast preliminary search */ - int ntree; /* number of subre's, plus one */ + size_t ntree; /* number of subre's, plus one */ struct colormap cmap; int (*compare) (const chr *, const chr *, size_t); struct subre *lacons; /* lookahead-constraint vector */ - int nlacons; /* size of lacons */ + size_t nlacons; /* size of lacons */ }; /* diff --git a/generic/tcl.decls b/generic/tcl.decls index a9c042c..2a35559 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -40,22 +40,22 @@ declare 2 { TCL_NORETURN void Tcl_Panic(const char *format, ...) } declare 3 { - char *Tcl_Alloc(TCL_HASH_TYPE size) + void *Tcl_Alloc(TCL_HASH_TYPE size) } declare 4 { - void Tcl_Free(char *ptr) + void Tcl_Free(void *ptr) } declare 5 { - char *Tcl_Realloc(char *ptr, TCL_HASH_TYPE size) + void *Tcl_Realloc(void *ptr, TCL_HASH_TYPE size) } declare 6 { - char *Tcl_DbCkalloc(TCL_HASH_TYPE size, const char *file, int line) + void *Tcl_DbCkalloc(TCL_HASH_TYPE size, const char *file, int line) } declare 7 { - void Tcl_DbCkfree(char *ptr, const char *file, int line) + void Tcl_DbCkfree(void *ptr, const char *file, int line) } declare 8 { - char *Tcl_DbCkrealloc(char *ptr, TCL_HASH_TYPE size, + void *Tcl_DbCkrealloc(void *ptr, TCL_HASH_TYPE size, const char *file, int line) } @@ -63,11 +63,11 @@ declare 8 { # but they are part of the old generic interface, so we include them here for # compatibility reasons. -declare 9 unix { +declare 9 { void Tcl_CreateFileHandler(int fd, int mask, Tcl_FileProc *proc, void *clientData) } -declare 10 unix { +declare 10 { void Tcl_DeleteFileHandler(int fd) } declare 11 { @@ -104,9 +104,10 @@ declare 20 { declare 21 { int Tcl_DbIsShared(Tcl_Obj *objPtr, const char *file, int line) } -declare 22 {deprecated {No longer in use, changed to macro}} { - Tcl_Obj *Tcl_DbNewBooleanObj(int intValue, const char *file, int line) -} +# Removed in 9.0 (changed to macro): +#declare 22 { +# Tcl_Obj *Tcl_DbNewBooleanObj(int intValue, const char *file, int line) +#} declare 23 { Tcl_Obj *Tcl_DbNewByteArrayObj(const unsigned char *bytes, Tcl_Size numBytes, const char *file, int line) @@ -119,9 +120,10 @@ declare 25 { Tcl_Obj *Tcl_DbNewListObj(Tcl_Size objc, Tcl_Obj *const *objv, const char *file, int line) } -declare 26 {deprecated {No longer in use, changed to macro}} { - Tcl_Obj *Tcl_DbNewLongObj(long longValue, const char *file, int line) -} +# Removed in 9.0 (changed to macro): +#declare 26 { +# Tcl_Obj *Tcl_DbNewLongObj(long longValue, const char *file, int line) +#} declare 27 { Tcl_Obj *Tcl_DbNewObj(const char *file, int line) } @@ -144,7 +146,7 @@ declare 32 { } # Only available in Tcl 8.x, NULL in Tcl 9.0 declare 33 { - unsigned char *Tcl_GetByteArrayFromObj(Tcl_Obj *objPtr, int *numBytesPtr) + unsigned char *TclGetByteArrayFromObj(Tcl_Obj *objPtr, int *numBytesPtr) } declare 34 { int Tcl_GetDouble(Tcl_Interp *interp, const char *src, double *doublePtr) @@ -153,10 +155,11 @@ declare 35 { int Tcl_GetDoubleFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, double *doublePtr) } -declare 36 {deprecated {No longer in use, changed to macro}} { - int Tcl_GetIndexFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, - const char *const *tablePtr, const char *msg, int flags, int *indexPtr) -} +# Removed in 9.0, replaced by macro. +#declare 36 { +# int Tcl_GetIndexFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, +# const char *const *tablePtr, const char *msg, int flags, int *indexPtr) +#} declare 37 { int Tcl_GetInt(Tcl_Interp *interp, const char *src, int *intPtr) } @@ -167,10 +170,10 @@ declare 39 { int Tcl_GetLongFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr) } declare 40 { - CONST86 Tcl_ObjType *Tcl_GetObjType(const char *typeName) + const Tcl_ObjType *Tcl_GetObjType(const char *typeName) } declare 41 { - char *Tcl_GetStringFromObj(Tcl_Obj *objPtr, int *lengthPtr) + char *TclGetStringFromObj(Tcl_Obj *objPtr, int *lengthPtr) } declare 42 { void Tcl_InvalidateStringRep(Tcl_Obj *objPtr) @@ -184,7 +187,7 @@ declare 44 { Tcl_Obj *objPtr) } declare 45 { - int Tcl_ListObjGetElements(Tcl_Interp *interp, Tcl_Obj *listPtr, + int TclListObjGetElements(Tcl_Interp *interp, Tcl_Obj *listPtr, int *objcPtr, Tcl_Obj ***objvPtr) } declare 46 { @@ -192,40 +195,44 @@ declare 46 { Tcl_Obj **objPtrPtr) } declare 47 { - int Tcl_ListObjLength(Tcl_Interp *interp, Tcl_Obj *listPtr, + int TclListObjLength(Tcl_Interp *interp, Tcl_Obj *listPtr, int *lengthPtr) } declare 48 { int Tcl_ListObjReplace(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size first, Tcl_Size count, Tcl_Size objc, Tcl_Obj *const objv[]) } -declare 49 {deprecated {No longer in use, changed to macro}} { - Tcl_Obj *Tcl_NewBooleanObj(int intValue) -} +# Removed in 9.0 (changed to macro): +#declare 49 { +# Tcl_Obj *Tcl_NewBooleanObj(int intValue) +#} declare 50 { Tcl_Obj *Tcl_NewByteArrayObj(const unsigned char *bytes, Tcl_Size numBytes) } declare 51 { Tcl_Obj *Tcl_NewDoubleObj(double doubleValue) } -declare 52 {deprecated {No longer in use, changed to macro}} { - Tcl_Obj *Tcl_NewIntObj(int intValue) -} +# Removed in 9.0 (changed to macro): +#declare 52 { +# Tcl_Obj *Tcl_NewIntObj(int intValue) +#} declare 53 { Tcl_Obj *Tcl_NewListObj(Tcl_Size objc, Tcl_Obj *const objv[]) } -declare 54 {deprecated {No longer in use, changed to macro}} { - Tcl_Obj *Tcl_NewLongObj(long longValue) -} +# Removed in 9.0 (changed to macro): +#declare 54 { +# Tcl_Obj *Tcl_NewLongObj(long longValue) +#} declare 55 { Tcl_Obj *Tcl_NewObj(void) } declare 56 { Tcl_Obj *Tcl_NewStringObj(const char *bytes, Tcl_Size length) } -declare 57 {deprecated {No longer in use, changed to macro}} { - void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int intValue) -} +# Removed in 9.0 (changed to macro): +#declare 57 { +# void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int intValue) +#} declare 58 { unsigned char *Tcl_SetByteArrayLength(Tcl_Obj *objPtr, Tcl_Size numBytes) } @@ -236,28 +243,32 @@ declare 59 { declare 60 { void Tcl_SetDoubleObj(Tcl_Obj *objPtr, double doubleValue) } -declare 61 {deprecated {No longer in use, changed to macro}} { - void Tcl_SetIntObj(Tcl_Obj *objPtr, int intValue) -} +# Removed in 9.0 (changed to macro): +#declare 61 { +# void Tcl_SetIntObj(Tcl_Obj *objPtr, int intValue) +#} declare 62 { void Tcl_SetListObj(Tcl_Obj *objPtr, Tcl_Size objc, Tcl_Obj *const objv[]) } -declare 63 {deprecated {No longer in use, changed to macro}} { - void Tcl_SetLongObj(Tcl_Obj *objPtr, long longValue) -} +# Removed in 9.0 (changed to macro): +#declare 63 { +# void Tcl_SetLongObj(Tcl_Obj *objPtr, long longValue) +#} declare 64 { void Tcl_SetObjLength(Tcl_Obj *objPtr, Tcl_Size length) } declare 65 { void Tcl_SetStringObj(Tcl_Obj *objPtr, const char *bytes, Tcl_Size length) } -declare 66 {deprecated {No longer in use, changed to macro}} { - void Tcl_AddErrorInfo(Tcl_Interp *interp, const char *message) -} -declare 67 {deprecated {No longer in use, changed to macro}} { - void Tcl_AddObjErrorInfo(Tcl_Interp *interp, const char *message, - int length) -} +# Removed in 9.0, replaced by macro. +#declare 66 { +# void Tcl_AddErrorInfo(Tcl_Interp *interp, const char *message) +#} +# Removed in 9.0, replaced by macro. +#declare 67 { +# void Tcl_AddObjErrorInfo(Tcl_Interp *interp, const char *message, +# int length) +#} declare 68 { void Tcl_AllowExceptions(Tcl_Interp *interp) } @@ -283,12 +294,14 @@ declare 74 { declare 75 { int Tcl_AsyncReady(void) } -declare 76 {deprecated {No longer in use, changed to macro}} { - void Tcl_BackgroundError(Tcl_Interp *interp) -} -declare 77 {deprecated {Use Tcl_UtfBackslash}} { - char Tcl_Backslash(const char *src, int *readPtr) -} +# Removed in 9.0 +#declare 76 { +# void Tcl_BackgroundError(Tcl_Interp *interp) +#} +# Removed in 9.0: +#declare 77 { +# char Tcl_Backslash(const char *src, int *readPtr) +#} declare 78 { int Tcl_BadChannelOption(Tcl_Interp *interp, const char *optionName, const char *optionList) @@ -354,11 +367,12 @@ declare 93 { declare 94 { Tcl_Interp *Tcl_CreateInterp(void) } -declare 95 {deprecated {}} { - void Tcl_CreateMathFunc(Tcl_Interp *interp, const char *name, - int numArgs, Tcl_ValueType *argTypes, - Tcl_MathProc *proc, void *clientData) -} +# Removed in 9.0: +#declare 95 { +# void Tcl_CreateMathFunc(Tcl_Interp *interp, const char *name, +# int numArgs, Tcl_ValueType *argTypes, +# Tcl_MathProc *proc, void *clientData) +#} declare 96 { Tcl_Command Tcl_CreateObjCommand(Tcl_Interp *interp, const char *cmdName, @@ -468,15 +482,17 @@ declare 127 { declare 128 { const char *Tcl_ErrnoMsg(int err) } -declare 129 { - int Tcl_Eval(Tcl_Interp *interp, const char *script) -} +# Removed in 9.0, replaced by macro. +#declare 129 { +# int Tcl_Eval(Tcl_Interp *interp, const char *script) +#} declare 130 { int Tcl_EvalFile(Tcl_Interp *interp, const char *fileName) } -declare 131 {deprecated {No longer in use, changed to macro}} { - int Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr) -} +# Removed in 9.0, replaced by macro. +#declare 131 { +# int Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr) +#} declare 132 { void Tcl_EventuallyFree(void *clientData, Tcl_FreeProc *freeProc) } @@ -515,9 +531,10 @@ declare 142 { declare 143 { void Tcl_Finalize(void) } -declare 144 {nostub {Don't use this function in a stub-enabled extension}} { - const char *Tcl_FindExecutable(const char *argv0) -} +# Removed in 9.0 (stub entry only) +#declare 144 { +# const char *Tcl_FindExecutable(const char *argv0) +#} declare 145 { Tcl_HashEntry *Tcl_FirstHashEntry(Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr) @@ -525,9 +542,10 @@ declare 145 { declare 146 { int Tcl_Flush(Tcl_Channel chan) } -declare 147 {deprecated {see TIP #559. Use Tcl_ResetResult}} { - void Tcl_FreeResult(Tcl_Interp *interp) -} +# Removed in 9.0, TIP 559 +#declare 147 { +# void Tcl_FreeResult(Tcl_Interp *interp) +#} declare 148 { int Tcl_GetAlias(Tcl_Interp *interp, const char *childCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, @@ -567,7 +585,7 @@ declare 157 { const char *optionName, Tcl_DString *dsPtr) } declare 158 { - CONST86 Tcl_ChannelType *Tcl_GetChannelType(Tcl_Channel chan) + const Tcl_ChannelType *Tcl_GetChannelType(Tcl_Channel chan) } declare 159 { int Tcl_GetCommandInfo(Tcl_Interp *interp, const char *cmdName, @@ -599,7 +617,7 @@ declare 166 { # Tcl_GetOpenFile is only available on unix, but it is a part of the old # generic interface, so we include it here for compatibility reasons. -declare 167 unix { +declare 167 { int Tcl_GetOpenFile(Tcl_Interp *interp, const char *chanID, int forWriting, int checkUsage, void **filePtr) } @@ -623,23 +641,27 @@ declare 172 { declare 173 { Tcl_Channel Tcl_GetStdChannel(int type) } -declare 174 { - const char *Tcl_GetStringResult(Tcl_Interp *interp) -} -declare 175 {deprecated {No longer in use, changed to macro}} { - const char *Tcl_GetVar(Tcl_Interp *interp, const char *varName, - int flags) -} +# Removed in 9.0, replaced by macro. +#declare 174 { +# const char *Tcl_GetStringResult(Tcl_Interp *interp) +#} +# Removed in 9.0, replaced by macro. +#declare 175 { +# const char *Tcl_GetVar(Tcl_Interp *interp, const char *varName, +# int flags) +#} declare 176 { const char *Tcl_GetVar2(Tcl_Interp *interp, const char *part1, const char *part2, int flags) } -declare 177 { - int Tcl_GlobalEval(Tcl_Interp *interp, const char *command) -} -declare 178 {deprecated {No longer in use, changed to macro}} { - int Tcl_GlobalEvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr) -} +# Removed in 9.0, replaced by macro. +#declare 177 { +# int Tcl_GlobalEval(Tcl_Interp *interp, const char *command) +#} +# Removed in 9.0, replaced by macro. +#declare 178 { +# int Tcl_GlobalEvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr) +#} declare 179 { int Tcl_HideCommand(Tcl_Interp *interp, const char *cmdName, const char *hiddenCmdToken) @@ -680,9 +702,10 @@ declare 187 { declare 189 { Tcl_Channel Tcl_MakeFileChannel(void *handle, int mode) } -declare 190 {deprecated {}} { - int Tcl_MakeSafe(Tcl_Interp *interp) -} +# Removed in 9.0 +#declare 190 { +# int Tcl_MakeSafe(Tcl_Interp *interp) +#} declare 191 { Tcl_Channel Tcl_MakeTcpClientChannel(void *tcpSocket) } @@ -781,9 +804,10 @@ declare 218 { declare 219 { Tcl_Size Tcl_ScanCountedElement(const char *src, Tcl_Size length, int *flagPtr) } -declare 220 {deprecated {}} { - int Tcl_SeekOld(Tcl_Channel chan, int offset, int mode) -} +# Removed in 9.0: +#declare 220 { +# int Tcl_SeekOld(Tcl_Channel chan, int offset, int mode) +#} declare 221 { int Tcl_ServiceAll(void) } @@ -814,16 +838,18 @@ declare 228 { declare 229 { void Tcl_SetMaxBlockTime(const Tcl_Time *timePtr) } -declare 230 {nostub {Don't use this function in a stub-enabled extension}} { - const char *Tcl_SetPanicProc(TCL_NORETURN1 Tcl_PanicProc *panicProc) -} +# Removed in 9.0 (stub entry only) +#declare 230 { +# const char *Tcl_SetPanicProc(TCL_NORETURN1 Tcl_PanicProc *panicProc) +#} declare 231 { Tcl_Size Tcl_SetRecursionLimit(Tcl_Interp *interp, Tcl_Size depth) } -declare 232 { - void Tcl_SetResult(Tcl_Interp *interp, char *result, - Tcl_FreeProc *freeProc) -} +# Removed in 9.0, replaced by macro. +#declare 232 { +# void Tcl_SetResult(Tcl_Interp *interp, char *result, +# Tcl_FreeProc *freeProc) +#} declare 233 { int Tcl_SetServiceMode(int mode) } @@ -836,10 +862,11 @@ declare 235 { declare 236 { void Tcl_SetStdChannel(Tcl_Channel channel, int type) } -declare 237 {deprecated {No longer in use, changed to macro}} { - const char *Tcl_SetVar(Tcl_Interp *interp, const char *varName, - const char *newValue, int flags) -} +# Removed in 9.0, replaced by macro. +#declare 237 { +# const char *Tcl_SetVar(Tcl_Interp *interp, const char *varName, +# const char *newValue, int flags) +#} declare 238 { const char *Tcl_SetVar2(Tcl_Interp *interp, const char *part1, const char *part2, const char *newValue, int flags) @@ -854,27 +881,31 @@ declare 241 { void Tcl_SourceRCFile(Tcl_Interp *interp) } declare 242 { - int Tcl_SplitList(Tcl_Interp *interp, const char *listStr, int *argcPtr, + int TclSplitList(Tcl_Interp *interp, const char *listStr, int *argcPtr, const char ***argvPtr) } # Obsolete, use Tcl_FSSplitPath declare 243 { - void Tcl_SplitPath(const char *path, int *argcPtr, const char ***argvPtr) -} -declare 244 {nostub {Don't use this function in a stub-enabled extension}} { - void Tcl_StaticLibrary(Tcl_Interp *interp, const char *prefix, - Tcl_LibraryInitProc *initProc, Tcl_LibraryInitProc *safeInitProc) -} -declare 245 {deprecated {No longer in use, changed to macro}} { - int Tcl_StringMatch(const char *str, const char *pattern) -} -declare 246 {deprecated {}} { - int Tcl_TellOld(Tcl_Channel chan) -} -declare 247 {deprecated {No longer in use, changed to macro}} { - int Tcl_TraceVar(Tcl_Interp *interp, const char *varName, int flags, - Tcl_VarTraceProc *proc, void *clientData) -} + void TclSplitPath(const char *path, int *argcPtr, const char ***argvPtr) +} +# Removed in 9.0 (stub entry only) +#declare 244 { +# void Tcl_StaticLibrary(Tcl_Interp *interp, const char *prefix, +# Tcl_LibraryInitProc *initProc, Tcl_LibraryInitProc *safeInitProc) +#} +# Removed in 9.0 (stub entry only) +#declare 245 { +# int Tcl_StringMatch(const char *str, const char *pattern) +#} +# Removed in 9.0: +#declare 246 { +# int Tcl_TellOld(Tcl_Channel chan) +#} +# Removed in 9.0, replaced by macro. +#declare 247 { +# int Tcl_TraceVar(Tcl_Interp *interp, const char *varName, int flags, +# Tcl_VarTraceProc *proc, void *clientData) +#} declare 248 { int Tcl_TraceVar2(Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, void *clientData) @@ -892,17 +923,19 @@ declare 251 { declare 252 { int Tcl_UnregisterChannel(Tcl_Interp *interp, Tcl_Channel chan) } -declare 253 {deprecated {No longer in use, changed to macro}} { - int Tcl_UnsetVar(Tcl_Interp *interp, const char *varName, int flags) -} +# Removed in 9.0, replaced by macro. +#declare 253 { +# int Tcl_UnsetVar(Tcl_Interp *interp, const char *varName, int flags) +#} declare 254 { int Tcl_UnsetVar2(Tcl_Interp *interp, const char *part1, const char *part2, int flags) } -declare 255 {deprecated {No longer in use, changed to macro}} { - void Tcl_UntraceVar(Tcl_Interp *interp, const char *varName, int flags, - Tcl_VarTraceProc *proc, void *clientData) -} +# Removed in 9.0, replaced by macro. +#declare 255 { +# void Tcl_UntraceVar(Tcl_Interp *interp, const char *varName, int flags, +# Tcl_VarTraceProc *proc, void *clientData) +#} declare 256 { void Tcl_UntraceVar2(Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, @@ -911,10 +944,11 @@ declare 256 { declare 257 { void Tcl_UpdateLinkedVar(Tcl_Interp *interp, const char *varName) } -declare 258 {deprecated {No longer in use, changed to macro}} { - int Tcl_UpVar(Tcl_Interp *interp, const char *frameName, - const char *varName, const char *localName, int flags) -} +# Removed in 9.0, replaced by macro. +#declare 258 { +# int Tcl_UpVar(Tcl_Interp *interp, const char *frameName, +# const char *varName, const char *localName, int flags) +#} declare 259 { int Tcl_UpVar2(Tcl_Interp *interp, const char *frameName, const char *part1, const char *part2, const char *localName, int flags) @@ -922,10 +956,11 @@ declare 259 { declare 260 { int Tcl_VarEval(Tcl_Interp *interp, ...) } -declare 261 {deprecated {No longer in use, changed to macro}} { - void *Tcl_VarTraceInfo(Tcl_Interp *interp, const char *varName, - int flags, Tcl_VarTraceProc *procPtr, void *prevClientData) -} +# Removed in 9.0, replaced by macro. +#declare 261 { +# void *Tcl_VarTraceInfo(Tcl_Interp *interp, const char *varName, +# int flags, Tcl_VarTraceProc *procPtr, void *prevClientData) +#} declare 262 { void *Tcl_VarTraceInfo2(Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *procPtr, @@ -944,12 +979,14 @@ declare 265 { declare 266 { void Tcl_ValidateAllMemory(const char *file, int line) } -declare 267 {deprecated {see TIP #422}} { - void Tcl_AppendResultVA(Tcl_Interp *interp, va_list argList) -} -declare 268 {deprecated {see TIP #422}} { - void Tcl_AppendStringsToObjVA(Tcl_Obj *objPtr, va_list argList) -} +# Removed in 9.0: +#declare 267 { +# void Tcl_AppendResultVA(Tcl_Interp *interp, va_list argList) +#} +# Removed in 9.0: +#declare 268 { +# void Tcl_AppendStringsToObjVA(Tcl_Obj *objPtr, va_list argList) +#} declare 269 { char *Tcl_HashStats(Tcl_HashTable *tablePtr) } @@ -957,36 +994,42 @@ declare 270 { const char *Tcl_ParseVar(Tcl_Interp *interp, const char *start, const char **termPtr) } -declare 271 {deprecated {No longer in use, changed to macro}} { - const char *Tcl_PkgPresent(Tcl_Interp *interp, const char *name, - const char *version, int exact) -} +# Removed in 9.0, replaced by macro. +#declare 271 { +# const char *Tcl_PkgPresent(Tcl_Interp *interp, const char *name, +# const char *version, int exact) +#} declare 272 { const char *Tcl_PkgPresentEx(Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr) } -declare 273 {deprecated {No longer in use, changed to macro}} { - int Tcl_PkgProvide(Tcl_Interp *interp, const char *name, - const char *version) -} +# Removed in 9.0, replaced by macro. +#declare 273 { +# int Tcl_PkgProvide(Tcl_Interp *interp, const char *name, +# const char *version) +#} # TIP #268: The internally used new Require function is in slot 573. -declare 274 {deprecated {No longer in use, changed to macro}} { - const char *Tcl_PkgRequire(Tcl_Interp *interp, const char *name, - const char *version, int exact) -} -declare 275 {deprecated {see TIP #422}} { - void Tcl_SetErrorCodeVA(Tcl_Interp *interp, va_list argList) -} -declare 276 {deprecated {see TIP #422}} { - int Tcl_VarEvalVA(Tcl_Interp *interp, va_list argList) -} +# Removed in 9.0, replaced by macro. +#declare 274 { +# const char *Tcl_PkgRequire(Tcl_Interp *interp, const char *name, +# const char *version, int exact) +#} +# Removed in 9.0: +#declare 275 { +# void Tcl_SetErrorCodeVA(Tcl_Interp *interp, va_list argList) +#} +# Removed in 9.0: +#declare 276 { +# int Tcl_VarEvalVA(Tcl_Interp *interp, va_list argList) +#} declare 277 { Tcl_Pid Tcl_WaitPid(Tcl_Pid pid, int *statPtr, int options) } -declare 278 {deprecated {see TIP #422}} { - TCL_NORETURN void Tcl_PanicVA(const char *format, va_list argList) -} +# Removed in 9.0: +#declare 278 { +# TCL_NORETURN void Tcl_PanicVA(const char *format, va_list argList) +#} declare 279 { void Tcl_GetVersion(int *major, int *minor, int *patchLevel, int *type) } @@ -1043,9 +1086,10 @@ declare 288 { declare 289 { void Tcl_DeleteThreadExitHandler(Tcl_ExitProc *proc, void *clientData) } -declare 290 {deprecated {Use Tcl_DiscardInterpState}} { - void Tcl_DiscardResult(Tcl_SavedResult *statePtr) -} +# Removed in 9.0 +#declare 290 { +# void Tcl_DiscardResult(Tcl_SavedResult *statePtr) +#} declare 291 { int Tcl_EvalEx(Tcl_Interp *interp, const char *script, Tcl_Size numBytes, int flags) @@ -1120,18 +1164,20 @@ declare 311 { const Tcl_Time *timePtr) } declare 312 { - Tcl_Size Tcl_NumUtfChars(const char *src, Tcl_Size length) + Tcl_Size TclNumUtfChars(const char *src, Tcl_Size length) } declare 313 { Tcl_Size Tcl_ReadChars(Tcl_Channel channel, Tcl_Obj *objPtr, Tcl_Size charsToRead, int appendFlag) } -declare 314 {deprecated {Use Tcl_RestoreInterpState}} { - void Tcl_RestoreResult(Tcl_Interp *interp, Tcl_SavedResult *statePtr) -} -declare 315 {deprecated {Use Tcl_SaveInterpState}} { - void Tcl_SaveResult(Tcl_Interp *interp, Tcl_SavedResult *statePtr) -} +# Removed in 9.0 +#declare 314 { +# void Tcl_RestoreResult(Tcl_Interp *interp, Tcl_SavedResult *statePtr) +#} +# Removed in 9.0 +#declare 315 { +# void Tcl_SaveResult(Tcl_Interp *interp, Tcl_SavedResult *statePtr) +#} declare 316 { int Tcl_SetSystemEncoding(Tcl_Interp *interp, const char *name) } @@ -1159,10 +1205,10 @@ declare 323 { int Tcl_UniCharToUpper(int ch) } declare 324 { - int Tcl_UniCharToUtf(int ch, char *buf) + Tcl_Size Tcl_UniCharToUtf(int ch, char *buf) } declare 325 { - const char *Tcl_UtfAtIndex(const char *src, Tcl_Size index) + const char *TclUtfAtIndex(const char *src, Tcl_Size index) } declare 326 { int TclUtfCharComplete(const char *src, Tcl_Size length) @@ -1193,16 +1239,16 @@ declare 333 { const char *src, Tcl_Size srcLen, Tcl_DString *dsPtr) } declare 334 { - int Tcl_UtfToLower(char *src) + Tcl_Size Tcl_UtfToLower(char *src) } declare 335 { - int Tcl_UtfToTitle(char *src) + Tcl_Size Tcl_UtfToTitle(char *src) } declare 336 { - int Tcl_UtfToChar16(const char *src, unsigned short *chPtr) + Tcl_Size Tcl_UtfToChar16(const char *src, unsigned short *chPtr) } declare 337 { - int Tcl_UtfToUpper(char *src) + Tcl_Size Tcl_UtfToUpper(char *src) } declare 338 { Tcl_Size Tcl_WriteChars(Tcl_Channel chan, const char *src, Tcl_Size srcLen) @@ -1213,12 +1259,14 @@ declare 339 { declare 340 { char *Tcl_GetString(Tcl_Obj *objPtr) } -declare 341 {deprecated {Use Tcl_GetEncodingSearchPath}} { - const char *Tcl_GetDefaultEncodingDir(void) -} -declare 342 {deprecated {Use Tcl_SetEncodingSearchPath}} { - void Tcl_SetDefaultEncodingDir(const char *path) -} +# Removed in 9.0: +#declare 341 { +# const char *Tcl_GetDefaultEncodingDir(void) +#} +# Removed in 9.0: +#declare 342 { +# void Tcl_SetDefaultEncodingDir(const char *path) +#} declare 343 { void Tcl_AlertNotifier(void *clientData) } @@ -1249,10 +1297,11 @@ declare 351 { declare 352 { Tcl_Size Tcl_Char16Len(const unsigned short *uniStr) } -declare 353 {deprecated {Use Tcl_UtfNcmp}} { - int Tcl_UniCharNcmp(const unsigned short *ucs, const unsigned short *uct, - unsigned long numChars) -} +# Removed in 9.0: +#declare 353 { +# int Tcl_UniCharNcmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, +# unsigned long numChars) +#} declare 354 { char *Tcl_Char16ToUtfDString(const unsigned short *uniStr, Tcl_Size uniLength, Tcl_DString *dsPtr) @@ -1265,10 +1314,11 @@ declare 356 { Tcl_RegExp Tcl_GetRegExpFromObj(Tcl_Interp *interp, Tcl_Obj *patObj, int flags) } -declare 357 {deprecated {Use Tcl_EvalTokensStandard}} { - Tcl_Obj *Tcl_EvalTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr, - int count) -} +# Removed in 9.0: +#declare 357 { +# Tcl_Obj *Tcl_EvalTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr, +# int count) +#} declare 358 { void Tcl_FreeParse(Tcl_Parse *parsePtr) } @@ -1313,10 +1363,10 @@ declare 368 { int Tcl_Stat(const char *path, struct stat *bufPtr) } declare 369 { - int Tcl_UtfNcmp(const char *s1, const char *s2, unsigned long n) + int Tcl_UtfNcmp(const char *s1, const char *s2, size_t n) } declare 370 { - int Tcl_UtfNcasecmp(const char *s1, const char *s2, unsigned long n) + int Tcl_UtfNcasecmp(const char *s1, const char *s2, size_t n) } declare 371 { int Tcl_StringCaseMatch(const char *str, const char *pattern, int nocase) @@ -1341,26 +1391,27 @@ declare 377 { void Tcl_RegExpGetInfo(Tcl_RegExp regexp, Tcl_RegExpInfo *infoPtr) } declare 378 { - Tcl_Obj *Tcl_NewUnicodeObj(const unsigned short *unicode, Tcl_Size numChars) + Tcl_Obj *Tcl_NewUnicodeObj(const Tcl_UniChar *unicode, Tcl_Size numChars) } declare 379 { - void Tcl_SetUnicodeObj(Tcl_Obj *objPtr, const unsigned short *unicode, + void Tcl_SetUnicodeObj(Tcl_Obj *objPtr, const Tcl_UniChar *unicode, Tcl_Size numChars) } declare 380 { - Tcl_Size Tcl_GetCharLength(Tcl_Obj *objPtr) + Tcl_Size TclGetCharLength(Tcl_Obj *objPtr) } declare 381 { - int Tcl_GetUniChar(Tcl_Obj *objPtr, Tcl_Size index) -} -declare 382 {deprecated {No longer in use, changed to macro}} { - unsigned short *Tcl_GetUnicode(Tcl_Obj *objPtr) + int TclGetUniChar(Tcl_Obj *objPtr, Tcl_Size index) } +# Removed in 9.0, replaced by macro. +#declare 382 { +# Tcl_UniChar *Tcl_GetUnicode(Tcl_Obj *objPtr) +#} declare 383 { - Tcl_Obj *Tcl_GetRange(Tcl_Obj *objPtr, Tcl_Size first, Tcl_Size last) + Tcl_Obj *TclGetRange(Tcl_Obj *objPtr, Tcl_Size first, Tcl_Size last) } declare 384 { - void Tcl_AppendUnicodeToObj(Tcl_Obj *objPtr, const unsigned short *unicode, + void Tcl_AppendUnicodeToObj(Tcl_Obj *objPtr, const Tcl_UniChar *unicode, Tcl_Size length) } declare 385 { @@ -1418,10 +1469,11 @@ declare 400 { Tcl_DriverBlockModeProc *Tcl_ChannelBlockModeProc( const Tcl_ChannelType *chanTypePtr) } -declare 401 {deprecated {Use Tcl_ChannelClose2Proc}} { - Tcl_DriverCloseProc *Tcl_ChannelCloseProc( - const Tcl_ChannelType *chanTypePtr) -} +# Removed in 9.0 +#declare 401 { +# Tcl_DriverCloseProc *Tcl_ChannelCloseProc( +# const Tcl_ChannelType *chanTypePtr) +#} declare 402 { Tcl_DriverClose2Proc *Tcl_ChannelClose2Proc( const Tcl_ChannelType *chanTypePtr) @@ -1434,10 +1486,11 @@ declare 404 { Tcl_DriverOutputProc *Tcl_ChannelOutputProc( const Tcl_ChannelType *chanTypePtr) } -declare 405 {deprecated {Use Tcl_ChannelWideSeekProc}} { - Tcl_DriverSeekProc *Tcl_ChannelSeekProc( - const Tcl_ChannelType *chanTypePtr) -} +# Removed in 9.0 +#declare 405 { +# Tcl_DriverSeekProc *Tcl_ChannelSeekProc( +# const Tcl_ChannelType *chanTypePtr) +#} declare 406 { Tcl_DriverSetOptionProc *Tcl_ChannelSetOptionProc( const Tcl_ChannelType *chanTypePtr) @@ -1485,21 +1538,25 @@ declare 417 { declare 418 { int Tcl_IsChannelExisting(const char *channelName) } -declare 419 {deprecated {Use Tcl_UtfNcasecmp}} { - int Tcl_UniCharNcasecmp(const unsigned short *ucs, const unsigned short *uct, - unsigned long numChars) -} -declare 420 {deprecated {Use Tcl_StringCaseMatch}} { - int Tcl_UniCharCaseMatch(const unsigned short *uniStr, - const unsigned short *uniPattern, int nocase) -} -declare 421 { - Tcl_HashEntry *Tcl_FindHashEntry(Tcl_HashTable *tablePtr, const void *key) -} -declare 422 { - Tcl_HashEntry *Tcl_CreateHashEntry(Tcl_HashTable *tablePtr, - const void *key, int *newPtr) -} +# Removed in 9.0: +#declare 419 { +# int Tcl_UniCharNcasecmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, +# unsigned long numChars) +#} +# Removed in 9.0: +#declare 420 { +# int Tcl_UniCharCaseMatch(const Tcl_UniChar *uniStr, +# const Tcl_UniChar *uniPattern, int nocase) +#} +# Removed in 9.0, as it is actually a macro: +#declare 421 { +# Tcl_HashEntry *Tcl_FindHashEntry(Tcl_HashTable *tablePtr, const void *key) +#} +# Removed in 9.0, as it is actually a macro: +#declare 422 { +# Tcl_HashEntry *Tcl_CreateHashEntry(Tcl_HashTable *tablePtr, +# const void *key, int *newPtr) +#} declare 423 { void Tcl_InitCustomHashTable(Tcl_HashTable *tablePtr, int keyType, const Tcl_HashKeyType *typePtr) @@ -1521,16 +1578,16 @@ declare 427 { int flags, Tcl_CommandTraceProc *proc, void *clientData) } declare 428 { - char *Tcl_AttemptAlloc(TCL_HASH_TYPE size) + void *Tcl_AttemptAlloc(TCL_HASH_TYPE size) } declare 429 { - char *Tcl_AttemptDbCkalloc(TCL_HASH_TYPE size, const char *file, int line) + void *Tcl_AttemptDbCkalloc(TCL_HASH_TYPE size, const char *file, int line) } declare 430 { - char *Tcl_AttemptRealloc(char *ptr, TCL_HASH_TYPE size) + void *Tcl_AttemptRealloc(void *ptr, TCL_HASH_TYPE size) } declare 431 { - char *Tcl_AttemptDbCkrealloc(char *ptr, TCL_HASH_TYPE size, + void *Tcl_AttemptDbCkrealloc(void *ptr, TCL_HASH_TYPE size, const char *file, int line) } declare 432 { @@ -1544,18 +1601,20 @@ declare 433 { # introduced in 8.4a3 declare 434 { - unsigned short *Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr, int *lengthPtr) + Tcl_UniChar *TclGetUnicodeFromObj(Tcl_Obj *objPtr, int *lengthPtr) } # TIP#15 (math function introspection) dkf -declare 435 {deprecated {}} { - int Tcl_GetMathFuncInfo(Tcl_Interp *interp, const char *name, - int *numArgsPtr, Tcl_ValueType **argTypesPtr, - Tcl_MathProc **procPtr, void **clientDataPtr) -} -declare 436 {deprecated {}} { - Tcl_Obj *Tcl_ListMathFuncs(Tcl_Interp *interp, const char *pattern) -} +# Removed in 9.0: +#declare 435 { +# int Tcl_GetMathFuncInfo(Tcl_Interp *interp, const char *name, +# int *numArgsPtr, Tcl_ValueType **argTypesPtr, +# Tcl_MathProc **procPtr, void **clientDataPtr) +#} +# Removed in 9.0: +#declare 436 { +# Tcl_Obj *Tcl_ListMathFuncs(Tcl_Interp *interp, const char *pattern) +#} # TIP#36 (better access to 'subst') dkf declare 437 { @@ -1617,7 +1676,7 @@ declare 452 { int index, Tcl_Obj *pathPtr, Tcl_Obj *objPtr) } declare 453 { - const char *CONST86 *Tcl_FSFileAttrStrings(Tcl_Obj *pathPtr, + const char *const *Tcl_FSFileAttrStrings(Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef) } declare 454 { @@ -1643,7 +1702,7 @@ declare 460 { Tcl_Obj *Tcl_FSJoinPath(Tcl_Obj *listObj, Tcl_Size elements) } declare 461 { - Tcl_Obj *Tcl_FSSplitPath(Tcl_Obj *pathPtr, int *lenPtr) + Tcl_Obj *TclFSSplitPath(Tcl_Obj *pathPtr, int *lenPtr) } declare 462 { int Tcl_FSEqualPaths(Tcl_Obj *firstPtr, Tcl_Obj *secondPtr) @@ -1695,7 +1754,7 @@ declare 476 { Tcl_Obj *pathPtr) } declare 477 { - CONST86 Tcl_Filesystem *Tcl_FSGetFileSystemForPath(Tcl_Obj *pathPtr) + const Tcl_Filesystem *Tcl_FSGetFileSystemForPath(Tcl_Obj *pathPtr) } declare 478 { Tcl_PathType Tcl_FSGetPathType(Tcl_Obj *pathPtr) @@ -1782,7 +1841,7 @@ declare 496 { Tcl_Obj *keyPtr) } declare 497 { - int Tcl_DictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr, int *sizePtr) + int TclDictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr, int *sizePtr) } declare 498 { int Tcl_DictObjFirst(Tcl_Interp *interp, Tcl_Obj *dictPtr, @@ -1870,10 +1929,10 @@ declare 518 { const char *encodingName) } -# TIP#121 (exit handler) dkf for Joe Mistachkin -declare 519 {nostub {Don't use this function in a stub-enabled extension}} { - Tcl_ExitProc *Tcl_SetExitProc(TCL_NORETURN1 Tcl_ExitProc *proc) -} +# Removed in 9.0 (stub entry only) +#declare 519 {nostub {Don't use this function in a stub-enabled extension}} { +# Tcl_ExitProc *Tcl_SetExitProc(TCL_NORETURN1 Tcl_ExitProc *proc) +#} # TIP#143 (resource limits) dkf declare 520 { @@ -2210,7 +2269,7 @@ declare 603 { # TIP#265 (option parser) dkf for Sam Bromley declare 604 { - int Tcl_ParseArgsObjv(Tcl_Interp *interp, const Tcl_ArgvInfo *argTable, + int TclParseArgsObjv(Tcl_Interp *interp, const Tcl_ArgvInfo *argTable, int *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv) } @@ -2395,7 +2454,7 @@ declare 645 { # TIP #548 declare 646 { - int Tcl_UtfToUniChar(const char *src, int *chPtr) + Tcl_Size Tcl_UtfToUniChar(const char *src, int *chPtr) } declare 647 { char *Tcl_UniCharToUtfDString(const int *uniStr, @@ -2418,14 +2477,14 @@ declare 650 { # TIP #481 declare 651 { - char *TclGetStringFromObj(Tcl_Obj *objPtr, size_t *lengthPtr) + char *Tcl_GetStringFromObj(Tcl_Obj *objPtr, size_t *lengthPtr) } declare 652 { - unsigned short *TclGetUnicodeFromObj(Tcl_Obj *objPtr, size_t *lengthPtr) + Tcl_UniChar *Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr, size_t *lengthPtr) } # Only available in Tcl 8.x, NULL in Tcl 9.0 declare 653 { - unsigned char *TclGetByteArrayFromObj(Tcl_Obj *objPtr, size_t *numBytesPtr) + unsigned char *Tcl_GetByteArrayFromObj(Tcl_Obj *objPtr, size_t *numBytesPtr) } # TIP #575 @@ -2457,28 +2516,28 @@ declare 660 { # TIP #616 declare 661 { - int TclListObjGetElements(Tcl_Interp *interp, Tcl_Obj *listPtr, + int Tcl_ListObjGetElements(Tcl_Interp *interp, Tcl_Obj *listPtr, size_t *objcPtr, Tcl_Obj ***objvPtr) } declare 662 { - int TclListObjLength(Tcl_Interp *interp, Tcl_Obj *listPtr, + int Tcl_ListObjLength(Tcl_Interp *interp, Tcl_Obj *listPtr, size_t *lengthPtr) } declare 663 { - int TclDictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr, size_t *sizePtr) + int Tcl_DictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr, size_t *sizePtr) } declare 664 { - int TclSplitList(Tcl_Interp *interp, const char *listStr, size_t *argcPtr, + int Tcl_SplitList(Tcl_Interp *interp, const char *listStr, size_t *argcPtr, const char ***argvPtr) } declare 665 { - void TclSplitPath(const char *path, size_t *argcPtr, const char ***argvPtr) + void Tcl_SplitPath(const char *path, size_t *argcPtr, const char ***argvPtr) } declare 666 { - Tcl_Obj *TclFSSplitPath(Tcl_Obj *pathPtr, size_t *lenPtr) + Tcl_Obj *Tcl_FSSplitPath(Tcl_Obj *pathPtr, size_t *lenPtr) } declare 667 { - int TclParseArgsObjv(Tcl_Interp *interp, const Tcl_ArgvInfo *argTable, + int Tcl_ParseArgsObjv(Tcl_Interp *interp, const Tcl_ArgvInfo *argTable, size_t *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv) } @@ -2487,19 +2546,19 @@ declare 668 { Tcl_Size Tcl_UniCharLen(const int *uniStr) } declare 669 { - Tcl_Size TclNumUtfChars(const char *src, Tcl_Size length) + Tcl_Size Tcl_NumUtfChars(const char *src, Tcl_Size length) } declare 670 { - Tcl_Size TclGetCharLength(Tcl_Obj *objPtr) + Tcl_Size Tcl_GetCharLength(Tcl_Obj *objPtr) } declare 671 { - const char *TclUtfAtIndex(const char *src, Tcl_Size index) + const char *Tcl_UtfAtIndex(const char *src, Tcl_Size index) } declare 672 { - Tcl_Obj *TclGetRange(Tcl_Obj *objPtr, Tcl_Size first, Tcl_Size last) + Tcl_Obj *Tcl_GetRange(Tcl_Obj *objPtr, Tcl_Size first, Tcl_Size last) } declare 673 { - int TclGetUniChar(Tcl_Obj *objPtr, Tcl_Size index) + int Tcl_GetUniChar(Tcl_Obj *objPtr, Tcl_Size index) } declare 674 { @@ -2581,45 +2640,28 @@ interface tclPlat # (none) ################################ -# Windows specific functions - -# Added in Tcl 8.1 - -declare 0 win { - TCHAR *Tcl_WinUtfToTChar(const char *str, int len, Tcl_DString *dsPtr) -} -declare 1 win { - char *Tcl_WinTCharToUtf(const TCHAR *str, int len, Tcl_DString *dsPtr) -} -declare 3 win { - void Tcl_WinConvertError(unsigned errCode) -} - -################################ # Mac OS X specific functions -declare 0 macosx { - int Tcl_MacOSXOpenBundleResources(Tcl_Interp *interp, - const char *bundleName, int hasResourceFile, - int maxPathLen, char *libraryPath) -} -declare 1 macosx { +declare 1 { int Tcl_MacOSXOpenVersionedBundleResources(Tcl_Interp *interp, const char *bundleName, const char *bundleVersion, - int hasResourceFile, int maxPathLen, char *libraryPath) + int hasResourceFile, size_t maxPathLen, char *libraryPath) } -declare 2 macosx { +declare 2 { void Tcl_MacOSXNotifierAddRunLoopMode(const void *runLoopMode) } +################################ +# Windows specific functions +declare 3 { + void Tcl_WinConvertError(unsigned errCode) +} + ############################################################################## # Public functions that are not accessible via the stubs table. export { - void Tcl_Main(Tcl_Size argc, char **argv, Tcl_AppInitProc *appInitProc) -} -export { void Tcl_MainEx(Tcl_Size argc, char **argv, Tcl_AppInitProc *appInitProc, Tcl_Interp *interp) } diff --git a/generic/tcl.h b/generic/tcl.h index ebe989c..68d6719 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -48,34 +48,18 @@ extern "C" { */ #if !defined(TCL_MAJOR_VERSION) -# define TCL_MAJOR_VERSION 8 +# define TCL_MAJOR_VERSION 9 #endif -#if TCL_MAJOR_VERSION != 8 -# error "This header-file is for Tcl 8 only" -#endif -#define TCL_MINOR_VERSION 7 -#define TCL_RELEASE_LEVEL TCL_ALPHA_RELEASE -#define TCL_RELEASE_SERIAL 6 - -#define TCL_VERSION "8.7" -#define TCL_PATCH_LEVEL "8.7a6" +#if TCL_MAJOR_VERSION == 9 +# define TCL_MINOR_VERSION 0 +# define TCL_RELEASE_LEVEL TCL_ALPHA_RELEASE +# define TCL_RELEASE_SERIAL 4 + +# define TCL_VERSION "9.0" +# define TCL_PATCH_LEVEL "9.0a4" +#endif /* TCL_MAJOR_VERSION */ -#if !defined(TCL_NO_DEPRECATED) || defined(RC_INVOKED) -/* - *---------------------------------------------------------------------------- - * The following definitions set up the proper options for Windows compilers. - * We use this method because there is no autoconf equivalent. - */ - -#ifdef _WIN32 -# ifndef __WIN32__ -# define __WIN32__ -# endif -# ifndef WIN32 -# define WIN32 -# endif -#endif - +#if defined(RC_INVOKED) /* * Utility macros: STRINGIFY takes an argument and wraps it in "" (double * quotation marks), JOIN joins two arguments. @@ -89,11 +73,7 @@ extern "C" { # define JOIN(a,b) JOIN1(a,b) # define JOIN1(a,b) a##b #endif - -#ifndef TCL_THREADS -# define TCL_THREADS 1 -#endif -#endif /* !TCL_NO_DEPRECATED */ +#endif /* RC_INVOKED */ /* * A special definition used to allow this header file to be included from @@ -123,24 +103,8 @@ extern "C" { */ #include <stdio.h> +#include <stddef.h> -/* - *---------------------------------------------------------------------------- - * Support for functions with a variable number of arguments. - * - * The following TCL_VARARGS* macros are to support old extensions - * written for older versions of Tcl where the macros permitted - * support for the varargs.h system as well as stdarg.h . - * - * New code should just directly be written to use stdarg.h conventions. - */ - -#include <stdarg.h> -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 -# define TCL_VARARGS(type, name) (type name, ...) -# define TCL_VARARGS_DEF(type, name) (type name, ...) -# define TCL_VARARGS_START(type, name, list) (va_start(list, name), name) -#endif /* !TCL_NO_DEPRECATED */ #if defined(__GNUC__) && (__GNUC__ > 2) # if defined(_WIN32) && defined(__USE_MINGW_ANSI_STDIO) && __USE_MINGW_ANSI_STDIO # define TCL_FORMAT_PRINTF(a,b) __attribute__ ((__format__ (__MINGW_PRINTF_FORMAT, a, b))) @@ -149,15 +113,16 @@ extern "C" { # endif # define TCL_NORETURN __attribute__ ((noreturn)) # define TCL_NOINLINE __attribute__ ((noinline)) -# if defined(BUILD_tcl) || defined(BUILD_tk) -# define TCL_NORETURN1 __attribute__ ((noreturn)) -# else -# define TCL_NORETURN1 /* nothing */ -# endif +# define TCL_NORETURN1 __attribute__ ((noreturn)) #else # define TCL_FORMAT_PRINTF(a,b) -# define TCL_NORETURN _declspec(noreturn) -# define TCL_NOINLINE __declspec(noinline) +# if defined(_MSC_VER) +# define TCL_NORETURN _declspec(noreturn) +# define TCL_NOINLINE __declspec(noinline) +# else +# define TCL_NORETURN /* nothing */ +# define TCL_NOINLINE /* nothing */ +# endif # define TCL_NORETURN1 /* nothing */ #endif @@ -243,33 +208,7 @@ extern "C" { # endif #endif -/* - * The following _ANSI_ARGS_ macro is to support old extensions - * written for older versions of Tcl where it permitted support - * for compilers written in the pre-prototype era of C. - * - * New code should use prototypes. - */ - -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 -# undef _ANSI_ARGS_ -# define _ANSI_ARGS_(x) x - -/* - * Definitions that allow this header file to be used either with or without - * ANSI C features. - */ - -#ifndef INLINE -# define INLINE -#endif -#ifndef CONST -# define CONST const -#endif - -#endif /* !TCL_NO_DEPRECATED */ - -#ifndef CONST86 +#if !defined(CONST86) && !defined(TCL_NO_DEPRECATED) # define CONST86 const #endif @@ -288,33 +227,6 @@ extern "C" { #endif /* - *---------------------------------------------------------------------------- - * The following code is copied from winnt.h. If we don't replicate it here, - * then <windows.h> can't be included after tcl.h, since tcl.h also defines - * VOID. This block is skipped under Cygwin and Mingw. - */ - -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 -#if defined(_WIN32) && !defined(HAVE_WINNT_IGNORE_VOID) -#ifndef VOID -#define VOID void -typedef char CHAR; -typedef short SHORT; -typedef long LONG; -#endif -#endif /* _WIN32 && !HAVE_WINNT_IGNORE_VOID */ - -/* - * Macro to use instead of "void" for arguments that must have type "void *" - * in ANSI C; maps them to type "char *" in non-ANSI systems. - */ - -#ifndef __VXWORKS__ -# define VOID void -#endif -#endif /* !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 */ - -/* * Miscellaneous declarations. */ @@ -447,34 +359,8 @@ typedef int Tcl_Size; /* *---------------------------------------------------------------------------- * Data structures defined opaquely in this module. The definitions below just - * provide dummy types. A few fields are made visible in Tcl_Interp - * structures, namely those used for returning a string result from commands. - * Direct access to the result field is discouraged in Tcl 8.0. The - * interpreter result is either an object or a string, and the two values are - * kept consistent unless some C code sets interp->result directly. - * Programmers should use either the function Tcl_GetObjResult() or - * Tcl_GetStringResult() to read the interpreter's result. See the SetResult - * man page for details. - * - * Note: any change to the Tcl_Interp definition below must be mirrored in the - * "real" definition in tclInt.h. - * - * Note: Tcl_ObjCmdProc functions do not directly set result and freeProc. - * Instead, they set a Tcl_Obj member in the "real" structure that can be - * accessed with Tcl_GetObjResult() and Tcl_SetObjResult(). - */ - -typedef struct Tcl_Interp -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 -{ - /* TIP #330: Strongly discourage extensions from using the string - * result. */ - char *resultDontUse; /* Don't use in extensions! */ - void (*freeProcDontUse) (char *); /* Don't use in extensions! */ - int errorLineDontUse; /* Don't use in extensions! */ -} -#endif /* !TCL_NO_DEPRECATED */ -Tcl_Interp; + * provide dummy types. + */ typedef struct Tcl_AsyncHandler_ *Tcl_AsyncHandler; typedef struct Tcl_Channel_ *Tcl_Channel; @@ -485,6 +371,7 @@ typedef struct Tcl_Dict_ *Tcl_Dict; typedef struct Tcl_EncodingState_ *Tcl_EncodingState; typedef struct Tcl_Encoding_ *Tcl_Encoding; typedef struct Tcl_Event Tcl_Event; +typedef struct Tcl_Interp Tcl_Interp; typedef struct Tcl_InterpState_ *Tcl_InterpState; typedef struct Tcl_LoadHandle_ *Tcl_LoadHandle; typedef struct Tcl_Mutex_ *Tcl_Mutex; @@ -572,6 +459,22 @@ typedef void (Tcl_ThreadCreateProc) (void *clientData); * string. */ +#if TCL_MAJOR_VERSION > 8 +typedef struct Tcl_RegExpIndices { + size_t start; /* Character offset of first character in + * match. */ + size_t end; /* Character offset of first character after + * the match. */ +} Tcl_RegExpIndices; + +typedef struct Tcl_RegExpInfo { + size_t nsubs; /* Number of subexpressions in the compiled + * expression. */ + Tcl_RegExpIndices *matches; /* Array of nsubs match offset pairs. */ + size_t 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. */ @@ -587,6 +490,7 @@ typedef struct Tcl_RegExpInfo { * might begin. */ long reserved; /* Reserved for later use. */ } Tcl_RegExpInfo; +#endif /* * Picky compilers complain if this typdef doesn't appear before the struct's @@ -623,10 +527,6 @@ typedef struct stat *Tcl_OldStat_; #define TCL_BREAK 3 #define TCL_CONTINUE 4 -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 -#define TCL_RESULT_SIZE 200 -#endif - /* *---------------------------------------------------------------------------- * Flags to control what substitutions are performed by Tcl_SubstObj(): @@ -638,27 +538,6 @@ typedef struct stat *Tcl_OldStat_; #define TCL_SUBST_ALL 007 /* - * Argument descriptors for math function callbacks in expressions: - */ - -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 -typedef enum { - TCL_INT, TCL_DOUBLE, TCL_EITHER, TCL_WIDE_INT -} Tcl_ValueType; - -typedef struct Tcl_Value { - Tcl_ValueType type; /* Indicates intValue or doubleValue is valid, - * or both. */ - long intValue; /* Integer value. */ - double doubleValue; /* Double-precision floating value. */ - Tcl_WideInt wideValue; /* Wide (min. 64-bit) integer value. */ -} Tcl_Value; -#else -#define Tcl_ValueType void /* Just enough to prevent compilation error in Tcl */ -#define Tcl_Value void /* Just enough to prevent compilation error in Tcl */ -#endif - -/* * Forward declaration of Tcl_Obj to prevent an error when the forward * reference to Tcl_Obj is encountered in the function types declared below. */ @@ -693,21 +572,19 @@ typedef void (Tcl_DupInternalRepProc) (struct Tcl_Obj *srcPtr, typedef int (Tcl_EncodingConvertProc) (void *clientData, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); -typedef void (Tcl_EncodingFreeProc) (void *clientData); +#define Tcl_EncodingFreeProc Tcl_FreeProc typedef int (Tcl_EventProc) (Tcl_Event *evPtr, int flags); typedef void (Tcl_EventCheckProc) (void *clientData, int flags); typedef int (Tcl_EventDeleteProc) (Tcl_Event *evPtr, void *clientData); typedef void (Tcl_EventSetupProc) (void *clientData, int flags); -typedef void (Tcl_ExitProc) (void *clientData); +#define Tcl_ExitProc Tcl_FreeProc typedef void (Tcl_FileProc) (void *clientData, int mask); -typedef void (Tcl_FileFreeProc) (void *clientData); +#define Tcl_FileFreeProc Tcl_FreeProc typedef void (Tcl_FreeInternalRepProc) (struct Tcl_Obj *objPtr); -typedef void (Tcl_FreeProc) (char *blockPtr); +typedef void (Tcl_FreeProc) (void *blockPtr); typedef void (Tcl_IdleProc) (void *clientData); typedef void (Tcl_InterpDeleteProc) (void *clientData, Tcl_Interp *interp); -typedef int (Tcl_MathProc) (void *clientData, Tcl_Interp *interp, - Tcl_Value *args, Tcl_Value *resultPtr); typedef void (Tcl_NamespaceDeleteProc) (void *clientData); typedef int (Tcl_ObjCmdProc) (void *clientData, Tcl_Interp *interp, int objc, struct Tcl_Obj *const *objv); @@ -762,8 +639,12 @@ typedef struct Tcl_ObjType { /* Called to convert the object's internal rep * to this type. Frees the internal rep of the * old type. Returns TCL_ERROR on failure. */ + size_t version; } Tcl_ObjType; -#define TCL_OBJTYPE_V0 /* just empty */ +#define TCL_OBJTYPE_V0 0 /* Pre-Tcl 9. Set to 0 so compiler will auto-init + * when existing code that does not init this + * field is compiled with Tcl9 headers */ +#define TCL_OBJTYPE_CURRENT TCL_OBJTYPE_V0 /* * The following structure stores an internal representation (internalrep) for @@ -801,7 +682,7 @@ typedef struct Tcl_Obj { * must be followed by a null byte (i.e., at * offset length) but may also contain * embedded null characters. The array's - * storage is allocated by ckalloc. NULL means + * storage is allocated by Tcl_Alloc. NULL means * the string rep is invalid and must be * regenerated from the internal rep. Clients * should use Tcl_GetStringFromObj or @@ -819,25 +700,6 @@ typedef struct Tcl_Obj { /* *---------------------------------------------------------------------------- - * The following structure contains the state needed by Tcl_SaveResult. No-one - * outside of Tcl should access any of these fields. This structure is - * typically allocated on the stack. - */ - -#ifndef TCL_NO_DEPRECATED -typedef struct Tcl_SavedResult { - char *result; - Tcl_FreeProc *freeProc; - Tcl_Obj *objResultPtr; - char *appendResult; - int appendAvl; - int appendUsed; - char resultSpace[200+1]; -} Tcl_SavedResult; -#endif - -/* - *---------------------------------------------------------------------------- * The following definitions support Tcl's namespace facility. Note: the first * five fields must match exactly the fields in a Namespace structure (see * tclInt.h). @@ -916,7 +778,7 @@ typedef struct Tcl_CallFrame { * then calls the other function. */ -typedef struct Tcl_CmdInfo { +typedef struct { int isNativeObjectProc; /* 1 if objProc was registered by a call to * Tcl_CreateObjCommand; 2 if objProc was registered by * a call to Tcl_CreateObjCommand2; 0 otherwise. @@ -935,8 +797,8 @@ typedef struct Tcl_CmdInfo { * change a command's namespace; use * TclRenameCommand or Tcl_Eval (of 'rename') * to do that. */ - Tcl_ObjCmdProc2 *objProc2; /* Not used in Tcl 8.7. */ - void *objClientData2; /* Not used in Tcl 8.7. */ + Tcl_ObjCmdProc2 *objProc2; /* Command's object2-based function. */ + void *objClientData2; /* ClientData for object2 proc. */ } Tcl_CmdInfo; /* @@ -961,9 +823,6 @@ typedef struct Tcl_DString { #define Tcl_DStringLength(dsPtr) ((dsPtr)->length) #define Tcl_DStringValue(dsPtr) ((dsPtr)->string) -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 -# define Tcl_DStringTrunc Tcl_DStringSetLength -#endif /* !TCL_NO_DEPRECATED */ /* * Definitions for the maximum number of digits of precision that may be @@ -1024,7 +883,7 @@ typedef struct Tcl_DString { /* * Flags that may be passed to Tcl_UniCharToUtf. - * TCL_COMBINE Combine surrogates (default in Tcl 8.x) + * TCL_COMBINE Combine surrogates */ #if TCL_MAJOR_VERSION > 8 @@ -1085,10 +944,6 @@ typedef struct Tcl_DString { #define TCL_TRACE_UNSETS 0x40 #define TCL_TRACE_DESTROYED 0x80 -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 -#define TCL_INTERP_DESTROYED 0x100 -#endif - #define TCL_LEAVE_ERR_MSG 0x200 #define TCL_TRACE_ARRAY 0x800 #ifndef TCL_REMOVE_OBSOLETE_TRACES @@ -1117,17 +972,6 @@ typedef struct Tcl_DString { #define TCL_ALLOW_INLINE_COMPILATION 0x20000 /* - * The TCL_PARSE_PART1 flag is deprecated and has no effect. The part1 is now - * always parsed whenever the part2 is NULL. (This is to avoid a common error - * when converting code to use the new object based APIs and forgetting to - * give the flag) - */ - -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 -# define TCL_PARSE_PART1 0x400 -#endif /* !TCL_NO_DEPRECATED */ - -/* * Types for linked variables: */ @@ -1186,9 +1030,7 @@ struct Tcl_HashEntry { Tcl_HashEntry *nextPtr; /* Pointer to next entry in this hash bucket, * or NULL for end of chain. */ Tcl_HashTable *tablePtr; /* Pointer to table containing entry. */ - void *hash; /* Hash value, stored as pointer to ensure - * that the offsets of the fields in this - * structure are not changed. */ + size_t hash; /* Hash value. */ void *clientData; /* Application stores something here with * Tcl_SetHashValue. */ union { /* Key has one of these forms: */ @@ -1283,10 +1125,15 @@ struct Tcl_HashTable { * table. */ Tcl_Size rebuildSize; /* Enlarge table when numEntries gets to be * this large. */ +#if TCL_MAJOR_VERSION > 8 + size_t mask; /* Mask value used in hashing function. */ +#endif int downShift; /* Shift count used in hashing function. * Designed to use high-order bits of * randomized keys. */ - int mask; /* Mask value used in hashing function. */ +#if TCL_MAJOR_VERSION < 9 + int mask; /* Mask value used in hashing function. */ +#endif int keyType; /* Type of keys used in this table. It's * either TCL_CUSTOM_KEYS, TCL_STRING_KEYS, * TCL_ONE_WORD_KEYS, or an integer giving the @@ -1408,8 +1255,8 @@ typedef struct Tcl_Time { long usec; /* Microseconds. */ } Tcl_Time; -typedef void (Tcl_SetTimerProc) (CONST86 Tcl_Time *timePtr); -typedef int (Tcl_WaitForEventProc) (CONST86 Tcl_Time *timePtr); +typedef void (Tcl_SetTimerProc) (const Tcl_Time *timePtr); +typedef int (Tcl_WaitForEventProc) (const Tcl_Time *timePtr); /* * TIP #233 (Virtualized Time) @@ -1452,18 +1299,16 @@ typedef void (Tcl_ScaleTimeProc) (Tcl_Time *timebuf, void *clientData); * interface. */ -#define TCL_CLOSE2PROC ((Tcl_DriverCloseProc *) 1) +#if TCL_MAJOR_VERSION > 8 +# define TCL_CLOSE2PROC NULL +#else +# define TCL_CLOSE2PROC ((void *) 1) +#endif /* * Channel version tag. This was introduced in 8.3.2/8.4. */ -#ifndef TCL_NO_DEPRECATED -#define TCL_CHANNEL_VERSION_1 ((Tcl_ChannelTypeVersion) 0x1) -#define TCL_CHANNEL_VERSION_2 ((Tcl_ChannelTypeVersion) 0x2) -#define TCL_CHANNEL_VERSION_3 ((Tcl_ChannelTypeVersion) 0x3) -#define TCL_CHANNEL_VERSION_4 ((Tcl_ChannelTypeVersion) 0x4) -#endif #define TCL_CHANNEL_VERSION_5 ((Tcl_ChannelTypeVersion) 0x5) /* @@ -1478,16 +1323,14 @@ typedef void (Tcl_ScaleTimeProc) (Tcl_Time *timebuf, void *clientData); */ typedef int (Tcl_DriverBlockModeProc) (void *instanceData, int mode); -typedef int (Tcl_DriverCloseProc) (void *instanceData, - Tcl_Interp *interp); +typedef void Tcl_DriverCloseProc; typedef int (Tcl_DriverClose2Proc) (void *instanceData, Tcl_Interp *interp, int flags); typedef int (Tcl_DriverInputProc) (void *instanceData, char *buf, int toRead, int *errorCodePtr); typedef int (Tcl_DriverOutputProc) (void *instanceData, const char *buf, int toWrite, int *errorCodePtr); -typedef int (Tcl_DriverSeekProc) (void *instanceData, long offset, - int mode, int *errorCodePtr); +typedef void Tcl_DriverSeekProc; typedef int (Tcl_DriverSetOptionProc) (void *instanceData, Tcl_Interp *interp, const char *optionName, const char *value); @@ -1530,17 +1373,14 @@ typedef struct Tcl_ChannelType { * type. */ Tcl_ChannelTypeVersion version; /* Version of the channel type. */ - Tcl_DriverCloseProc *closeProc; - /* Function to call to close the channel, or - * NULL or TCL_CLOSE2PROC if the close2Proc should be - * used instead. */ + void *closeProc; + /* Not used any more. */ Tcl_DriverInputProc *inputProc; /* Function to call for input on channel. */ Tcl_DriverOutputProc *outputProc; /* Function to call for output on channel. */ - Tcl_DriverSeekProc *seekProc; - /* Function to call to seek on the channel. - * May be NULL. */ + void *seekProc; + /* Not used any more. */ Tcl_DriverSetOptionProc *setOptionProc; /* Set an option on a channel. */ Tcl_DriverGetOptionProc *getOptionProc; @@ -1558,9 +1398,6 @@ typedef struct Tcl_ChannelType { Tcl_DriverBlockModeProc *blockModeProc; /* Set blocking mode for the raw channel. May * be NULL. */ - /* - * Only valid in TCL_CHANNEL_VERSION_2 channels or later. - */ Tcl_DriverFlushProc *flushProc; /* Function to call to flush a channel. May be * NULL. */ @@ -1568,26 +1405,15 @@ typedef struct Tcl_ChannelType { /* Function to call to handle a channel event. * This will be passed up the stacked channel * chain. */ - /* - * Only valid in TCL_CHANNEL_VERSION_3 channels or later. - */ Tcl_DriverWideSeekProc *wideSeekProc; /* Function to call to seek on the channel * which can handle 64-bit offsets. May be * NULL, and must be NULL if seekProc is * NULL. */ - /* - * Only valid in TCL_CHANNEL_VERSION_4 channels or later. - * TIP #218, Channel Thread Actions. - */ Tcl_DriverThreadActionProc *threadActionProc; /* Function to call to notify the driver of * thread specific activity for a channel. May * be NULL. */ - /* - * Only valid in TCL_CHANNEL_VERSION_5 channels or later. - * TIP #208, File Truncation. - */ Tcl_DriverTruncateProc *truncateProc; /* Function to call to truncate the underlying * file to a particular length. May be NULL if @@ -1683,7 +1509,7 @@ typedef int (Tcl_FSNormalizePathProc) (Tcl_Interp *interp, Tcl_Obj *pathPtr, int nextCheckpoint); typedef int (Tcl_FSFileAttrsGetProc) (Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef); -typedef const char *CONST86 * (Tcl_FSFileAttrStringsProc) (Tcl_Obj *pathPtr, +typedef const char *const * (Tcl_FSFileAttrStringsProc) (Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef); typedef int (Tcl_FSFileAttrsSetProc) (Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj *objPtr); @@ -1695,7 +1521,7 @@ typedef int (Tcl_FSPathInFilesystemProc) (Tcl_Obj *pathPtr, void **clientDataPtr); typedef Tcl_Obj * (Tcl_FSFilesystemPathTypeProc) (Tcl_Obj *pathPtr); typedef Tcl_Obj * (Tcl_FSFilesystemSeparatorProc) (Tcl_Obj *pathPtr); -typedef void (Tcl_FSFreeInternalRepProc) (void *clientData); +#define Tcl_FSFreeInternalRepProc Tcl_FreeProc typedef void *(Tcl_FSDupInternalRepProc) (void *clientData); typedef Tcl_Obj * (Tcl_FSInternalToNormalizedProc) (void *clientData); typedef void *(Tcl_FSCreateInternalRepProc) (Tcl_Obj *pathPtr); @@ -1957,7 +1783,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 preceded by one + * token is always preceeded 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 @@ -2027,6 +1853,12 @@ typedef struct Tcl_Parse { * *tokenPtr. */ int errorType; /* One of the parsing error types defined * above. */ +#if TCL_MAJOR_VERSION > 8 + int incomplete; /* This field is set to 1 by Tcl_ParseCommand + * if the command appears to be incomplete. + * This information is used by + * Tcl_CommandComplete. */ +#endif /* * The fields below are intended only for the private use of the parser. @@ -2045,10 +1877,9 @@ typedef struct Tcl_Parse { * beginning of region where the error * occurred (e.g. the open brace if the close * brace is missing). */ - int incomplete; /* This field is set to 1 by Tcl_ParseCommand - * if the command appears to be incomplete. - * This information is used by - * Tcl_CommandComplete. */ +#if TCL_MAJOR_VERSION < 9 + int incomplete; +#endif Tcl_Token staticTokens[NUM_STATIC_TOKENS]; /* Initial space for tokens for command. This * space should be large enough to accommodate @@ -2073,7 +1904,7 @@ typedef struct Tcl_EncodingType { Tcl_EncodingConvertProc *fromUtfProc; /* Function to convert from UTF-8 into * external encoding. */ - Tcl_EncodingFreeProc *freeProc; + Tcl_FreeProc *freeProc; /* If non-NULL, function to call when this * encoding is deleted. */ void *clientData; /* Arbitrary value associated with encoding @@ -2105,14 +1936,9 @@ typedef struct Tcl_EncodingType { * reset to an initial state. If the source * buffer contains the entire input stream to be * converted, this flag should be set. - * TCL_ENCODING_STOPONERROR - If set, the converter returns immediately upon - * encountering an invalid byte sequence or a - * source character that has no mapping in the - * target encoding. If clear, the converter - * substitutes the problematic character(s) with - * one or more "close" characters in the - * destination buffer and then continues to - * convert the source. Only for Tcl 8.x. + * TCL_ENCODING_STRICT - Be more strict in accepting what + * is considered a 'invalid byte sequence'. + * TCL_ENCODING_STOPONERROR - Not used any more. * TCL_ENCODING_NO_TERMINATE - If set, Tcl_ExternalToUtf does not append a * terminating NUL byte. Since it does not need * an extra byte for a terminating NUL, it fills @@ -2143,12 +1969,17 @@ typedef struct Tcl_EncodingType { #define TCL_ENCODING_START 0x01 #define TCL_ENCODING_END 0x02 -#define TCL_ENCODING_STOPONERROR 0x04 +#if TCL_MAJOR_VERSION > 8 +# define TCL_ENCODING_STRICT 0x04 +# define TCL_ENCODING_STOPONERROR 0x0 /* Not used any more */ +#else +# define TCL_ENCODING_STRICT 0x44 +# define TCL_ENCODING_STOPONERROR 0x04 +#endif #define TCL_ENCODING_NO_TERMINATE 0x08 #define TCL_ENCODING_CHAR_LIMIT 0x10 #define TCL_ENCODING_MODIFIED 0x20 #define TCL_ENCODING_NOCOMPLAIN 0x40 -#define TCL_ENCODING_STRICT 0x44 /* * The following definitions are the error codes returned by the conversion @@ -2170,12 +2001,12 @@ typedef struct Tcl_EncodingType { * character sequence. This may occur if the * input stream has been damaged or if the input * encoding method was misidentified. This error - * is reported only if TCL_ENCODING_STOPONERROR + * is reported unless if TCL_ENCODING_NOCOMPLAIN * was specified. * TCL_CONVERT_UNKNOWN - The source string contained a character that * could not be represented in the target - * encoding. This error is reported only if - * TCL_ENCODING_STOPONERROR was specified. + * encoding. This error is reported unless if + * TCL_ENCODING_NOCOMPLAIN was specified. */ #define TCL_CONVERT_MULTIBYTE (-1) @@ -2186,18 +2017,18 @@ typedef struct Tcl_EncodingType { /* * The maximum number of bytes that are necessary to represent a single * Unicode character in UTF-8. The valid values are 3 and 4 - * (or perhaps 1 if we want to support a non-unicode enabled core). If 3, - * then Tcl_UniChar must be 2-bytes in size (UTF-16) (the default). If > 3, - * then Tcl_UniChar must be 4-bytes in size (UCS-4). At this time UTF-16 mode - * is the default and recommended mode. + * (or perhaps 1 if we want to support a non-unicode enabled core). If > 3, + * then Tcl_UniChar must be 4-bytes in size (UCS-4) (the default). If == 3, + * then Tcl_UniChar must be 2-bytes in size (UTF-16). Since Tcl 9.0, UCS-4 + * mode is the default and recommended mode. */ #ifndef TCL_UTF_MAX -# ifdef BUILD_tcl -# 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 /* @@ -2401,7 +2232,11 @@ typedef int (Tcl_NRPostProc) (void *data[], Tcl_Interp *interp, * stubs tables. */ -#define TCL_STUB_MAGIC ((int) 0xFCA3BACF) +#if TCL_MAJOR_VERSION > 8 +# define TCL_STUB_MAGIC ((int) 0xFCA3BACB + (int) sizeof(void *)) +#else +# define TCL_STUB_MAGIC ((int) 0xFCA3BACF) +#endif /* * The following function is required to be defined in all stubs aware @@ -2414,21 +2249,43 @@ const char * Tcl_InitStubs(Tcl_Interp *interp, const char *version, int exact, int magic); const char * TclTomMathInitializeStubs(Tcl_Interp *interp, const char *version, int epoch, int revision); +const char * TclInitStubTable(const char *version); +void * TclStubCall(void *arg); #if defined(_WIN32) - TCL_NORETURN void Tcl_ConsolePanic(const char *format, ...); + TCL_NORETURN1 void Tcl_ConsolePanic(const char *format, ...); #else -# define Tcl_ConsolePanic ((Tcl_PanicProc *)NULL) +# define Tcl_ConsolePanic NULL #endif #ifdef USE_TCL_STUBS +#if TCL_MAJOR_VERSION < 9 +# define Tcl_InitStubs(interp, version, exact) \ + (Tcl_InitStubs)(interp, version, \ + (exact)|(TCL_MAJOR_VERSION<<8)|(0xFF<<16), \ + TCL_STUB_MAGIC) +#elif TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE # define Tcl_InitStubs(interp, version, exact) \ (Tcl_InitStubs)(interp, version, \ (exact)|(TCL_MAJOR_VERSION<<8)|(TCL_MINOR_VERSION<<16), \ TCL_STUB_MAGIC) #else # define Tcl_InitStubs(interp, version, exact) \ + (Tcl_InitStubs)(interp, TCL_PATCH_LEVEL, \ + 1|(TCL_MAJOR_VERSION<<8)|(TCL_MINOR_VERSION<<16), \ + TCL_STUB_MAGIC) +#endif +#else +#if TCL_MAJOR_VERSION < 9 +# error "Please define -DUSE_TCL_STUBS" +#elif TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE +# define Tcl_InitStubs(interp, version, exact) \ Tcl_PkgInitStubsCheck(interp, version, \ (exact)|(TCL_MAJOR_VERSION<<8)|(TCL_MINOR_VERSION<<16)) +#else +# define Tcl_InitStubs(interp, version, exact) \ + Tcl_PkgInitStubsCheck(interp, TCL_PATCH_LEVEL, \ + 1|(TCL_MAJOR_VERSION<<8)|(TCL_MINOR_VERSION<<16)) +#endif #endif /* @@ -2437,22 +2294,65 @@ const char * TclTomMathInitializeStubs(Tcl_Interp *interp, */ #define Tcl_Main(argc, argv, proc) Tcl_MainEx(argc, argv, proc, \ - ((Tcl_SetPanicProc(Tcl_ConsolePanic), Tcl_CreateInterp)())) -EXTERN void Tcl_MainEx(Tcl_Size argc, char **argv, + ((Tcl_SetPanicProc(Tcl_ConsolePanic), Tcl_CreateInterp()))) +EXTERN TCL_NORETURN void Tcl_MainEx(Tcl_Size argc, char **argv, Tcl_AppInitProc *appInitProc, Tcl_Interp *interp); EXTERN const char * Tcl_PkgInitStubsCheck(Tcl_Interp *interp, const char *version, int exact); EXTERN const char * Tcl_InitSubsystems(void); EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr); +EXTERN const char * Tcl_FindExecutable(const char *argv0); EXTERN const char * Tcl_SetPreInitScript(const char *string); +EXTERN const char * Tcl_SetPanicProc( + TCL_NORETURN1 Tcl_PanicProc *panicProc); +EXTERN void Tcl_StaticLibrary(Tcl_Interp *interp, + const char *prefix, + Tcl_LibraryInitProc *initProc, + Tcl_LibraryInitProc *safeInitProc); #ifndef TCL_NO_DEPRECATED # define Tcl_StaticPackage Tcl_StaticLibrary #endif +EXTERN Tcl_ExitProc *Tcl_SetExitProc(TCL_NORETURN1 Tcl_ExitProc *proc); #ifdef _WIN32 EXTERN const char *TclZipfs_AppHook(int *argc, wchar_t ***argv); #else EXTERN const char *TclZipfs_AppHook(int *argc, char ***argv); #endif +#if defined(_WIN32) && defined(UNICODE) +#ifndef USE_TCL_STUBS +# 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, + Tcl_AppInitProc *appInitProc, Tcl_Interp *interp); +#endif +#if defined(USE_TCL_STUBS) && (TCL_MAJOR_VERSION > 8) +#define Tcl_SetPanicProc(panicProc) \ + TclInitStubTable(((const char *(*)(Tcl_PanicProc *))TclStubCall((void *)panicProc))(panicProc)) +#define Tcl_InitSubsystems() \ + TclInitStubTable(((const char *(*)(void))TclStubCall((void *)1))()) +#define Tcl_FindExecutable(argv0) \ + TclInitStubTable(((const char *(*)(const char *))TclStubCall((void *)2))(argv0)) +#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 *)) \ + TclStubCall((void *)4))(argc, argv, appInitProc, interp) +#if !defined(_WIN32) || !defined(UNICODE) +#define Tcl_MainEx(argc, argv, appInitProc, interp) \ + (void)((const char *(*)(size_t, const void *, Tcl_AppInitProc *, Tcl_Interp *)) \ + TclStubCall((void *)5))(argc, argv, appInitProc, interp) +#endif +#define Tcl_StaticLibrary(interp, pkgName, initProc, safeInitProc) \ + (void)((const char *(*)(Tcl_Interp *, const char *, Tcl_LibraryInitProc *, Tcl_LibraryInitProc *)) \ + TclStubCall((void *)6))(interp, pkgName, initProc, safeInitProc) +#define Tcl_SetExitProc(proc) \ + ((Tcl_ExitProc *(*)(Tcl_ExitProc *))TclStubCall((void *)7))(proc) +#define Tcl_GetMemoryInfo(dsPtr) \ + (void)((const char *(*)(Tcl_DString *))TclStubCall((void *)8))(dsPtr) +#define Tcl_SetPreInitScript(string) \ + ((const char *(*)(const char *))TclStubCall((void *)9))(string) +#endif /* *---------------------------------------------------------------------------- @@ -2477,25 +2377,26 @@ EXTERN const char *TclZipfs_AppHook(int *argc, char ***argv); /* *---------------------------------------------------------------------------- - * The following declarations either map ckalloc and ckfree to malloc and - * free, or they map them to functions with all sorts of debugging hooks - * defined in tclCkalloc.c. - */ - -#ifdef TCL_MEM_DEBUG - -# define ckalloc(x) \ - ((void *) Tcl_DbCkalloc((unsigned)(x), __FILE__, __LINE__)) -# define ckfree(x) \ - Tcl_DbCkfree((char *)(x), __FILE__, __LINE__) -# define ckrealloc(x,y) \ - ((void *) Tcl_DbCkrealloc((char *)(x), (unsigned)(y), __FILE__, __LINE__)) -# define attemptckalloc(x) \ - ((void *) Tcl_AttemptDbCkalloc((unsigned)(x), __FILE__, __LINE__)) -# define attemptckrealloc(x,y) \ - ((void *) Tcl_AttemptDbCkrealloc((char *)(x), (unsigned)(y), __FILE__, __LINE__)) + * The following declarations map ckalloc and ckfree to Tcl_Alloc and + * Tcl_Free for use in Tcl-8.x-compatible extensions. + */ + +#ifndef BUILD_tcl +# define ckalloc Tcl_Alloc +# define attemptckalloc Tcl_AttemptAlloc +# ifdef _MSC_VER + /* Silence invalid C4090 warnings */ +# define ckfree(a) Tcl_Free((char *)(a)) +# define ckrealloc(a,b) Tcl_Realloc((char *)(a),(b)) +# define attemptckrealloc(a,b) Tcl_AttemptRealloc((char *)(a),(b)) +# else +# define ckfree Tcl_Free +# define ckrealloc Tcl_Realloc +# define attemptckrealloc Tcl_AttemptRealloc +# endif +#endif -#else /* !TCL_MEM_DEBUG */ +#ifndef TCL_MEM_DEBUG /* * If we are not using the debugging allocator, we should call the Tcl_Alloc, @@ -2503,16 +2404,6 @@ EXTERN const char *TclZipfs_AppHook(int *argc, char ***argv); * memory allocator both inside and outside of the Tcl library. */ -# define ckalloc(x) \ - ((void *) Tcl_Alloc((unsigned)(x))) -# define ckfree(x) \ - Tcl_Free((char *)(x)) -# define ckrealloc(x,y) \ - ((void *) Tcl_Realloc((char *)(x), (unsigned)(y))) -# define attemptckalloc(x) \ - ((void *) Tcl_AttemptAlloc((unsigned)(x))) -# define attemptckrealloc(x,y) \ - ((void *) Tcl_AttemptRealloc((char *)(x), (unsigned)(y))) # undef Tcl_InitMemory # define Tcl_InitMemory(x) # undef Tcl_DumpActiveMemory @@ -2611,38 +2502,6 @@ EXTERN const char *TclZipfs_AppHook(int *argc, char ***argv); #define Tcl_CreateHashEntry(tablePtr, key, newPtr) \ (*((tablePtr)->createProc))(tablePtr, (const char *)(key), newPtr) -/* - *---------------------------------------------------------------------------- - * Deprecated Tcl functions: - */ - -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 -/* - * These function have been renamed. The old names are deprecated, but we - * define these macros for backwards compatibility. - */ - -# define Tcl_Ckalloc Tcl_Alloc -# define Tcl_Ckfree Tcl_Free -# define Tcl_Ckrealloc Tcl_Realloc -# define Tcl_Return Tcl_SetResult -# define Tcl_TildeSubst Tcl_TranslateFileName -#if !defined(__APPLE__) /* On OSX, there is a conflict with "mach/mach.h" */ -# define panic Tcl_Panic -#endif -# define panicVA Tcl_PanicVA - -/* - *---------------------------------------------------------------------------- - * Convenience declaration of Tcl_AppInit for backwards compatibility. This - * function is not *implemented* by the tcl library, so the storage class is - * neither DLLEXPORT nor DLLIMPORT. - */ - -extern Tcl_AppInitProc Tcl_AppInit; - -#endif /* !TCL_NO_DEPRECATED */ - #endif /* RC_INVOKED */ /* diff --git a/generic/tclAlloc.c b/generic/tclAlloc.c index 03655b9..8b1bd74 100644 --- a/generic/tclAlloc.c +++ b/generic/tclAlloc.c @@ -251,11 +251,11 @@ TclFinalizeAllocSubsystem(void) void * TclpAlloc( - unsigned int numBytes) /* Number of bytes to allocate. */ + size_t numBytes) /* Number of bytes to allocate. */ { union overhead *overPtr; size_t bucket; - unsigned amount; + size_t amount; struct block *bigBlockPtr = NULL; if (!allocInit) { @@ -274,8 +274,8 @@ TclpAlloc( if (numBytes >= MAXMALLOC - OVERHEAD) { if (numBytes <= UINT_MAX - OVERHEAD -sizeof(struct block)) { - bigBlockPtr = (struct block *) TclpSysAlloc( - sizeof(struct block) + OVERHEAD + numBytes, 0); + bigBlockPtr = TclpSysAlloc( + sizeof(struct block) + OVERHEAD + numBytes); } if (bigBlockPtr == NULL) { Tcl_MutexUnlock(allocMutexPtr); @@ -304,7 +304,7 @@ TclpAlloc( #endif Tcl_MutexUnlock(allocMutexPtr); - return (char *)(overPtr+1); + return (void *)(overPtr+1); } /* @@ -405,8 +405,7 @@ MoreCore( numBlocks = amount / size; ASSERT(numBlocks*size == amount); - blockPtr = (struct block *) TclpSysAlloc( - (sizeof(struct block) + amount), 1); + blockPtr = TclpSysAlloc(sizeof(struct block) + amount); /* no more room! */ if (blockPtr == NULL) { return; @@ -512,7 +511,7 @@ TclpFree( void * TclpRealloc( void *oldPtr, /* Pointer to alloced block. */ - unsigned int numBytes) /* New size of memory. */ + size_t numBytes) /* New size of memory. */ { int i; union overhead *overPtr; @@ -692,9 +691,10 @@ mstats( *---------------------------------------------------------------------- */ +#undef TclpAlloc void * TclpAlloc( - unsigned int numBytes) /* Number of bytes to allocate. */ + size_t numBytes) /* Number of bytes to allocate. */ { return malloc(numBytes); } @@ -715,6 +715,7 @@ TclpAlloc( *---------------------------------------------------------------------- */ +#undef TclpFree void TclpFree( void *oldPtr) /* Pointer to memory to free. */ @@ -742,7 +743,7 @@ TclpFree( void * TclpRealloc( void *oldPtr, /* Pointer to alloced block. */ - unsigned int numBytes) /* New size of memory. */ + size_t numBytes) /* New size of memory. */ { return realloc(oldPtr, numBytes); } diff --git a/generic/tclArithSeries.c b/generic/tclArithSeries.c index b278644..cca0c58 100755 --- a/generic/tclArithSeries.c +++ b/generic/tclArithSeries.c @@ -75,7 +75,8 @@ const Tcl_ObjType tclArithSeriesType = { FreeArithSeriesInternalRep, /* freeIntRepProc */ DupArithSeriesInternalRep, /* dupIntRepProc */ UpdateStringOfArithSeries, /* updateStringProc */ - SetArithSeriesFromAny /* setFromAnyProc */ + SetArithSeriesFromAny, /* setFromAnyProc */ + TCL_OBJTYPE_V0 }; /* @@ -144,7 +145,7 @@ TclNewArithSeriesInt(Tcl_WideInt start, Tcl_WideInt end, Tcl_WideInt step, Tcl_W return arithSeriesPtr; } - arithSeriesRepPtr = (ArithSeries*) ckalloc(sizeof (ArithSeries)); + arithSeriesRepPtr = (ArithSeries*) Tcl_Alloc(sizeof (ArithSeries)); arithSeriesRepPtr->isDouble = 0; arithSeriesRepPtr->start = start; arithSeriesRepPtr->end = end; @@ -191,7 +192,7 @@ TclNewArithSeriesDbl(double start, double end, double step, Tcl_WideInt len) return arithSeriesPtr; } - arithSeriesRepPtr = (ArithSeriesDbl*) ckalloc(sizeof (ArithSeriesDbl)); + arithSeriesRepPtr = (ArithSeriesDbl*) Tcl_Alloc(sizeof (ArithSeriesDbl)); arithSeriesRepPtr->isDouble = 1; arithSeriesRepPtr->start = start; arithSeriesRepPtr->end = end; @@ -282,7 +283,8 @@ TclNewArithSeriesObj( Tcl_Obj *lenObj) /* Number of elements */ { double dstart, dend, dstep; - Tcl_WideInt start, end, step, len; + Tcl_WideInt start, end, step; + Tcl_WideInt len; if (startObj) { assignNumber(useDoubles, &start, &dstart, startObj); @@ -429,7 +431,7 @@ TclArithSeriesObjIndex(Tcl_Obj *arithSeriesPtr, Tcl_WideInt index, Tcl_Obj **ele Tcl_Panic("TclArithSeriesObjIndex called with a not ArithSeries Obj."); } arithSeriesRepPtr = ArithSeriesRepPtr(arithSeriesPtr); - if (index < 0 || index >= arithSeriesRepPtr->len) { + if (index < 0 || (Tcl_Size)index >= arithSeriesRepPtr->len) { return TCL_ERROR; } /* List[i] = Start + (Step * index) */ @@ -489,16 +491,16 @@ FreeArithSeriesInternalRep(Tcl_Obj *arithSeriesPtr) ArithSeries *arithSeriesRepPtr = (ArithSeries *) arithSeriesPtr->internalRep.twoPtrValue.ptr1; if (arithSeriesRepPtr->elements) { - Tcl_WideInt i; + Tcl_Size i; Tcl_Obj**elmts = arithSeriesRepPtr->elements; for(i=0; i<arithSeriesRepPtr->len; i++) { if (elmts[i]) { Tcl_DecrRefCount(elmts[i]); } } - ckfree((char *) arithSeriesRepPtr->elements); + Tcl_Free((char *) arithSeriesRepPtr->elements); } - ckfree((char *) arithSeriesRepPtr); + Tcl_Free((char *) arithSeriesRepPtr); arithSeriesPtr->internalRep.twoPtrValue.ptr1 = NULL; } @@ -531,7 +533,7 @@ DupArithSeriesInternalRep( /* * Allocate a new ArithSeries structure. */ - copyArithSeriesRepPtr = (ArithSeries*) ckalloc(sizeof(ArithSeries)); + copyArithSeriesRepPtr = (ArithSeries*) Tcl_Alloc(sizeof(ArithSeries)); *copyArithSeriesRepPtr = *srcArithSeriesRepPtr; copyArithSeriesRepPtr->elements = NULL; copyPtr->internalRep.twoPtrValue.ptr1 = copyArithSeriesRepPtr; @@ -574,16 +576,16 @@ UpdateStringOfArithSeries(Tcl_Obj *arithSeriesPtr) (ArithSeries*) arithSeriesPtr->internalRep.twoPtrValue.ptr1; char *elem, *p; Tcl_Obj *elemObj; - Tcl_WideInt i; + Tcl_Size i; Tcl_WideInt length = 0; - int slen; + size_t slen; /* * Pass 1: estimate space. */ for (i = 0; i < arithSeriesRepPtr->len; i++) { TclArithSeriesObjIndex(arithSeriesPtr, i, &elemObj); - elem = TclGetStringFromObj(elemObj, &slen); + elem = Tcl_GetStringFromObj(elemObj, &slen); Tcl_DecrRefCount(elemObj); slen += 1; /* + 1 is for the space or the nul-term */ length += slen; @@ -596,7 +598,7 @@ UpdateStringOfArithSeries(Tcl_Obj *arithSeriesPtr) p = Tcl_InitStringRep(arithSeriesPtr, NULL, length); for (i = 0; i < arithSeriesRepPtr->len; i++) { TclArithSeriesObjIndex(arithSeriesPtr, i, &elemObj); - elem = TclGetStringFromObj(elemObj, &slen); + elem = Tcl_GetStringFromObj(elemObj, &slen); strcpy(p, elem); p[slen] = ' '; p += slen+1; @@ -706,15 +708,15 @@ Tcl_Obj * TclArithSeriesObjRange( Tcl_Interp *interp, /* For error message(s) */ Tcl_Obj *arithSeriesPtr, /* List object to take a range from. */ - int fromIdx, /* Index of first element to include. */ - int toIdx) /* Index of last element to include. */ + Tcl_Size fromIdx, /* Index of first element to include. */ + Tcl_Size toIdx) /* Index of last element to include. */ { ArithSeries *arithSeriesRepPtr; Tcl_Obj *startObj, *endObj, *stepObj; ArithSeriesGetInternalRep(arithSeriesPtr, arithSeriesRepPtr); - if (fromIdx < 0) { + if (fromIdx == TCL_INDEX_NONE) { fromIdx = 0; } if (fromIdx > toIdx) { @@ -725,9 +727,10 @@ TclArithSeriesObjRange( if (TclArithSeriesObjIndex(arithSeriesPtr, fromIdx, &startObj) != TCL_OK) { if (interp) { - Tcl_SetObjResult(interp, - Tcl_ObjPrintf("index %d is out of bounds 0 to %" - "d", fromIdx, (arithSeriesRepPtr->len-1))); + Tcl_SetObjResult( + interp, + Tcl_ObjPrintf("index %" TCL_Z_MODIFIER "u is out of bounds 0 to %" + TCL_Z_MODIFIER "u", fromIdx, (arithSeriesRepPtr->len-1))); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); } return NULL; @@ -735,9 +738,10 @@ TclArithSeriesObjRange( Tcl_IncrRefCount(startObj); if (TclArithSeriesObjIndex(arithSeriesPtr, toIdx, &endObj) != TCL_OK) { if (interp) { - Tcl_SetObjResult(interp, - Tcl_ObjPrintf("index %d is out of bounds 0 to %" - "d", fromIdx, (arithSeriesRepPtr->len-1))); + Tcl_SetObjResult( + interp, + Tcl_ObjPrintf("index %" TCL_Z_MODIFIER "u is out of bounds 0 to %" + TCL_Z_MODIFIER "d", fromIdx, (arithSeriesRepPtr->len-1))); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); } return NULL; @@ -854,7 +858,7 @@ TclArithSeriesGetElements( objv = arithSeriesRepPtr->elements; } else { /* Construct the elements array */ - objv = (Tcl_Obj **)ckalloc(sizeof(Tcl_Obj*) * objc); + objv = (Tcl_Obj **)Tcl_Alloc(sizeof(Tcl_Obj*) * objc); if (objv == NULL) { if (interp) { Tcl_SetObjResult( @@ -985,7 +989,7 @@ TclArithSeriesObjReverse( for (i=0; i<len; i++) { Tcl_DecrRefCount(arithSeriesRepPtr->elements[i]); } - ckfree((char*)arithSeriesRepPtr->elements); + Tcl_Free((char*)arithSeriesRepPtr->elements); } arithSeriesRepPtr->elements = NULL; diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c index dbf37bb8..9448162 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. */ - int cmdLine; /* Current line number within the assembly + size_t cmdLine; /* Current line number within the assembly * code */ int* clNext; /* Invisible continuation line for * [info frame] */ @@ -277,7 +277,7 @@ static void DeleteMirrorJumpTable(JumptableInfo* jtPtr); static void FillInJumpOffsets(AssemblyEnv*); static int CreateMirrorJumpTable(AssemblyEnv* assemEnvPtr, Tcl_Obj* jumpTable); -static int FindLocalVar(AssemblyEnv* envPtr, +static size_t FindLocalVar(AssemblyEnv* envPtr, Tcl_Token** tokenPtrPtr); static int FinishAssembly(AssemblyEnv*); static void FreeAssemblyEnv(AssemblyEnv*); @@ -325,7 +325,8 @@ static const Tcl_ObjType assembleCodeType = { FreeAssembleCodeInternalRep, /* freeIntRepProc */ DupAssembleCodeInternalRep, /* dupIntRepProc */ NULL, /* updateStringProc */ - NULL /* setFromAnyProc */ + NULL, /* setFromAnyProc */ + TCL_OBJTYPE_V0 }; /* @@ -409,7 +410,6 @@ static const TalInstDesc TalInstructionTable[] = { {"jumpTrue", ASSEM_JUMP, INST_JUMP_TRUE1, 1, 0}, {"jumpTrue4", ASSEM_JUMP4, INST_JUMP_TRUE4, 1, 0}, {"label", ASSEM_LABEL, 0, 0, 0}, - {"land", ASSEM_1BYTE, INST_LAND, 2, 1}, {"lappend", ASSEM_LVT, (INST_LAPPEND_SCALAR1<<8 | INST_LAPPEND_SCALAR4), 1, 1}, @@ -437,7 +437,6 @@ static const TalInstDesc TalInstructionTable[] = { | INST_LOAD_ARRAY4), 1, 1}, {"loadArrayStk", ASSEM_1BYTE, INST_LOAD_ARRAY_STK, 2, 1}, {"loadStk", ASSEM_1BYTE, INST_LOAD_STK, 1, 1}, - {"lor", ASSEM_1BYTE, INST_LOR, 2, 1}, {"lsetFlat", ASSEM_LSET_FLAT,INST_LSET_FLAT, INT_MIN,1}, {"lsetList", ASSEM_1BYTE, INST_LSET_LIST, 3, 1}, {"lshift", ASSEM_1BYTE, INST_LSHIFT, 2, 1}, @@ -772,7 +771,7 @@ BBEmitInst1or4( int Tcl_AssembleObjCmd( - ClientData clientData, /* clientData */ + void *clientData, /* clientData */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -787,7 +786,7 @@ Tcl_AssembleObjCmd( int TclNRAssembleObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -858,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 */ - int sourceLen; /* Length of the source code in bytes */ + size_t sourceLen; /* Length of the source code in bytes */ /* * Get the expression ByteCode from the object. If it exists, make sure it @@ -889,7 +888,7 @@ CompileAssembleObj( * Set up the compilation environment, and assemble the code. */ - source = TclGetStringFromObj(objPtr, &sourceLen); + source = Tcl_GetStringFromObj(objPtr, &sourceLen); TclInitCompileEnv(interp, &compEnv, source, sourceLen, NULL, 0); status = TclAssembleCode(&compEnv, source, sourceLen, TCL_EVAL_DIRECT); if (status != TCL_OK) { @@ -965,9 +964,9 @@ TclCompileAssembleCmd( { Tcl_Token *tokenPtr; /* Token in the input script */ - int numCommands = envPtr->numCommands; + size_t numCommands = envPtr->numCommands; int offset = envPtr->codeNext - envPtr->codeStart; - int depth = envPtr->currStackDepth; + size_t depth = envPtr->currStackDepth; /* * Make sure that the command has a single arg that is a simple word. */ @@ -990,7 +989,7 @@ TclCompileAssembleCmd( Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (\"%.*s\" body, line %d)", - parsePtr->tokenPtr->size, parsePtr->tokenPtr->start, + (int)parsePtr->tokenPtr->size, parsePtr->tokenPtr->start, Tcl_GetErrorLine(interp))); envPtr->numCommands = numCommands; envPtr->codeNext = envPtr->codeStart + offset; @@ -1077,7 +1076,7 @@ TclAssembleCode( */ if (parsePtr->numWords > 0) { - int instLen = parsePtr->commandSize; + size_t instLen = parsePtr->commandSize; /* Length in bytes of the current command */ if (parsePtr->term == parsePtr->commandStart + instLen - 1) { @@ -1091,7 +1090,7 @@ TclAssembleCode( #ifdef TCL_COMPILE_DEBUG if ((tclTraceCompile >= 2) && (envPtr->procPtr == NULL)) { printf(" %4" TCL_Z_MODIFIER "d Assembling: ", - (size_t)(envPtr->codeNext - envPtr->codeStart)); + envPtr->codeNext - envPtr->codeStart); TclPrintSource(stdout, parsePtr->commandStart, TclMin(instLen, 55)); printf("\n"); @@ -1217,14 +1216,14 @@ FreeAssemblyEnv( Tcl_DecrRefCount(thisBB->jumpTarget); } if (thisBB->foreignExceptions != NULL) { - ckfree(thisBB->foreignExceptions); + Tcl_Free(thisBB->foreignExceptions); } nextBB = thisBB->successor1; if (thisBB->jtPtr != NULL) { DeleteMirrorJumpTable(thisBB->jtPtr); thisBB->jtPtr = NULL; } - ckfree(thisBB); + Tcl_Free(thisBB); } /* @@ -1270,10 +1269,10 @@ AssembleOneLine( Tcl_Obj* operand1Obj = NULL; /* First operand to the instruction */ const char* operand1; /* String rep of the operand */ - int operand1Len; /* String length of the operand */ + size_t operand1Len; /* String length of the operand */ int opnd; /* Integer representation of an operand */ int litIndex; /* Literal pool index of a constant */ - int localVar; /* LVT index of a local variable */ + size_t 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 */ @@ -1313,7 +1312,7 @@ AssembleOneLine( if (GetNextOperand(assemEnvPtr, &tokenPtr, &operand1Obj) != TCL_OK) { goto cleanup; } - operand1 = TclGetStringFromObj(operand1Obj, &operand1Len); + operand1 = Tcl_GetStringFromObj(operand1Obj, &operand1Len); litIndex = TclRegisterLiteral(envPtr, operand1, operand1Len, 0); BBEmitInst1or4(assemEnvPtr, tblIdx, litIndex, 0); break; @@ -1368,7 +1367,7 @@ AssembleOneLine( goto cleanup; } localVar = FindLocalVar(assemEnvPtr, &tokenPtr); - if (localVar < 0) { + if (localVar == TCL_INDEX_NONE) { goto cleanup; } BBEmitInstInt1(assemEnvPtr, tblIdx, opnd, 0); @@ -1428,7 +1427,7 @@ AssembleOneLine( goto cleanup; } localVar = FindLocalVar(assemEnvPtr, &tokenPtr); - if (localVar < 0) { + if (localVar == TCL_INDEX_NONE) { goto cleanup; } BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd+1); @@ -1445,7 +1444,7 @@ AssembleOneLine( goto cleanup; } localVar = FindLocalVar(assemEnvPtr, &tokenPtr); - if (localVar < 0) { + if (localVar == TCL_INDEX_NONE) { goto cleanup; } BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd); @@ -1480,7 +1479,7 @@ AssembleOneLine( &operand1Obj) != TCL_OK) { goto cleanup; } else { - operand1 = TclGetStringFromObj(operand1Obj, &operand1Len); + operand1 = Tcl_GetStringFromObj(operand1Obj, &operand1Len); litIndex = TclRegisterLiteral(envPtr, operand1, operand1Len, 0); /* @@ -1543,7 +1542,7 @@ AssembleOneLine( goto cleanup; } - jtPtr = (JumptableInfo*)ckalloc(sizeof(JumptableInfo)); + jtPtr = (JumptableInfo*)Tcl_Alloc(sizeof(JumptableInfo)); Tcl_InitHashTable(&jtPtr->hashTable, TCL_STRING_KEYS); assemEnvPtr->curr_bb->jumpLine = assemEnvPtr->cmdLine; @@ -1640,7 +1639,7 @@ AssembleOneLine( goto cleanup; } localVar = FindLocalVar(assemEnvPtr, &tokenPtr); - if (localVar < 0) { + if (localVar == TCL_INDEX_NONE) { goto cleanup; } BBEmitInst1or4(assemEnvPtr, tblIdx, localVar, 0); @@ -1652,7 +1651,7 @@ AssembleOneLine( goto cleanup; } localVar = FindLocalVar(assemEnvPtr, &tokenPtr); - if (localVar < 0 || CheckOneByte(interp, localVar)) { + if (localVar == TCL_INDEX_NONE || CheckOneByte(interp, localVar)) { goto cleanup; } BBEmitInstInt1(assemEnvPtr, tblIdx, localVar, 0); @@ -1664,7 +1663,7 @@ AssembleOneLine( goto cleanup; } localVar = FindLocalVar(assemEnvPtr, &tokenPtr); - if (localVar < 0 || CheckOneByte(interp, localVar) + if (localVar == TCL_INDEX_NONE || CheckOneByte(interp, localVar) || GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK || CheckSignedOneByte(interp, opnd)) { goto cleanup; @@ -1679,7 +1678,7 @@ AssembleOneLine( goto cleanup; } localVar = FindLocalVar(assemEnvPtr, &tokenPtr); - if (localVar < 0) { + if (localVar == TCL_INDEX_NONE) { goto cleanup; } BBEmitInstInt4(assemEnvPtr, tblIdx, localVar, 0); @@ -1743,7 +1742,7 @@ AssembleOneLine( goto cleanup; } localVar = FindLocalVar(assemEnvPtr, &tokenPtr); - if (localVar < 0) { + if (localVar == TCL_INDEX_NONE) { goto cleanup; } BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, 0); @@ -1813,15 +1812,15 @@ CompileEmbeddedScript( * code. */ - int savedStackDepth = envPtr->currStackDepth; - int savedMaxStackDepth = envPtr->maxStackDepth; + size_t savedStackDepth = envPtr->currStackDepth; + size_t savedMaxStackDepth = envPtr->maxStackDepth; int savedExceptArrayNext = envPtr->exceptArrayNext; envPtr->currStackDepth = 0; envPtr->maxStackDepth = 0; StartBasicBlock(assemEnvPtr, BB_FALLTHRU, NULL); - switch(instPtr->tclInstCode) { + switch (instPtr->tclInstCode) { case INST_EVAL_STK: TclCompileScript(interp, tokenPtr->start, tokenPtr->size, envPtr); break; @@ -1937,7 +1936,7 @@ MoveExceptionRangesToBasicBlock( curr_bb->foreignExceptionBase = savedExceptArrayNext; curr_bb->foreignExceptionCount = exceptionCount; curr_bb->foreignExceptions = - (ExceptionRange*)ckalloc(exceptionCount * sizeof(ExceptionRange)); + (ExceptionRange*)Tcl_Alloc(exceptionCount * sizeof(ExceptionRange)); memcpy(curr_bb->foreignExceptions, envPtr->exceptArrayPtr + savedExceptArrayNext, exceptionCount * sizeof(ExceptionRange)); @@ -1970,7 +1969,7 @@ CreateMirrorJumpTable( AssemblyEnv* assemEnvPtr, /* Assembly environment */ Tcl_Obj* jumps) /* List of alternating keywords and labels */ { - int objc; /* Number of elements in the 'jumps' list */ + size_t objc; /* Number of elements in the 'jumps' list */ Tcl_Obj** objv; /* Pointers to the elements in the list */ CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ @@ -1983,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. */ - int i; + size_t i; if (TclListObjGetElementsM(interp, jumps, &objc, &objv) != TCL_OK) { return TCL_ERROR; @@ -2002,7 +2001,7 @@ CreateMirrorJumpTable( * Allocate the jumptable. */ - jtPtr = (JumptableInfo*)ckalloc(sizeof(JumptableInfo)); + jtPtr = (JumptableInfo*)Tcl_Alloc(sizeof(JumptableInfo)); jtHashPtr = &jtPtr->hashTable; Tcl_InitHashTable(jtHashPtr, TCL_STRING_KEYS); @@ -2067,7 +2066,7 @@ DeleteMirrorJumpTable( Tcl_SetHashValue(entry, NULL); } Tcl_DeleteHashTable(jtHashPtr); - ckfree(jtPtr); + Tcl_Free(jtPtr); } /* @@ -2297,7 +2296,7 @@ GetListIndexOperand( *----------------------------------------------------------------------------- */ -static int +static size_t FindLocalVar( AssemblyEnv* assemEnvPtr, /* Assembly environment */ Tcl_Token** tokenPtrPtr) @@ -2311,27 +2310,27 @@ FindLocalVar( * source code. */ Tcl_Obj* varNameObj; /* Name of the variable */ const char* varNameStr; - int varNameLen; - int localVar; /* Index of the variable in the LVT */ + size_t varNameLen; + size_t localVar; /* Index of the variable in the LVT */ if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &varNameObj) != TCL_OK) { - return -1; + return TCL_INDEX_NONE; } - varNameStr = TclGetStringFromObj(varNameObj, &varNameLen); + varNameStr = Tcl_GetStringFromObj(varNameObj, &varNameLen); if (CheckNamespaceQualifiers(interp, varNameStr, varNameLen)) { Tcl_DecrRefCount(varNameObj); - return -1; + return TCL_INDEX_NONE; } localVar = TclFindCompiledLocal(varNameStr, varNameLen, 1, envPtr); Tcl_DecrRefCount(varNameObj); - if (localVar == -1) { + if (localVar == TCL_INDEX_NONE) { if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "cannot use this instruction to create a variable" " in a non-proc context", -1)); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "LVT", NULL); } - return -1; + return TCL_INDEX_NONE; } *tokenPtrPtr = TokenAfter(tokenPtr); return localVar; @@ -2651,7 +2650,7 @@ AllocBB( AssemblyEnv* assemEnvPtr) /* Assembly environment */ { CompileEnv* envPtr = assemEnvPtr->envPtr; - BasicBlock *bb = (BasicBlock*)ckalloc(sizeof(BasicBlock)); + BasicBlock *bb = (BasicBlock*)Tcl_Alloc(sizeof(BasicBlock)); bb->originalStartOffset = bb->startOffset = envPtr->codeNext - envPtr->codeStart; @@ -2913,7 +2912,7 @@ CheckJumpTableLabels( valEntryPtr = Tcl_FindHashEntry(&assemEnvPtr->labelHash, TclGetString(symbolObj)); DEBUG_PRINT(" %s -> %s (%d)\n", - (char*) Tcl_GetHashKey(symHash, symEntryPtr), + (char *)Tcl_GetHashKey(symHash, symEntryPtr), TclGetString(symbolObj), (valEntryPtr != NULL)); if (valEntryPtr == NULL) { ReportUndefinedLabel(assemEnvPtr, bbPtr, symbolObj); @@ -3118,7 +3117,7 @@ ResolveJumpTableTargets( realJumpEntryPtr = Tcl_CreateHashEntry(realJumpHashPtr, Tcl_GetHashKey(symHash, symEntryPtr), &junk); DEBUG_PRINT(" %s -> %s -> bb %p (pc %d) hash entry %p\n", - (char*) Tcl_GetHashKey(symHash, symEntryPtr), + (char *)Tcl_GetHashKey(symHash, symEntryPtr), TclGetString(symbolObj), jumpTargetBBPtr, jumpTargetBBPtr->startOffset, realJumpEntryPtr); @@ -3319,7 +3318,7 @@ CheckStack( { CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ - int maxDepth; /* Maximum stack depth overall */ + size_t maxDepth; /* Maximum stack depth overall */ /* * Checking the head block will check all the other blocks recursively. @@ -3929,8 +3928,8 @@ BuildExceptionRanges( * Allocate memory for a stack of active catches. */ - catches = (BasicBlock**)ckalloc(maxCatchDepth * sizeof(BasicBlock*)); - catchIndices = (int *)ckalloc(maxCatchDepth * sizeof(int)); + catches = (BasicBlock**)Tcl_Alloc(maxCatchDepth * sizeof(BasicBlock*)); + catchIndices = (int *)Tcl_Alloc(maxCatchDepth * sizeof(int)); for (i = 0; i < maxCatchDepth; ++i) { catches[i] = NULL; catchIndices[i] = -1; @@ -3969,8 +3968,8 @@ BuildExceptionRanges( /* Free temp storage */ - ckfree(catchIndices); - ckfree(catches); + Tcl_Free(catchIndices); + Tcl_Free(catches); return TCL_OK; } @@ -4128,7 +4127,7 @@ StackFreshCatches( TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr); range = envPtr->exceptArrayPtr + catchIndices[catchDepth]; range->nestingLevel = envPtr->exceptDepth + catchDepth; - envPtr->maxExceptDepth = + envPtr->maxExceptDepth= TclMax(range->nestingLevel + 1, envPtr->maxExceptDepth); range->codeOffset = bbPtr->startOffset; @@ -4165,7 +4164,7 @@ RestoreEmbeddedExceptionRanges( BasicBlock* bbPtr; /* Current basic block */ int rangeBase; /* Base of the foreign exception ranges when * they are reinstalled */ - int rangeIndex; /* Index of the current foreign exception + size_t rangeIndex; /* Index of the current foreign exception * range as reinstalled */ ExceptionRange* range; /* Current foreign exception range */ unsigned char opcode; /* Current instruction's opcode */ @@ -4192,7 +4191,7 @@ RestoreEmbeddedExceptionRanges( range->nestingLevel += envPtr->exceptDepth + bbPtr->catchDepth; memcpy(envPtr->exceptArrayPtr + rangeIndex, range, sizeof(ExceptionRange)); - if (range->nestingLevel >= envPtr->maxExceptDepth) { + if (range->nestingLevel + 1 >= envPtr->maxExceptDepth + 1) { envPtr->maxExceptDepth = range->nestingLevel + 1; } } diff --git a/generic/tclAsync.c b/generic/tclAsync.c index 9ce2c88..f0f0c9c 100644 --- a/generic/tclAsync.c +++ b/generic/tclAsync.c @@ -30,7 +30,7 @@ typedef struct AsyncHandler { * for the process. */ Tcl_AsyncProc *proc; /* Procedure to call when handler is * invoked. */ - ClientData clientData; /* Value to pass to handler when it is + void *clientData; /* Value to pass to handler when it is * invoked. */ struct ThreadSpecificData *originTsd; /* Used in Tcl_AsyncMark to modify thread- @@ -38,7 +38,7 @@ typedef struct AsyncHandler { * associated to. */ Tcl_ThreadId originThrdId; /* Origin thread where this token was created * and where it will be yielded. */ - ClientData notifierData; /* Platform notifier data or NULL. */ + void *notifierData; /* Platform notifier data or NULL. */ } AsyncHandler; typedef struct ThreadSpecificData { @@ -115,7 +115,7 @@ TclFinalizeAsync(void) while (toDelete != NULL) { token = toDelete; toDelete = toDelete->nextPtr; - ckfree(token); + Tcl_Free(token); } } @@ -142,12 +142,12 @@ Tcl_AsyncHandler Tcl_AsyncCreate( Tcl_AsyncProc *proc, /* Procedure to call when handler is * invoked. */ - ClientData clientData) /* Argument to pass to handler. */ + void *clientData) /* Argument to pass to handler. */ { AsyncHandler *asyncPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - asyncPtr = (AsyncHandler*)ckalloc(sizeof(AsyncHandler)); + asyncPtr = (AsyncHandler*)Tcl_Alloc(sizeof(AsyncHandler)); asyncPtr->ready = 0; asyncPtr->nextPtr = NULL; asyncPtr->prevPtr = NULL; @@ -406,7 +406,7 @@ Tcl_AsyncDelete( asyncPtr->nextPtr->prevPtr = asyncPtr->prevPtr; } Tcl_MutexUnlock(&asyncMutex); - ckfree(asyncPtr); + Tcl_Free(asyncPtr); } /* diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 80dc416..52c35fc 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -78,18 +78,6 @@ #endif /* - * The following structure defines the client data for a math function - * registered with Tcl_CreateMathFunc - */ - -typedef struct OldMathFuncData { - Tcl_MathProc *proc; /* Handler function */ - int numArgs; /* Number of args expected */ - Tcl_ValueType *argTypes; /* Types of the args */ - void *clientData; /* Client data for the handler function */ -} OldMathFuncData; - -/* * This is the script cancellation struct and hash table. The hash table is * used to keep track of the information necessary to process script * cancellation requests, including the original interp, asynchronous handler @@ -105,7 +93,7 @@ typedef struct { * cancellation. */ char *result; /* The script cancellation result or NULL for * a default result. */ - int length; /* Length of the above error message. */ + size_t length; /* Length of the above error message. */ void *clientData; /* Not used. */ int flags; /* Additional flags */ } CancelInfo; @@ -190,10 +178,6 @@ static Tcl_NRPostProc NRCoroutineCallerCallback; static Tcl_NRPostProc NRCoroutineExitCallback; static Tcl_NRPostProc NRCommand; -#if !defined(TCL_NO_DEPRECATED) -static Tcl_ObjCmdProc OldMathFuncProc; -static void OldMathFuncDeleteProc(void *clientData); -#endif /* !defined(TCL_NO_DEPRECATED) */ static void ProcessUnexpectedResult(Tcl_Interp *interp, int returnCode); static int RewindCoroutine(CoroutineData *corPtr, int result); @@ -236,8 +220,8 @@ MODULE_SCOPE const TclStubs tclStubs; #define CORO_ACTIVATE_YIELD NULL #define CORO_ACTIVATE_YIELDM INT2PTR(1) -#define COROUTINE_ARGUMENTS_SINGLE_OPTIONAL (-1) -#define COROUTINE_ARGUMENTS_ARBITRARY (-2) +#define COROUTINE_ARGUMENTS_SINGLE_OPTIONAL ((size_t)-1) +#define COROUTINE_ARGUMENTS_ARBITRARY ((size_t)-2) /* * The following structure define the commands in the Tcl core. @@ -280,6 +264,12 @@ typedef struct { * The built-in commands, and the functions that implement them: */ +int procObjCmd(void *clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]) { + return Tcl_ProcObjCmd(clientData, interp, objc, objv); +} + + static const CmdInfo builtInCmds[] = { /* * Commands in the generic core. @@ -288,9 +278,6 @@ static const CmdInfo builtInCmds[] = { {"append", Tcl_AppendObjCmd, TclCompileAppendCmd, NULL, CMD_IS_SAFE}, {"apply", Tcl_ApplyObjCmd, NULL, TclNRApplyObjCmd, CMD_IS_SAFE}, {"break", Tcl_BreakObjCmd, TclCompileBreakCmd, NULL, CMD_IS_SAFE}, -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 - {"case", Tcl_CaseObjCmd, NULL, NULL, CMD_IS_SAFE}, -#endif {"catch", Tcl_CatchObjCmd, TclCompileCatchCmd, TclNRCatchObjCmd, CMD_IS_SAFE}, {"concat", Tcl_ConcatObjCmd, TclCompileConcatCmd, NULL, CMD_IS_SAFE}, {"continue", Tcl_ContinueObjCmd, TclCompileContinueCmd, NULL, CMD_IS_SAFE}, @@ -327,7 +314,7 @@ static const CmdInfo builtInCmds[] = { {"lset", Tcl_LsetObjCmd, TclCompileLsetCmd, NULL, CMD_IS_SAFE}, {"lsort", Tcl_LsortObjCmd, NULL, NULL, CMD_IS_SAFE}, {"package", Tcl_PackageObjCmd, NULL, TclNRPackageObjCmd, CMD_IS_SAFE}, - {"proc", Tcl_ProcObjCmd, NULL, NULL, CMD_IS_SAFE}, + {"proc", procObjCmd, NULL, NULL, CMD_IS_SAFE}, {"regexp", Tcl_RegexpObjCmd, TclCompileRegexpCmd, NULL, CMD_IS_SAFE}, {"regsub", Tcl_RegsubObjCmd, TclCompileRegsubCmd, NULL, CMD_IS_SAFE}, {"rename", Tcl_RenameObjCmd, NULL, NULL, CMD_IS_SAFE}, @@ -623,19 +610,19 @@ TclFinalizeEvaluation(void) */ static int -buildInfoObjCmd( +buildInfoObjCmd2( void *clientData, Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ + size_t objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - if (objc > 2) { + if (objc - 1 > 1) { Tcl_WrongNumArgs(interp, 1, objv, "?option?"); return TCL_ERROR; } if (objc == 2) { - int len; - const char *arg = TclGetStringFromObj(objv[1], &len); + size_t len; + const char *arg = Tcl_GetStringFromObj(objv[1], &len); if (len == 7 && !strcmp(arg, "version")) { char buf[80]; const char *p = strchr((char *)clientData, '.'); @@ -708,6 +695,16 @@ buildInfoObjCmd( return TCL_OK; } +static int +buildInfoObjCmd( + void *clientData, + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + return buildInfoObjCmd2(clientData, interp, (size_t)objc, objv); +} + /* *---------------------------------------------------------------------- * @@ -759,16 +756,13 @@ Tcl_CreateInterp(void) Tcl_Panic("Tcl_CallFrame must not be smaller than CallFrame"); } -#if defined(_WIN32) && !defined(_WIN64) && !defined(_USE_64BIT_TIME_T) - /* If Tcl is compiled on Win32 using -D_USE_64BIT_TIME_T - * the result is a binary incompatible with the 'standard' build of - * Tcl: All extensions using Tcl_StatBuf need to be recompiled in - * the same way. Therefore, this is not officially supported. - * In stead, it is recommended to use Win64 or Tcl 9.0 (not released yet) - */ +#if defined(_WIN32) && !defined(_WIN64) + if (sizeof(time_t) != 8) { + Tcl_Panic("<time.h> is not compatible with VS2005+"); + } if ((offsetof(Tcl_StatBuf,st_atime) != 32) - || (offsetof(Tcl_StatBuf,st_ctime) != 40)) { - Tcl_Panic("<sys/stat.h> is not compatible with MSVC"); + || (offsetof(Tcl_StatBuf,st_ctime) != 48)) { + Tcl_Panic("<sys/stat.h> is not compatible with VS2005+"); } #endif @@ -802,25 +796,23 @@ Tcl_CreateInterp(void) * object type table and other object management code. */ - iPtr = (Interp *)ckalloc(sizeof(Interp)); + iPtr = (Interp *)Tcl_Alloc(sizeof(Interp)); interp = (Tcl_Interp *) iPtr; -#ifdef TCL_NO_DEPRECATED - iPtr->result = &tclEmptyString; -#else - iPtr->result = iPtr->resultSpace; -#endif - iPtr->freeProc = NULL; + iPtr->legacyResult = NULL; + /* Special invalid value: Any attempt to free the legacy result + * will cause a crash. */ + iPtr->legacyFreeProc = (void (*) (void))-1; iPtr->errorLine = 0; - TclNewObj(iPtr->objResultPtr); + iPtr->stubTable = &tclStubs; + iPtr->objResultPtr = Tcl_NewObj(); Tcl_IncrRefCount(iPtr->objResultPtr); iPtr->handle = TclHandleCreate(iPtr); iPtr->globalNsPtr = NULL; iPtr->hiddenCmdTablePtr = NULL; iPtr->interpInfo = NULL; - TCL_CT_ASSERT(sizeof(iPtr->extra) <= sizeof(Tcl_HashTable)); - iPtr->extra.optimizer = TclOptimizeBytecode; + iPtr->optimizer = TclOptimizeBytecode; iPtr->numLevels = 0; iPtr->maxNestingDepth = MAX_NESTING_DEPTH; @@ -833,10 +825,10 @@ Tcl_CreateInterp(void) */ iPtr->cmdFramePtr = NULL; - iPtr->linePBodyPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable)); - iPtr->lineBCPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable)); - iPtr->lineLAPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable)); - iPtr->lineLABCPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable)); + iPtr->linePBodyPtr = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable)); + iPtr->lineBCPtr = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable)); + iPtr->lineLAPtr = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable)); + iPtr->lineLABCPtr = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(iPtr->linePBodyPtr, TCL_ONE_WORD_KEYS); Tcl_InitHashTable(iPtr->lineBCPtr, TCL_ONE_WORD_KEYS); Tcl_InitHashTable(iPtr->lineLAPtr, TCL_ONE_WORD_KEYS); @@ -869,12 +861,6 @@ Tcl_CreateInterp(void) iPtr->rootFramePtr = NULL; /* Initialise as soon as :: is available */ iPtr->lookupNsPtr = NULL; -#ifndef TCL_NO_DEPRECATED - iPtr->appendResult = NULL; - iPtr->appendAvl = 0; - iPtr->appendUsed = 0; -#endif - Tcl_InitHashTable(&iPtr->packageTable, TCL_STRING_KEYS); iPtr->packageUnknown = NULL; @@ -904,11 +890,9 @@ Tcl_CreateInterp(void) iPtr->activeInterpTracePtr = NULL; iPtr->assocData = NULL; iPtr->execEnvPtr = NULL; /* Set after namespaces initialized. */ - TclNewObj(iPtr->emptyObjPtr); /* Another empty object. */ + iPtr->emptyObjPtr = Tcl_NewObj(); + /* Another empty object. */ Tcl_IncrRefCount(iPtr->emptyObjPtr); -#ifndef TCL_NO_DEPRECATED - iPtr->resultSpace[0] = 0; -#endif iPtr->threadId = Tcl_GetCurrentThread(); /* TIP #378 */ @@ -942,7 +926,7 @@ Tcl_CreateInterp(void) */ /* This is needed to satisfy GCC 3.3's strict aliasing rules */ - framePtr = (CallFrame *)ckalloc(sizeof(CallFrame)); + framePtr = (CallFrame *)Tcl_Alloc(sizeof(CallFrame)); (void) Tcl_PushCallFrame(interp, (Tcl_CallFrame *) framePtr, (Tcl_Namespace *) iPtr->globalNsPtr, /*isProcCallFrame*/ 0); framePtr->objc = 0; @@ -970,9 +954,9 @@ Tcl_CreateInterp(void) * TIP #285, Script cancellation support. */ - TclNewObj(iPtr->asyncCancelMsg); + iPtr->asyncCancelMsg = Tcl_NewObj(); - cancelInfo = (CancelInfo *)ckalloc(sizeof(CancelInfo)); + cancelInfo = (CancelInfo *)Tcl_Alloc(sizeof(CancelInfo)); cancelInfo->interp = interp; iPtr->asyncCancel = Tcl_AsyncCreate(CancelEvalProc, cancelInfo); @@ -1019,12 +1003,6 @@ Tcl_CreateInterp(void) #endif /* TCL_COMPILE_STATS */ /* - * Initialise the stub table pointer. - */ - - iPtr->stubTable = &tclStubs; - - /* * Initialize the ensemble error message rewriting support. */ @@ -1071,7 +1049,7 @@ Tcl_CreateInterp(void) hPtr = Tcl_CreateHashEntry(&iPtr->globalNsPtr->cmdTable, cmdInfoPtr->name, &isNew); if (isNew) { - cmdPtr = (Command *)ckalloc(sizeof(Command)); + cmdPtr = (Command *)Tcl_Alloc(sizeof(Command)); cmdPtr->hPtr = hPtr; cmdPtr->nsPtr = iPtr->globalNsPtr; cmdPtr->refCount = 1; @@ -1201,7 +1179,7 @@ Tcl_CreateInterp(void) #define MATH_OP_PREFIX_LEN 15 /* == strlen("::tcl::mathop::") */ memcpy(mathFuncName, "::tcl::mathop::", MATH_OP_PREFIX_LEN); for (opcmdInfoPtr=mathOpCmds ; opcmdInfoPtr->name!=NULL ; opcmdInfoPtr++){ - TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)ckalloc(sizeof(TclOpCmdClientData)); + TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)Tcl_Alloc(sizeof(TclOpCmdClientData)); occdPtr->op = opcmdInfoPtr->name; occdPtr->i.numArgs = opcmdInfoPtr->i.numArgs; @@ -1259,24 +1237,8 @@ Tcl_CreateInterp(void) Tcl_SetVar2(interp, "tcl_patchLevel", NULL, TCL_PATCH_LEVEL, TCL_GLOBAL_ONLY); Tcl_SetVar2(interp, "tcl_version", NULL, TCL_VERSION, TCL_GLOBAL_ONLY); -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 - Tcl_TraceVar2(interp, "tcl_precision", NULL, - TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, - TclPrecTraceProc, NULL); -#endif /* !TCL_NO_DEPRECATED */ TclpSetVariables(interp); -#if TCL_THREADS && !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 - /* - * The existence of the "threaded" element of the tcl_platform array - * indicates that this particular Tcl shell has been compiled with threads - * turned on. Using "info exists tcl_platform(threaded)" a Tcl script can - * introspect on the interpreter level of thread safety. - */ - - Tcl_SetVar2(interp, "tcl_platform", "threaded", "1", TCL_GLOBAL_ONLY); -#endif - /* * Register Tcl's version number. * TIP #268: Full patchlevel instead of just major.minor @@ -1285,16 +1247,20 @@ Tcl_CreateInterp(void) Tcl_PkgProvideEx(interp, "Tcl", TCL_PATCH_LEVEL, &tclStubs); Tcl_PkgProvideEx(interp, "tcl", TCL_PATCH_LEVEL, &tclStubs); - Tcl_CreateObjCommand(interp, "::tcl::build-info", + Tcl_CmdInfo info2; + Tcl_Command buildInfoCmd = Tcl_CreateObjCommand(interp, "::tcl::build-info", buildInfoObjCmd, (void *)version, NULL); - + Tcl_GetCommandInfoFromToken(buildInfoCmd, &info2); + info2.objProc2 = buildInfoObjCmd2; + info2.objClientData2 = (void *)version; + Tcl_SetCommandInfoFromToken(buildInfoCmd, &info2); if (TclTommath_Init(interp) != TCL_OK) { - Tcl_Panic("%s", TclGetString(Tcl_GetObjResult(interp))); + Tcl_Panic("%s", Tcl_GetStringResult(interp)); } if (TclOOInit(interp) != TCL_OK) { - Tcl_Panic("%s", TclGetString(Tcl_GetObjResult(interp))); + Tcl_Panic("%s", Tcl_GetStringResult(interp)); } /* @@ -1304,10 +1270,10 @@ Tcl_CreateInterp(void) #ifdef HAVE_ZLIB if (TclZlibInit(interp) != TCL_OK) { - Tcl_Panic("%s", TclGetString(Tcl_GetObjResult(interp))); + Tcl_Panic("%s", Tcl_GetStringResult(interp)); } if (TclZipfs_Init(interp) != TCL_OK) { - Tcl_Panic("%s", Tcl_GetString(Tcl_GetObjResult(interp))); + Tcl_Panic("%s", Tcl_GetStringResult(interp)); } #endif @@ -1321,7 +1287,7 @@ DeleteOpCmdClientData( { TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)clientData; - ckfree(occdPtr); + Tcl_Free(occdPtr); } /* @@ -1439,7 +1405,7 @@ TclHideUnsafeCommands( TclGetString(hideName)) != TCL_OK) { Tcl_Panic("problem making '%s %s' safe: %s", unsafePtr->ensembleNsName, unsafePtr->commandName, - Tcl_GetString(Tcl_GetObjResult(interp))); + Tcl_GetStringResult(interp)); } Tcl_CreateObjCommand(interp, TclGetString(cmdName), BadEnsembleSubcommand, (void *)unsafePtr, NULL); @@ -1454,7 +1420,7 @@ TclHideUnsafeCommands( unsafePtr->ensembleNsName) != TCL_OK) { Tcl_Panic("problem making '%s' safe: %s", unsafePtr->ensembleNsName, - Tcl_GetString(Tcl_GetObjResult(interp))); + Tcl_GetStringResult(interp)); } } } @@ -1530,14 +1496,14 @@ Tcl_CallWhenDeleted( (int *)Tcl_GetThreadData(&assocDataCounterKey, sizeof(int)); int isNew; char buffer[32 + TCL_INTEGER_SPACE]; - AssocData *dPtr = (AssocData *)ckalloc(sizeof(AssocData)); + AssocData *dPtr = (AssocData *)Tcl_Alloc(sizeof(AssocData)); Tcl_HashEntry *hPtr; sprintf(buffer, "Assoc Data Key #%d", *assocDataCounterPtr); (*assocDataCounterPtr)++; if (iPtr->assocData == NULL) { - iPtr->assocData = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable)); + iPtr->assocData = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(iPtr->assocData, TCL_STRING_KEYS); } hPtr = Tcl_CreateHashEntry(iPtr->assocData, buffer, &isNew); @@ -1586,7 +1552,7 @@ Tcl_DontCallWhenDeleted( hPtr = Tcl_NextHashEntry(&hSearch)) { dPtr = (AssocData *)Tcl_GetHashValue(hPtr); if ((dPtr->proc == proc) && (dPtr->clientData == clientData)) { - ckfree(dPtr); + Tcl_Free(dPtr); Tcl_DeleteHashEntry(hPtr); return; } @@ -1626,14 +1592,14 @@ Tcl_SetAssocData( int isNew; if (iPtr->assocData == NULL) { - iPtr->assocData = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable)); + iPtr->assocData = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(iPtr->assocData, TCL_STRING_KEYS); } hPtr = Tcl_CreateHashEntry(iPtr->assocData, name, &isNew); if (isNew == 0) { dPtr = (AssocData *)Tcl_GetHashValue(hPtr); } else { - dPtr = (AssocData *)ckalloc(sizeof(AssocData)); + dPtr = (AssocData *)Tcl_Alloc(sizeof(AssocData)); } dPtr->proc = proc; dPtr->clientData = clientData; @@ -1678,7 +1644,7 @@ Tcl_DeleteAssocData( if (dPtr->proc != NULL) { dPtr->proc(dPtr->clientData, interp); } - ckfree(dPtr); + Tcl_Free(dPtr); Tcl_DeleteHashEntry(hPtr); } @@ -1833,7 +1799,7 @@ DeleteInterpProc( Tcl_HashSearch search; Tcl_HashTable *hTablePtr; ResolverScheme *resPtr, *nextResPtr; - int i; + size_t i; /* * Punt if there is an error in the Tcl_Release/Tcl_Preserve matchup, @@ -1874,9 +1840,9 @@ DeleteInterpProc( if (cancelInfo != NULL) { if (cancelInfo->result != NULL) { - ckfree(cancelInfo->result); + Tcl_Free(cancelInfo->result); } - ckfree(cancelInfo); + Tcl_Free(cancelInfo); } Tcl_DeleteHashEntry(hPtr); @@ -1931,7 +1897,7 @@ DeleteInterpProc( Tcl_DeleteCommandFromToken(interp, (Tcl_Command)Tcl_GetHashValue(hPtr)); } Tcl_DeleteHashTable(hTablePtr); - ckfree(hTablePtr); + Tcl_Free(hTablePtr); } @@ -1951,10 +1917,10 @@ DeleteInterpProc( dPtr->proc(dPtr->clientData, interp); } Tcl_DeleteHashEntry(hPtr); - ckfree(dPtr); + Tcl_Free(dPtr); } Tcl_DeleteHashTable(hTablePtr); - ckfree(hTablePtr); + Tcl_Free(hTablePtr); iPtr->assocData = NULL; } @@ -1967,7 +1933,7 @@ DeleteInterpProc( Tcl_Panic("DeleteInterpProc: popping rootCallFrame with other frames on top"); } Tcl_PopCallFrame(interp); - ckfree(iPtr->rootFramePtr); + Tcl_Free(iPtr->rootFramePtr); iPtr->rootFramePtr = NULL; Tcl_DeleteNamespace((Tcl_Namespace *) iPtr->globalNsPtr); @@ -1976,10 +1942,6 @@ DeleteInterpProc( * could have transferred ownership of the result string to Tcl. */ -#ifndef TCL_NO_DEPRECATED - Tcl_FreeResult(interp); - iPtr->result = NULL; -#endif Tcl_DecrRefCount(iPtr->objResultPtr); iPtr->objResultPtr = NULL; Tcl_DecrRefCount(iPtr->ecVar); @@ -2001,12 +1963,6 @@ DeleteInterpProc( if (iPtr->returnOpts) { Tcl_DecrRefCount(iPtr->returnOpts); } -#ifndef TCL_NO_DEPRECATED - if (iPtr->appendResult != NULL) { - ckfree(iPtr->appendResult); - iPtr->appendResult = NULL; - } -#endif TclFreePackageInfo(iPtr); while (iPtr->tracePtr != NULL) { Tcl_DeleteTrace((Tcl_Interp *) iPtr, (Tcl_Trace) iPtr->tracePtr); @@ -2024,8 +1980,8 @@ DeleteInterpProc( resPtr = iPtr->resolverPtr; while (resPtr) { nextResPtr = resPtr->nextPtr; - ckfree(resPtr->name); - ckfree(resPtr); + Tcl_Free(resPtr->name); + Tcl_Free(resPtr); resPtr = nextResPtr; } @@ -2052,13 +2008,13 @@ DeleteInterpProc( if (cfPtr->type == TCL_LOCATION_SOURCE) { Tcl_DecrRefCount(cfPtr->data.eval.path); } - ckfree(cfPtr->line); - ckfree(cfPtr); + Tcl_Free(cfPtr->line); + Tcl_Free(cfPtr); } Tcl_DeleteHashEntry(hPtr); } Tcl_DeleteHashTable(iPtr->linePBodyPtr); - ckfree(iPtr->linePBodyPtr); + Tcl_Free(iPtr->linePBodyPtr); iPtr->linePBodyPtr = NULL; /* @@ -2074,18 +2030,18 @@ DeleteInterpProc( Tcl_DecrRefCount(eclPtr->path); } for (i=0; i<eclPtr->nuloc; i++) { - ckfree(eclPtr->loc[i].line); + Tcl_Free(eclPtr->loc[i].line); } if (eclPtr->loc != NULL) { - ckfree(eclPtr->loc); + Tcl_Free(eclPtr->loc); } - ckfree(eclPtr); + Tcl_Free(eclPtr); Tcl_DeleteHashEntry(hPtr); } Tcl_DeleteHashTable(iPtr->lineBCPtr); - ckfree(iPtr->lineBCPtr); + Tcl_Free(iPtr->lineBCPtr); iPtr->lineBCPtr = NULL; /* @@ -2104,7 +2060,7 @@ DeleteInterpProc( } Tcl_DeleteHashTable(iPtr->lineLAPtr); - ckfree(iPtr->lineLAPtr); + Tcl_Free(iPtr->lineLAPtr); iPtr->lineLAPtr = NULL; if (iPtr->lineLABCPtr->numEntries && !TclInExit()) { @@ -2117,7 +2073,7 @@ DeleteInterpProc( } Tcl_DeleteHashTable(iPtr->lineLABCPtr); - ckfree(iPtr->lineLABCPtr); + Tcl_Free(iPtr->lineLABCPtr); iPtr->lineLABCPtr = NULL; /* @@ -2128,7 +2084,7 @@ DeleteInterpProc( Tcl_DeleteHashTable(&iPtr->varTraces); Tcl_DeleteHashTable(&iPtr->varSearches); - ckfree(iPtr); + Tcl_Free(iPtr); } /* @@ -2232,7 +2188,7 @@ Tcl_HideCommand( hiddenCmdTablePtr = iPtr->hiddenCmdTablePtr; if (hiddenCmdTablePtr == NULL) { - hiddenCmdTablePtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable)); + hiddenCmdTablePtr = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(hiddenCmdTablePtr, TCL_STRING_KEYS); iPtr->hiddenCmdTablePtr = hiddenCmdTablePtr; } @@ -2598,7 +2554,7 @@ Tcl_CreateCommand( * infinite loop). */ - ckfree(Tcl_GetHashValue(hPtr)); + Tcl_Free(Tcl_GetHashValue(hPtr)); } if (!deleted) { @@ -2623,7 +2579,7 @@ Tcl_CreateCommand( TclInvalidateNsCmdLookup(nsPtr); TclInvalidateNsPath(nsPtr); } - cmdPtr = (Command *)ckalloc(sizeof(Command)); + cmdPtr = (Command *)Tcl_Alloc(sizeof(Command)); Tcl_SetHashValue(hPtr, cmdPtr); cmdPtr->hPtr = hPtr; cmdPtr->nsPtr = nsPtr; @@ -2681,7 +2637,6 @@ Tcl_CreateCommand( * Side effects: * If a command named "cmdName" already exists for interp, it is * first deleted. Then the new command is created from the arguments. - * [***] (See below for exception). * * In the future, during bytecode evaluation when "cmdName" is seen as * the name of a command by Tcl_EvalObj or Tcl_Eval, the object-based @@ -2710,7 +2665,7 @@ static int cmdWrapperProc(void *clientData, if (objc < 0) { objc = -1; } - return info->proc(info->clientData, interp, objc, objv); + return info->proc(info->clientData, interp, (size_t)objc, objv); } static void cmdWrapperDeleteProc(void *clientData) { @@ -2718,7 +2673,7 @@ static void cmdWrapperDeleteProc(void *clientData) { clientData = info->deleteData; Tcl_CmdDeleteProc *deleteProc = info->deleteProc; - ckfree(info); + Tcl_Free(info); if (deleteProc != NULL) { deleteProc(clientData); } @@ -2741,7 +2696,7 @@ Tcl_CreateObjCommand2( * this command is deleted. */ ) { - CmdWrapperInfo *info = (CmdWrapperInfo *)ckalloc(sizeof(CmdWrapperInfo)); + CmdWrapperInfo *info = (CmdWrapperInfo *)Tcl_Alloc(sizeof(CmdWrapperInfo)); info->proc = proc; info->clientData = clientData; info->deleteProc = deleteProc; @@ -2850,24 +2805,7 @@ TclCreateObjCommandInNs( cmdPtr = (Command *)Tcl_GetHashValue(hPtr); /* - * [***] This is wrong. See Tcl Bug a16752c252. - * However, this buggy behavior is kept under particular circumstances - * to accommodate deployed binaries of the "tclcompiler" program - * <http://sourceforge.net/projects/tclpro/> that crash if the bug is - * fixed. - */ - - if (cmdPtr->objProc == TclInvokeStringCommand - && cmdPtr->clientData == clientData - && cmdPtr->deleteData == clientData - && cmdPtr->deleteProc == deleteProc) { - cmdPtr->objProc = proc; - cmdPtr->objClientData = clientData; - return (Tcl_Command) cmdPtr; - } - - /* - * Otherwise, we delete the old command. Be careful to preserve any + * Command already exists; delete it. Be careful to preserve any * existing import links so we can restore them down below. That way, * you can redefine a command and its import status will remain * intact. @@ -2903,7 +2841,7 @@ TclCreateObjCommandInNs( * infinite loop). */ - ckfree(Tcl_GetHashValue(hPtr)); + Tcl_Free(Tcl_GetHashValue(hPtr)); } if (!deleted) { @@ -2928,7 +2866,7 @@ TclCreateObjCommandInNs( TclInvalidateNsCmdLookup(nsPtr); TclInvalidateNsPath(nsPtr); } - cmdPtr = (Command *)ckalloc(sizeof(Command)); + cmdPtr = (Command *)Tcl_Alloc(sizeof(Command)); Tcl_SetHashValue(hPtr, cmdPtr); cmdPtr->hPtr = hPtr; cmdPtr->nsPtr = nsPtr; @@ -3076,13 +3014,6 @@ TclInvokeObjectCommand( } /* - * Move the interpreter's object result to the string result, then reset - * the object result. - */ - - (void) Tcl_GetStringResult(interp); - - /* * Decrement the ref counts for the argument objects created above, then * free the objv array if malloc'ed storage was used. */ @@ -3356,6 +3287,37 @@ Tcl_SetCommandInfo( *---------------------------------------------------------------------- */ +static int +invokeObj2Command( + void *clientData, /* Points to command's Command structure. */ + Tcl_Interp *interp, /* Current interpreter. */ + size_t objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + int result; + Command *cmdPtr = (Command *) clientData; + + if (objc > INT_MAX) { + objc = TCL_INDEX_NONE; + } + if (cmdPtr->objProc != NULL) { + result = cmdPtr->objProc(cmdPtr->objClientData, interp, objc, objv); + } else { + result = Tcl_NRCallObjProc(interp, cmdPtr->nreProc, + cmdPtr->objClientData, objc, objv); + } + return result; +} + +static int cmdWrapper2Proc(void *clientData, + Tcl_Interp *interp, + size_t objc, + Tcl_Obj *const objv[]) +{ + Command *cmdPtr = (Command *)clientData; + return cmdPtr->objProc(cmdPtr->objClientData, interp, objc, objv); +} + int Tcl_SetCommandInfoFromToken( Tcl_Command cmd, @@ -3387,11 +3349,33 @@ Tcl_SetCommandInfoFromToken( } if (cmdPtr->deleteProc == cmdWrapperDeleteProc) { CmdWrapperInfo *info = (CmdWrapperInfo *)cmdPtr->deleteData; + if (infoPtr->objProc2 == NULL) { + info->proc = invokeObj2Command; + info->clientData = cmdPtr; + info->nreProc = NULL; + } else { + if (infoPtr->objProc2 != info->proc) { + info->nreProc = NULL; + info->proc = infoPtr->objProc2; + } + info->clientData = infoPtr->objClientData2; + } info->deleteProc = infoPtr->deleteProc; info->deleteData = infoPtr->deleteData; } else { - cmdPtr->deleteProc = infoPtr->deleteProc; - cmdPtr->deleteData = infoPtr->deleteData; + if ((infoPtr->objProc2 != NULL) && (infoPtr->objProc2 != cmdWrapper2Proc)) { + CmdWrapperInfo *info = (CmdWrapperInfo *)Tcl_Alloc(sizeof(CmdWrapperInfo)); + info->proc = infoPtr->objProc2; + info->clientData = infoPtr->objClientData2; + info->nreProc = NULL; + info->deleteProc = infoPtr->deleteProc; + info->deleteData = infoPtr->deleteData; + cmdPtr->deleteProc = cmdWrapperDeleteProc; + cmdPtr->deleteData = info; + } else { + cmdPtr->deleteProc = infoPtr->deleteProc; + cmdPtr->deleteData = infoPtr->deleteData; + } } return 1; } @@ -3459,7 +3443,8 @@ Tcl_GetCommandInfoFromToken( /* * Set isNativeObjectProc 1 if objProc was registered by a call to - * Tcl_CreateObjCommand. Otherwise set it to 0. + * Tcl_CreateObjCommand. Set isNativeObjectProc 2 if objProc was + * registered by a call to Tcl_CreateObjCommand2. Otherwise set it to 0. */ cmdPtr = (Command *) cmd; @@ -3473,9 +3458,16 @@ Tcl_GetCommandInfoFromToken( CmdWrapperInfo *info = (CmdWrapperInfo *)cmdPtr->deleteData; infoPtr->deleteProc = info->deleteProc; infoPtr->deleteData = info->deleteData; + infoPtr->objProc2 = info->proc; + infoPtr->objClientData2 = info->clientData; + if (cmdPtr->objProc == cmdWrapperProc) { + infoPtr->isNativeObjectProc = 2; + } } else { infoPtr->deleteProc = cmdPtr->deleteProc; infoPtr->deleteData = cmdPtr->deleteData; + infoPtr->objProc2 = cmdWrapper2Proc; + infoPtr->objClientData2 = cmdPtr; } infoPtr->namespacePtr = (Tcl_Namespace *) cmdPtr->nsPtr; return 1; @@ -3704,7 +3696,7 @@ Tcl_DeleteCommandFromToken( CommandTrace *nextPtr = tracePtr->nextPtr; if (tracePtr->refCount-- <= 1) { - ckfree(tracePtr); + Tcl_Free(tracePtr); } tracePtr = nextPtr; } @@ -3756,10 +3748,10 @@ Tcl_DeleteCommandFromToken( * If you are getting a crash during the call to deleteProc and * cmdPtr->deleteProc is a pointer to the function free(), the most * likely cause is that your extension allocated memory for the - * clientData argument to Tcl_CreateObjCommand with the ckalloc() + * clientData argument to Tcl_CreateObjCommand with the Tcl_Alloc() * macro and you are now trying to deallocate this memory with free() - * instead of ckfree(). You should pass a pointer to your own method - * that calls ckfree(). + * instead of Tcl_Free(). You should pass a pointer to your own method + * that calls Tcl_Free(). */ cmdPtr->deleteProc(cmdPtr->deleteData); @@ -3897,7 +3889,7 @@ CallCommandTraces( oldName, newName, flags); cmdPtr->flags &= ~tracePtr->flags; if (tracePtr->refCount-- <= 1) { - ckfree(tracePtr); + Tcl_Free(tracePtr); } } @@ -4028,372 +4020,9 @@ TclCleanupCommand( * be freed. */ { if (cmdPtr->refCount-- <= 1) { - ckfree(cmdPtr); - } -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_CreateMathFunc -- - * - * Creates a new math function for expressions in a given interpreter. - * - * Results: - * None. - * - * Side effects: - * The Tcl function defined by "name" is created or redefined. If the - * function already exists then its definition is replaced; this includes - * the builtin functions. Redefining a builtin function forces all - * existing code to be invalidated since that code may be compiled using - * an instruction specific to the replaced function. In addition, - * redefioning a non-builtin function will force existing code to be - * invalidated if the number of arguments has changed. - * - *---------------------------------------------------------------------- - */ - -#if !defined(TCL_NO_DEPRECATED) -void -Tcl_CreateMathFunc( - Tcl_Interp *interp, /* Interpreter in which function is to be - * available. */ - const char *name, /* Name of function (e.g. "sin"). */ - int numArgs, /* Nnumber of arguments required by - * function. */ - Tcl_ValueType *argTypes, /* Array of types acceptable for each - * argument. */ - Tcl_MathProc *proc, /* C function that implements the math - * function. */ - void *clientData) /* Additional value to pass to the - * function. */ -{ - Tcl_DString bigName; - OldMathFuncData *data = (OldMathFuncData *)ckalloc(sizeof(OldMathFuncData)); - - data->proc = proc; - data->numArgs = numArgs; - data->argTypes = (Tcl_ValueType *)ckalloc(numArgs * sizeof(Tcl_ValueType)); - if ((numArgs > 0) && (argTypes != NULL)) { - memcpy(data->argTypes, argTypes, numArgs * sizeof(Tcl_ValueType)); - } - data->clientData = clientData; - - Tcl_DStringInit(&bigName); - TclDStringAppendLiteral(&bigName, "::tcl::mathfunc::"); - Tcl_DStringAppend(&bigName, name, -1); - - Tcl_CreateObjCommand(interp, Tcl_DStringValue(&bigName), - OldMathFuncProc, data, OldMathFuncDeleteProc); - Tcl_DStringFree(&bigName); -} - -/* - *---------------------------------------------------------------------- - * - * OldMathFuncProc -- - * - * Dispatch to a math function created with Tcl_CreateMathFunc - * - * Results: - * Returns a standard Tcl result. - * - * Side effects: - * Whatever the math function does. - * - *---------------------------------------------------------------------- - */ - -static int -OldMathFuncProc( - void *clientData, /* Pointer to OldMathFuncData describing the - * function being called */ - Tcl_Interp *interp, /* Tcl interpreter */ - int objc, /* Actual parameter count */ - Tcl_Obj *const *objv) /* Parameter vector */ -{ - Tcl_Obj *valuePtr; - OldMathFuncData *dataPtr = (OldMathFuncData *)clientData; - Tcl_Value funcResult, *args; - int result; - int j, k; - double d; - - /* - * Check argument count. - */ - - if (objc != dataPtr->numArgs + 1) { - MathFuncWrongNumArgs(interp, dataPtr->numArgs+1, objc, objv); - return TCL_ERROR; - } - - /* - * Convert arguments from Tcl_Obj's to Tcl_Value's. - */ - - args = (Tcl_Value *)ckalloc(dataPtr->numArgs * sizeof(Tcl_Value)); - for (j = 1, k = 0; j < objc; ++j, ++k) { - /* TODO: Convert to Tcl_GetNumberFromObj? */ - valuePtr = objv[j]; - result = Tcl_GetDoubleFromObj(NULL, valuePtr, &d); -#ifdef ACCEPT_NAN - if (result != TCL_OK) { - const Tcl_ObjInternalRep *irPtr - = TclFetchInternalRep(valuePtr, &tclDoubleType); - - if (irPtr) { - d = irPtr->doubleValue; - result = TCL_OK; - } - } -#endif - if (result != TCL_OK) { - /* - * We have a non-numeric argument. - */ - - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "argument to math function didn't have numeric value", - -1)); - TclCheckBadOctal(interp, TclGetString(valuePtr)); - ckfree(args); - return TCL_ERROR; - } - - /* - * Copy the object's numeric value to the argument record, converting - * it if necessary. - * - * NOTE: no bignum support; use the new mathfunc interface for that. - */ - - args[k].type = dataPtr->argTypes[k]; - switch (args[k].type) { - case TCL_EITHER: - if (Tcl_GetLongFromObj(NULL, valuePtr, &args[k].intValue) - == TCL_OK) { - args[k].type = TCL_INT; - break; - } - if (TclGetWideIntFromObj(interp, valuePtr, &args[k].wideValue) - == TCL_OK) { - args[k].type = TCL_WIDE_INT; - break; - } - args[k].type = TCL_DOUBLE; - /* FALLTHROUGH */ - - case TCL_DOUBLE: - args[k].doubleValue = d; - break; - case TCL_INT: - if (ExprIntFunc(NULL, interp, 2, &objv[j-1]) != TCL_OK) { - ckfree(args); - return TCL_ERROR; - } - valuePtr = Tcl_GetObjResult(interp); - Tcl_GetLongFromObj(NULL, valuePtr, &args[k].intValue); - Tcl_ResetResult(interp); - break; - case TCL_WIDE_INT: - if (ExprWideFunc(NULL, interp, 2, &objv[j-1]) != TCL_OK) { - ckfree(args); - return TCL_ERROR; - } - valuePtr = Tcl_GetObjResult(interp); - TclGetWideIntFromObj(NULL, valuePtr, &args[k].wideValue); - Tcl_ResetResult(interp); - break; - } - } - - /* - * Call the function. - */ - - errno = 0; - result = dataPtr->proc(dataPtr->clientData, interp, args, &funcResult); - ckfree(args); - if (result != TCL_OK) { - return result; - } - - /* - * Return the result of the call. - */ - - if (funcResult.type == TCL_INT) { - TclNewIntObj(valuePtr, funcResult.intValue); - } else if (funcResult.type == TCL_WIDE_INT) { - TclNewIntObj(valuePtr, funcResult.wideValue); - } else { - return CheckDoubleResult(interp, funcResult.doubleValue); - } - Tcl_SetObjResult(interp, valuePtr); - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * - * OldMathFuncDeleteProc -- - * - * Cleans up after deleting a math function registered with - * Tcl_CreateMathFunc - * - * Results: - * None. - * - * Side effects: - * Frees allocated memory. - * - *---------------------------------------------------------------------- - */ - -static void -OldMathFuncDeleteProc( - void *clientData) -{ - OldMathFuncData *dataPtr = (OldMathFuncData *)clientData; - - ckfree(dataPtr->argTypes); - ckfree(dataPtr); -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_GetMathFuncInfo -- - * - * Discovers how a particular math function was created in a given - * interpreter. - * - * Results: - * TCL_OK if it succeeds, TCL_ERROR else (leaving an error message in the - * interpreter result if that happens.) - * - * Side effects: - * If this function succeeds, the variables pointed to by the numArgsPtr - * and argTypePtr arguments will be updated to detail the arguments - * allowed by the function. The variable pointed to by the procPtr - * argument will be set to NULL if the function is a builtin function, - * and will be set to the address of the C function used to implement the - * math function otherwise (in which case the variable pointed to by the - * clientDataPtr argument will also be updated.) - * - *---------------------------------------------------------------------- - */ - -int -Tcl_GetMathFuncInfo( - Tcl_Interp *interp, - const char *name, - int *numArgsPtr, - Tcl_ValueType **argTypesPtr, - Tcl_MathProc **procPtr, - void **clientDataPtr) -{ - Tcl_Obj *cmdNameObj; - Command *cmdPtr; - - /* - * Get the command that implements the math function. - */ - - TclNewLiteralStringObj(cmdNameObj, "tcl::mathfunc::"); - Tcl_AppendToObj(cmdNameObj, name, -1); - Tcl_IncrRefCount(cmdNameObj); - cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdNameObj); - Tcl_DecrRefCount(cmdNameObj); - - /* - * Report unknown functions. - */ - - if (cmdPtr == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "unknown math function \"%s\"", name)); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "MATHFUNC", name, NULL); - *numArgsPtr = -1; - *argTypesPtr = NULL; - *procPtr = NULL; - *clientDataPtr = NULL; - return TCL_ERROR; - } - - /* - * Retrieve function info for user defined functions; return dummy - * information for builtins. - */ - - if (cmdPtr->objProc == &OldMathFuncProc) { - OldMathFuncData *dataPtr = (OldMathFuncData *)cmdPtr->clientData; - - *procPtr = dataPtr->proc; - *numArgsPtr = dataPtr->numArgs; - *argTypesPtr = dataPtr->argTypes; - *clientDataPtr = dataPtr->clientData; - } else { - *procPtr = NULL; - *numArgsPtr = -1; - *argTypesPtr = NULL; - *procPtr = NULL; - *clientDataPtr = NULL; - } - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_ListMathFuncs -- - * - * Produces a list of all the math functions defined in a given - * interpreter. - * - * Results: - * A pointer to a Tcl_Obj structure with a reference count of zero, or - * NULL in the case of an error (in which case a suitable error message - * will be left in the interpreter result.) - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -Tcl_Obj * -Tcl_ListMathFuncs( - Tcl_Interp *interp, - const char *pattern) -{ - Tcl_Obj *script = Tcl_NewStringObj("::info functions ", -1); - Tcl_Obj *result; - Tcl_InterpState state; - - if (pattern) { - Tcl_Obj *patternObj = Tcl_NewStringObj(pattern, -1); - Tcl_Obj *arg = Tcl_NewListObj(1, &patternObj); - - Tcl_AppendObjToObj(script, arg); - Tcl_DecrRefCount(arg); /* Should tear down patternObj too */ - } - - state = Tcl_SaveInterpState(interp, TCL_OK); - Tcl_IncrRefCount(script); - if (TCL_OK == Tcl_EvalObjEx(interp, script, 0)) { - result = Tcl_DuplicateObj(Tcl_GetObjResult(interp)); - } else { - TclNewObj(result); + Tcl_Free(cmdPtr); } - Tcl_DecrRefCount(script); - Tcl_RestoreInterpState(interp, state); - - return result; } -#endif /* !defined(TCL_NO_DEPRECATED) */ /* *---------------------------------------------------------------------- @@ -4408,7 +4037,7 @@ Tcl_ListMathFuncs( * otherwise. * * Side effects: - * The interpreters object and string results are cleared. + * The interpreter's result is cleared. * *---------------------------------------------------------------------- */ @@ -4420,8 +4049,8 @@ TclInterpReady( Interp *iPtr = (Interp *) interp; /* - * Reset both the interpreter's string and object results and clear out - * any previous error information. + * Reset the interpreter's result and clear out any previous error + * information. */ Tcl_ResetResult(interp); @@ -4570,7 +4199,7 @@ Tcl_Canceled( if (flags & TCL_LEAVE_ERR_MSG) { const char *id, *message = NULL; - int length; + size_t length; /* * Setup errorCode variables so that we can differentiate between @@ -4578,7 +4207,7 @@ Tcl_Canceled( */ if (iPtr->asyncCancelMsg != NULL) { - message = TclGetStringFromObj(iPtr->asyncCancelMsg, &length); + message = Tcl_GetStringFromObj(iPtr->asyncCancelMsg, &length); } else { length = 0; } @@ -4677,8 +4306,8 @@ Tcl_CancelEval( */ if (resultObjPtr != NULL) { - result = TclGetStringFromObj(resultObjPtr, &cancelInfo->length); - cancelInfo->result = (char *)ckrealloc(cancelInfo->result,cancelInfo->length); + result = Tcl_GetStringFromObj(resultObjPtr, &cancelInfo->length); + cancelInfo->result = (char *)Tcl_Realloc(cancelInfo->result,cancelInfo->length); memcpy(cancelInfo->result, result, cancelInfo->length); TclDecrRefCount(resultObjPtr); /* Discard their result object. */ } else { @@ -4741,7 +4370,7 @@ int Tcl_EvalObjv( Tcl_Interp *interp, /* Interpreter in which to evaluate the * command. Also used for error reporting. */ - int objc, /* Number of words in command. */ + size_t 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 @@ -4760,7 +4389,7 @@ int TclNREvalObjv( Tcl_Interp *interp, /* Interpreter in which to evaluate the * command. Also used for error reporting. */ - int objc, /* Number of words in command. */ + size_t 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 @@ -5005,30 +4634,6 @@ TclNRRunCallbacks( /* All callbacks down to rootPtr not inclusive * are to be run. */ { -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 - Interp *iPtr = (Interp *) interp; -#endif /* !defined(TCL_NO_DEPRECATED) */ - - /* - * If the interpreter has a non-empty string result, the result object is - * either empty or stale because some function set interp->result - * directly. If so, move the string result to the result object, then - * reset the string result. - * - * This only needs to be done for the first item in the list: all other - * are for NR function calls, and those are Tcl_Obj based. - */ - -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 - if (*(iPtr->result) != 0) { - (void) Tcl_GetObjResult(interp); - } -#endif /* !defined(TCL_NO_DEPRECATED) */ - - /* - * This is the trampoline. - */ - while (TOP_CB(interp) != rootPtr) { NRE_callback *callbackPtr = TOP_CB(interp); Tcl_NRPostProc *procPtr = callbackPtr->procPtr; @@ -5192,7 +4797,7 @@ TEOV_Error( Interp *iPtr = (Interp *) interp; Tcl_Obj *listPtr; const char *cmdString; - int cmdLen; + size_t cmdLen; int objc = PTR2INT(data[0]); Tcl_Obj **objv = (Tcl_Obj **)data[1]; @@ -5204,7 +4809,7 @@ TEOV_Error( */ listPtr = Tcl_NewListObj(objc, objv); - cmdString = TclGetStringFromObj(listPtr, &cmdLen); + cmdString = Tcl_GetStringFromObj(listPtr, &cmdLen); Tcl_LogCommandInfo(interp, cmdString, cmdString, cmdLen); Tcl_DecrRefCount(listPtr); } @@ -5221,7 +4826,7 @@ TEOV_NotFound( { Command * cmdPtr; Interp *iPtr = (Interp *) interp; - int i, newObjc, handlerObjc; + size_t i, newObjc, handlerObjc; Tcl_Obj **newObjv, **handlerObjv; CallFrame *varFramePtr = iPtr->varFramePtr; Namespace *currNsPtr = NULL;/* Used to check for and invoke any registered @@ -5348,9 +4953,9 @@ TEOV_RunEnterTraces( { Interp *iPtr = (Interp *) interp; Command *cmdPtr = *cmdPtrPtr; - int length, newEpoch, cmdEpoch = cmdPtr->cmdEpoch; + size_t length, newEpoch, cmdEpoch = cmdPtr->cmdEpoch; int traceCode = TCL_OK; - const char *command = TclGetStringFromObj(commandPtr, &length); + const char *command = Tcl_GetStringFromObj(commandPtr, &length); /* * Call trace functions. @@ -5401,8 +5006,8 @@ TEOV_RunLeaveTraces( Tcl_Obj *commandPtr = (Tcl_Obj *)data[1]; Command *cmdPtr = (Command *)data[2]; Tcl_Obj **objv = (Tcl_Obj **)data[3]; - int length; - const char *command = TclGetStringFromObj(commandPtr, &length); + size_t length; + const char *command = Tcl_GetStringFromObj(commandPtr, &length); if (!(cmdPtr->flags & CMD_DYING)) { if (cmdPtr->flags & CMD_HAS_EXEC_TRACES) { @@ -5484,63 +5089,13 @@ Tcl_EvalTokensStandard( * errors. */ Tcl_Token *tokenPtr, /* Pointer to first in an array of tokens to * evaluate and concatenate. */ - int count) /* Number of tokens to consider at tokenPtr. + size_t count) /* Number of tokens to consider at tokenPtr. * Must be at least 1. */ { return TclSubstTokens(interp, tokenPtr, count, /* numLeftPtr */ NULL, 1, NULL, NULL); } -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 -/* - *---------------------------------------------------------------------- - * - * Tcl_EvalTokens -- - * - * Given an array of tokens parsed from a Tcl command (e.g., the tokens - * that make up a word or the index for an array variable) this function - * evaluates the tokens and concatenates their values to form a single - * result value. - * - * Results: - * The return value is a pointer to a newly allocated Tcl_Obj containing - * the value of the array of tokens. The reference count of the returned - * object has been incremented. If an error occurs in evaluating the - * tokens then a NULL value is returned and an error message is left in - * interp's result. - * - * Side effects: - * A new object is allocated to hold the result. - * - *---------------------------------------------------------------------- - * - * This uses a non-standard return convention; its use is now deprecated. It - * is a wrapper for the new function Tcl_EvalTokensStandard, and is not used - * in the core any longer. It is only kept for backward compatibility. - */ - -Tcl_Obj * -Tcl_EvalTokens( - Tcl_Interp *interp, /* Interpreter in which to lookup variables, - * execute nested commands, and report - * errors. */ - Tcl_Token *tokenPtr, /* Pointer to first in an array of tokens to - * evaluate and concatenate. */ - int count) /* Number of tokens to consider at tokenPtr. - * Must be at least 1. */ -{ - Tcl_Obj *resPtr; - - if (Tcl_EvalTokensStandard(interp, tokenPtr, count) != TCL_OK) { - return NULL; - } - resPtr = Tcl_GetObjResult(interp); - Tcl_IncrRefCount(resPtr); - Tcl_ResetResult(interp); - return resPtr; -} -#endif /* !TCL_NO_DEPRECATED */ - /* *---------------------------------------------------------------------- * @@ -5567,7 +5122,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. */ - int numBytes, /* Number of bytes in script. If < 0, the + size_t 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 @@ -5582,13 +5137,13 @@ 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. */ - int numBytes, /* Number of bytes in script. If < 0, the + size_t 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. */ - int line, /* The line the script starts on. */ + size_t 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 @@ -5614,7 +5169,7 @@ TclEvalEx( int *expand, *lines, *lineSpace; Tcl_Token *tokenPtr; int bytesLeft, expandRequested, code = TCL_OK; - int commandLength; + size_t commandLength; CallFrame *savedVarFramePtr;/* Saves old copy of iPtr->varFramePtr in case * TCL_EVAL_GLOBAL was set. */ int allowExceptions = (iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS); @@ -5648,7 +5203,7 @@ TclEvalEx( } } - if (numBytes < 0) { + if (numBytes == TCL_INDEX_NONE) { numBytes = strlen(script); } Tcl_ResetResult(interp); @@ -5754,7 +5309,7 @@ TclEvalEx( * per-command parsing. */ - int wordLine = line; + size_t wordLine = line; const char *wordStart = parsePtr->commandStart; int *wordCLNext = clNext; unsigned int objectsNeeded = 0; @@ -5765,9 +5320,9 @@ TclEvalEx( */ if (numWords > minObjs) { - expand = (int *)ckalloc(numWords * sizeof(int)); - objvSpace = (Tcl_Obj **)ckalloc(numWords * sizeof(Tcl_Obj *)); - lineSpace = (int *)ckalloc(numWords * sizeof(int)); + expand = (int *)Tcl_Alloc(numWords * sizeof(int)); + objvSpace = (Tcl_Obj **)Tcl_Alloc(numWords * sizeof(Tcl_Obj *)); + lineSpace = (int *)Tcl_Alloc(numWords * sizeof(int)); } expandRequested = 0; objv = objvSpace; @@ -5791,7 +5346,7 @@ TclEvalEx( wordStart = tokenPtr->start; lines[objectsUsed] = TclWordKnownAtCompileTime(tokenPtr, NULL) - ? wordLine : -1; + ? (int)wordLine : -1; if (eeFramePtr->type == TCL_LOCATION_SOURCE) { iPtr->evalFlags |= TCL_EVAL_FILE; @@ -5809,7 +5364,7 @@ TclEvalEx( objv[objectsUsed] = Tcl_GetObjResult(interp); Tcl_IncrRefCount(objv[objectsUsed]); if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) { - int numElements; + size_t numElements; code = TclListObjLengthM(interp, objv[objectsUsed], &numElements); @@ -5819,7 +5374,7 @@ TclEvalEx( */ Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( - "\n (expanding word %d)", objectsUsed)); + "\n (expanding word %" TCL_Z_MODIFIER "u)", objectsUsed)); Tcl_DecrRefCount(objv[objectsUsed]); break; } @@ -5853,14 +5408,14 @@ TclEvalEx( if ((numWords > minObjs) || (objectsNeeded > minObjs)) { objv = objvSpace = - (Tcl_Obj **)ckalloc(objectsNeeded * sizeof(Tcl_Obj *)); - lines = lineSpace = (int *)ckalloc(objectsNeeded * sizeof(int)); + (Tcl_Obj **)Tcl_Alloc(objectsNeeded * sizeof(Tcl_Obj *)); + lines = lineSpace = (int *)Tcl_Alloc(objectsNeeded * sizeof(int)); } objectsUsed = 0; while (wordIdx--) { if (expand[wordIdx]) { - int numElements; + size_t numElements; Tcl_Obj **elements, *temp = copy[wordIdx]; TclListObjGetElementsM(NULL, temp, &numElements, @@ -5881,10 +5436,10 @@ TclEvalEx( objv += objIdx+1; if (copy != stackObjArray) { - ckfree(copy); + Tcl_Free(copy); } if (lcopy != linesStack) { - ckfree(lcopy); + Tcl_Free(lcopy); } } @@ -5929,9 +5484,9 @@ TclEvalEx( } objectsUsed = 0; if (objvSpace != stackObjArray) { - ckfree(objvSpace); + Tcl_Free(objvSpace); objvSpace = stackObjArray; - ckfree(lineSpace); + Tcl_Free(lineSpace); lineSpace = linesStack; } @@ -5941,7 +5496,7 @@ TclEvalEx( */ if (expand != expandStack) { - ckfree(expand); + Tcl_Free(expand); expand = expandStack; } } @@ -6007,11 +5562,11 @@ TclEvalEx( Tcl_FreeParse(parsePtr); } if (objvSpace != stackObjArray) { - ckfree(objvSpace); - ckfree(lineSpace); + Tcl_Free(objvSpace); + Tcl_Free(lineSpace); } if (expand != expandStack) { - ckfree(expand); + Tcl_Free(expand); } iPtr->varFramePtr = savedVarFramePtr; @@ -6053,7 +5608,7 @@ TclEvalEx( void TclAdvanceLines( - int *line, + size_t *line, const char *start, const char *end) { @@ -6088,7 +5643,7 @@ TclAdvanceLines( void TclAdvanceContinuations( - int *line, + size_t *line, int **clNextPtrPtr, int loc) { @@ -6175,7 +5730,7 @@ TclArgumentEnter( * and initialize references. */ - cfwPtr = (CFWord *)ckalloc(sizeof(CFWord)); + cfwPtr = (CFWord *)Tcl_Alloc(sizeof(CFWord)); cfwPtr->framePtr = cfPtr; cfwPtr->word = i; cfwPtr->refCount = 1; @@ -6235,7 +5790,7 @@ TclArgumentRelease( continue; } - ckfree(cfwPtr); + Tcl_Free(cfwPtr); Tcl_DeleteHashEntry(hPtr); } } @@ -6268,7 +5823,7 @@ TclArgumentBCEnter( void *codePtr, CmdFrame *cfPtr, int cmd, - int pc) + size_t pc) { ExtCmdLoc *eclPtr; int word; @@ -6297,7 +5852,7 @@ TclArgumentBCEnter( * housekeeping, and can escape now. */ - if (ePtr->nline != objc) { + if (ePtr->nline != (size_t)objc) { return; } @@ -6317,7 +5872,7 @@ TclArgumentBCEnter( int isNew; Tcl_HashEntry *hPtr = Tcl_CreateHashEntry(iPtr->lineLABCPtr, objv[word], &isNew); - CFWordBC *cfwPtr = (CFWordBC *)ckalloc(sizeof(CFWordBC)); + CFWordBC *cfwPtr = (CFWordBC *)Tcl_Alloc(sizeof(CFWordBC)); cfwPtr->framePtr = cfPtr; cfwPtr->obj = objv[word]; @@ -6395,7 +5950,7 @@ TclArgumentBCRelease( Tcl_DeleteHashEntry(hPtr); } - ckfree(cfwPtr); + Tcl_Free(cfwPtr); cfwPtr = nextPtr; } @@ -6477,83 +6032,6 @@ TclArgumentGet( /* *---------------------------------------------------------------------- * - * Tcl_Eval -- - * - * Execute a Tcl command in a string. This function executes the script - * directly, rather than compiling it to bytecodes. Before the arrival of - * the bytecode compiler in Tcl 8.0 Tcl_Eval was the main function used - * for executing Tcl commands, but nowadays it isn't used much. - * - * Results: - * The return value is one of the return codes defined in tcl.h (such as - * TCL_OK), and interp's result contains a value to supplement the return - * code. The value of the result will persist only until the next call to - * Tcl_Eval or Tcl_EvalObj: you must copy it or lose it! - * - * Side effects: - * Can be almost arbitrary, depending on the commands in the script. - * - *---------------------------------------------------------------------- - */ - -#ifndef TCL_NO_DEPRECATED -#undef Tcl_Eval -int -Tcl_Eval( - Tcl_Interp *interp, /* Token for command interpreter (returned by - * previous call to Tcl_CreateInterp). */ - const char *script) /* Pointer to TCL command to execute. */ -{ - int code = Tcl_EvalEx(interp, script, TCL_INDEX_NONE, 0); - - /* - * For backwards compatibility with old C code that predates the object - * system in Tcl 8.0, we have to mirror the object result back into the - * string result (some callers may expect it there). - */ - - (void) Tcl_GetStringResult(interp); - return code; -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_EvalObj, Tcl_GlobalEvalObj -- - * - * These functions are deprecated but we keep them around for backwards - * compatibility reasons. - * - * Results: - * See the functions they call. - * - * Side effects: - * See the functions they call. - * - *---------------------------------------------------------------------- - */ - -#undef Tcl_EvalObj -int -Tcl_EvalObj( - Tcl_Interp *interp, - Tcl_Obj *objPtr) -{ - return Tcl_EvalObjEx(interp, objPtr, 0); -} -#undef Tcl_GlobalEvalObj -int -Tcl_GlobalEvalObj( - Tcl_Interp *interp, - Tcl_Obj *objPtr) -{ - return Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL); -} -#endif /* TCL_NO_DEPRECATED */ - -/* - *---------------------------------------------------------------------- - * * Tcl_EvalObjEx, TclEvalObjEx -- * * Execute Tcl commands stored in a Tcl object. These commands are @@ -6634,7 +6112,7 @@ TclNREvalObjEx( if (TclListObjIsCanonical(objPtr)) { CmdFrame *eoFramePtr = NULL; - int objc; + size_t objc; Tcl_Obj *listPtr, **objv; /* @@ -6744,7 +6222,7 @@ TclNREvalObjEx( */ const char *script; - int numSrcBytes; + size_t numSrcBytes; /* * Now we check if we have data about invisible continuation lines for @@ -6771,7 +6249,7 @@ TclNREvalObjEx( Tcl_IncrRefCount(objPtr); - script = TclGetStringFromObj(objPtr, &numSrcBytes); + script = Tcl_GetStringFromObj(objPtr, &numSrcBytes); result = Tcl_EvalEx(interp, script, numSrcBytes, flags); TclDecrRefCount(objPtr); @@ -6798,11 +6276,11 @@ TEOEx_ByteCodeCallback( } if ((result != TCL_OK) && (result != TCL_ERROR) && !allowExceptions) { const char *script; - int numSrcBytes; + size_t numSrcBytes; ProcessUnexpectedResult(interp, result); result = TCL_ERROR; - script = TclGetStringFromObj(objPtr, &numSrcBytes); + script = Tcl_GetStringFromObj(objPtr, &numSrcBytes); Tcl_LogCommandInfo(interp, script, script, numSrcBytes); } @@ -6936,9 +6414,6 @@ Tcl_ExprLong( Tcl_IncrRefCount(exprPtr); result = Tcl_ExprLongObj(interp, exprPtr, ptr); Tcl_DecrRefCount(exprPtr); - if (result != TCL_OK) { - (void) Tcl_GetStringResult(interp); - } } return result; } @@ -6965,9 +6440,6 @@ Tcl_ExprDouble( result = Tcl_ExprDoubleObj(interp, exprPtr, ptr); Tcl_DecrRefCount(exprPtr); /* Discard the expression object. */ - if (result != TCL_OK) { - (void) Tcl_GetStringResult(interp); - } } return result; } @@ -6993,14 +6465,6 @@ Tcl_ExprBoolean( Tcl_IncrRefCount(exprPtr); result = Tcl_ExprBooleanObj(interp, exprPtr, ptr); Tcl_DecrRefCount(exprPtr); - if (result != TCL_OK) { - /* - * Move the interpreter's object result to the string result, then - * reset the object result. - */ - - (void) Tcl_GetStringResult(interp); - } return result; } } @@ -7318,12 +6782,6 @@ Tcl_ExprString( Tcl_DecrRefCount(resultPtr); } } - - /* - * Force the string rep of the interp result. - */ - - (void) Tcl_GetStringResult(interp); return code; } @@ -7346,83 +6804,17 @@ Tcl_ExprString( *---------------------------------------------------------------------- */ -#undef Tcl_AddObjErrorInfo void Tcl_AppendObjToErrorInfo( Tcl_Interp *interp, /* Interpreter to which error information * pertains. */ Tcl_Obj *objPtr) /* Message to record. */ { - int length; - const char *message = TclGetStringFromObj(objPtr, &length); + size_t length; + const char *message = Tcl_GetStringFromObj(objPtr, &length); + Interp *iPtr = (Interp *) interp; Tcl_IncrRefCount(objPtr); - Tcl_AddObjErrorInfo(interp, message, length); - Tcl_DecrRefCount(objPtr); -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_AddErrorInfo -- - * - * Add information to the errorInfo field that describes the current - * error. - * - * Results: - * None. - * - * Side effects: - * The contents of message are appended to the errorInfo field. If we are - * just starting to log an error, errorInfo is initialized from the error - * message in the interpreter's result. - * - *---------------------------------------------------------------------- - */ - -#ifndef TCL_NO_DEPRECATED -#undef Tcl_AddErrorInfo -void -Tcl_AddErrorInfo( - Tcl_Interp *interp, /* Interpreter to which error information - * pertains. */ - const char *message) /* Message to record. */ -{ - Tcl_AddObjErrorInfo(interp, message, -1); -} -#endif /* TCL_NO_DEPRECATED */ - -/* - *---------------------------------------------------------------------- - * - * Tcl_AddObjErrorInfo -- - * - * Add information to the errorInfo field that describes the current - * error. This routine differs from Tcl_AddErrorInfo by taking a byte - * pointer and length. - * - * Results: - * None. - * - * Side effects: - * "length" bytes from "message" are appended to the errorInfo field. If - * "length" is negative, use bytes up to the first NULL byte. If we are - * just starting to log an error, errorInfo is initialized from the error - * message in the interpreter's result. - * - *---------------------------------------------------------------------- - */ - -void -Tcl_AddObjErrorInfo( - Tcl_Interp *interp, /* Interpreter to which error information - * pertains. */ - const char *message, /* Points to the first byte of an array of - * bytes of the message. */ - int length) /* The number of bytes in the message. If < 0, - * then append all bytes up to a NULL byte. */ -{ - Interp *iPtr = (Interp *) interp; /* * If we are just starting to log an error, errorInfo is initialized from @@ -7431,20 +6823,7 @@ Tcl_AddObjErrorInfo( iPtr->flags |= ERR_LEGACY_COPY; if (iPtr->errorInfo == NULL) { -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 - if (*(iPtr->result) != 0) { - /* - * The interp's string result is set, apparently by some extension - * making a deprecated direct write to it. That extension may - * expect interp->result to continue to be set, so we'll take - * special pains to avoid clearing it, until we drop support for - * interp->result completely. - */ - - iPtr->errorInfo = Tcl_NewStringObj(iPtr->result, -1); - } else -#endif /* !defined(TCL_NO_DEPRECATED) */ - iPtr->errorInfo = iPtr->objResultPtr; + iPtr->errorInfo = iPtr->objResultPtr; Tcl_IncrRefCount(iPtr->errorInfo); if (!iPtr->errorCode) { Tcl_SetErrorCode(interp, "NONE", NULL); @@ -7463,12 +6842,13 @@ Tcl_AddObjErrorInfo( } Tcl_AppendToObj(iPtr->errorInfo, message, length); } + Tcl_DecrRefCount(objPtr); } /* *---------------------------------------------------------------------- * - * Tcl_VarEvalVA -- + * Tcl_VarEval -- * * Given a variable number of string arguments, concatenate them all * together and execute the result as a Tcl command. @@ -7484,18 +6864,20 @@ Tcl_AddObjErrorInfo( */ int -Tcl_VarEvalVA( - Tcl_Interp *interp, /* Interpreter in which to evaluate command */ - va_list argList) /* Variable argument list. */ +Tcl_VarEval( + Tcl_Interp *interp, + ...) { + va_list argList; + int result; Tcl_DString buf; char *string; - int result; + va_start(argList, interp); /* * Copy the strings one after the other into a single larger string. Use * stack-allocated space for small commands, but if the command gets too - * large than call ckalloc to create the space. + * large than call Tcl_Alloc to create the space. */ Tcl_DStringInit(&buf); @@ -7515,78 +6897,6 @@ Tcl_VarEvalVA( /* *---------------------------------------------------------------------- * - * Tcl_VarEval -- - * - * Given a variable number of string arguments, concatenate them all - * together and execute the result as a Tcl command. - * - * Results: - * A standard Tcl return result. An error message or other result may be - * left in interp->result. - * - * Side effects: - * Depends on what was done by the command. - * - *---------------------------------------------------------------------- - */ - -int -Tcl_VarEval( - Tcl_Interp *interp, - ...) -{ - va_list argList; - int result; - - va_start(argList, interp); - result = Tcl_VarEvalVA(interp, argList); - va_end(argList); - - return result; -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_GlobalEval -- - * - * Evaluate a command at global level in an interpreter. - * - * Results: - * A standard Tcl result is returned, and the interp's result is modified - * accordingly. - * - * Side effects: - * The command string is executed in interp, and the execution is carried - * out in the variable context of global level (no functions active), - * just as if an "uplevel #0" command were being executed. - * - *---------------------------------------------------------------------- - */ - -#ifndef TCL_NO_DEPRECATED -#undef Tcl_GlobalEval -int -Tcl_GlobalEval( - Tcl_Interp *interp, /* Interpreter in which to evaluate - * command. */ - const char *command) /* Command to evaluate. */ -{ - Interp *iPtr = (Interp *) interp; - int result; - CallFrame *savedVarFramePtr; - - savedVarFramePtr = iPtr->varFramePtr; - iPtr->varFramePtr = iPtr->rootFramePtr; - result = Tcl_EvalEx(interp, command, -1, 0); - iPtr->varFramePtr = savedVarFramePtr; - return result; -} -#endif /* TCL_NO_DEPRECATED */ - -/* - *---------------------------------------------------------------------- - * * Tcl_SetRecursionLimit -- * * Set the maximum number of recursive calls that may be active for an @@ -7601,17 +6911,17 @@ Tcl_GlobalEval( *---------------------------------------------------------------------- */ -int +size_t Tcl_SetRecursionLimit( Tcl_Interp *interp, /* Interpreter whose nesting limit is to be * set. */ - int depth) /* New value for maximimum depth. */ + size_t depth) /* New value for maximimum depth. */ { Interp *iPtr = (Interp *) interp; - int old; + size_t old; old = iPtr->maxNestingDepth; - if (depth > 0) { + if (depth + 1 > 1) { iPtr->maxNestingDepth = depth; } return old; @@ -8084,8 +7394,8 @@ ExprAbsFunc( goto unChanged; } else if (l == 0) { if (TclHasStringRep(objv[1])) { - int numBytes; - const char *bytes = TclGetStringFromObj(objv[1], &numBytes); + size_t numBytes; + const char *bytes = Tcl_GetStringFromObj(objv[1], &numBytes); while (numBytes) { if (*bytes == '-') { @@ -9164,7 +8474,7 @@ Tcl_NRCallObjProc( Tcl_Interp *interp, Tcl_ObjCmdProc *objProc, void *clientData, - int objc, + size_t objc, Tcl_Obj *const objv[]) { NRE_callback *rootPtr = TOP_CB(interp); @@ -9183,8 +8493,11 @@ int wrapperNRObjProc( CmdWrapperInfo *info = (CmdWrapperInfo *)clientData; clientData = info->clientData; Tcl_ObjCmdProc2 *proc = info->proc; - ckfree(info); - return proc(clientData, interp, objc, objv); + Tcl_Free(info); + if (objc < 0) { + objc = -1; + } + return proc(clientData, interp, (size_t)objc, objv); } int @@ -9201,7 +8514,7 @@ Tcl_NRCallObjProc2( } NRE_callback *rootPtr = TOP_CB(interp); - CmdWrapperInfo *info = (CmdWrapperInfo *)ckalloc(sizeof(CmdWrapperInfo)); + CmdWrapperInfo *info = (CmdWrapperInfo *)Tcl_Alloc(sizeof(CmdWrapperInfo)); info->clientData = clientData; info->proc = objProc; @@ -9248,7 +8561,7 @@ static int cmdWrapperNreProc( if (objc < 0) { objc = -1; } - return info->nreProc(info->clientData, interp, objc, objv); + return info->nreProc(info->clientData, interp, (size_t)objc, objv); } Tcl_Command @@ -9270,7 +8583,7 @@ Tcl_NRCreateCommand2( /* If not NULL, gives a function to call when * this command is deleted. */ { - CmdWrapperInfo *info = (CmdWrapperInfo *)ckalloc(sizeof(CmdWrapperInfo)); + CmdWrapperInfo *info = (CmdWrapperInfo *)Tcl_Alloc(sizeof(CmdWrapperInfo)); info->proc = proc; info->clientData = clientData; info->nreProc = nreProc; @@ -9344,7 +8657,7 @@ int Tcl_NREvalObjv( Tcl_Interp *interp, /* Interpreter in which to evaluate the * command. Also used for error reporting. */ - int objc, /* Number of words in command. */ + size_t 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 @@ -9359,7 +8672,7 @@ int Tcl_NRCmdSwap( Tcl_Interp *interp, Tcl_Command cmd, - int objc, + size_t objc, Tcl_Obj *const objv[], int flags) { @@ -9551,7 +8864,7 @@ TclNRTailcallEval( Interp *iPtr = (Interp *) interp; Tcl_Obj *listPtr = (Tcl_Obj *)data[0], *nsObjPtr; Tcl_Namespace *nsPtr; - int objc; + size_t objc; Tcl_Obj **objv; TclListObjGetElementsM(interp, listPtr, &objc, &objv); @@ -9788,7 +9101,7 @@ NRCoroutineCallerCallback( NRE_ASSERT(iPtr->varFramePtr == corPtr->caller.varFramePtr); NRE_ASSERT(iPtr->framePtr == corPtr->caller.framePtr); NRE_ASSERT(iPtr->cmdFramePtr == corPtr->caller.cmdFramePtr); - ckfree(corPtr); + Tcl_Free(corPtr); return result; } @@ -9847,7 +9160,7 @@ NRCoroutineExitCallback( */ Tcl_DeleteHashTable(corPtr->lineLABCPtr); - ckfree(corPtr->lineLABCPtr); + Tcl_Free(corPtr->lineLABCPtr); corPtr->lineLABCPtr = NULL; RESTORE_CONTEXT(corPtr->caller); @@ -9898,7 +9211,7 @@ TclNRCoroutineActivateCallback( */ corPtr->stackLevel = &corPtr; - int numLevels = corPtr->auxNumLevels; + size_t numLevels = corPtr->auxNumLevels; corPtr->auxNumLevels = iPtr->numLevels; SAVE_CONTEXT(corPtr->caller); @@ -9947,7 +9260,7 @@ TclNRCoroutineActivateCallback( corPtr->yieldPtr = NULL; corPtr->stackLevel = NULL; - int numLevels = iPtr->numLevels; + size_t numLevels = iPtr->numLevels; iPtr->numLevels = corPtr->auxNumLevels; corPtr->auxNumLevels = numLevels - corPtr->auxNumLevels; @@ -9974,7 +9287,7 @@ TclNREvalList( Tcl_Interp *interp, TCL_UNUSED(int) /*result*/) { - int objc; + size_t objc; Tcl_Obj **objv; Tcl_Obj *listPtr = (Tcl_Obj *)data[0]; @@ -10190,7 +9503,7 @@ TclNRCoroProbeObjCmd( */ corPtr->stackLevel = &corPtr; - int numLevels = corPtr->auxNumLevels; + size_t numLevels = corPtr->auxNumLevels; corPtr->auxNumLevels = iPtr->numLevels; /* @@ -10234,9 +9547,9 @@ InjectHandler( { CoroutineData *corPtr = (CoroutineData *)data[0]; Tcl_Obj *listPtr = (Tcl_Obj *)data[1]; - int nargs = PTR2INT(data[2]); + size_t nargs = PTR2INT(data[2]); void *isProbe = data[3]; - int objc; + size_t objc; Tcl_Obj **objv; if (!isProbe) { @@ -10255,7 +9568,7 @@ InjectHandler( * I don't think this is reachable... */ - Tcl_ListObjAppendElement(NULL, listPtr, Tcl_NewWideIntObj(nargs)); + Tcl_ListObjAppendElement(NULL, listPtr, Tcl_NewWideIntObj((Tcl_WideInt)(nargs + 1U) - 1)); } Tcl_ListObjAppendElement(NULL, listPtr, Tcl_GetObjResult(interp)); } @@ -10280,7 +9593,7 @@ InjectHandlerPostCall( { CoroutineData *corPtr = (CoroutineData *)data[0]; Tcl_Obj *listPtr = (Tcl_Obj *)data[1]; - int nargs = PTR2INT(data[2]); + size_t nargs = PTR2INT(data[2]); void *isProbe = data[3]; /* @@ -10303,7 +9616,7 @@ InjectHandlerPostCall( } corPtr->nargs = nargs; corPtr->stackLevel = NULL; - int numLevels = iPtr->numLevels; + size_t numLevels = iPtr->numLevels; iPtr->numLevels = corPtr->auxNumLevels; corPtr->auxNumLevels = numLevels - corPtr->auxNumLevels; iPtr->execEnvPtr = corPtr->callerEEPtr; @@ -10399,7 +9712,7 @@ TclNRInterpCoroutine( } break; default: - if (corPtr->nargs + 1 != objc) { + if (corPtr->nargs + 1 != (size_t)objc) { Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong coro nargs; how did we get here? " "not implemented!", -1)); @@ -10473,7 +9786,7 @@ TclNRCoroutineObjCmd( * struct and create the corresponding command. */ - corPtr = (CoroutineData *)ckalloc(sizeof(CoroutineData)); + corPtr = (CoroutineData *)Tcl_Alloc(sizeof(CoroutineData)); cmdPtr = (Command *) TclNRCreateCommandInNs(interp, simpleName, (Tcl_Namespace *)nsPtr, /*objProc*/ NULL, TclNRInterpCoroutine, @@ -10495,7 +9808,7 @@ TclNRCoroutineObjCmd( Tcl_HashSearch hSearch; Tcl_HashEntry *hePtr; - corPtr->lineLABCPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable)); + corPtr->lineLABCPtr = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(corPtr->lineLABCPtr, TCL_ONE_WORD_KEYS); for (hePtr = Tcl_FirstHashEntry(iPtr->lineLABCPtr,&hSearch); diff --git a/generic/tclBinary.c b/generic/tclBinary.c index e4c8766..28cf31d 100644 --- a/generic/tclBinary.c +++ b/generic/tclBinary.c @@ -2,7 +2,7 @@ * tclBinary.c -- * * This file contains the implementation of the "binary" Tcl built-in - * command and the Tcl value internal representation for binary data. + * command and the Tcl binary data object. * * Copyright © 1997 Sun Microsystems, Inc. * Copyright © 1998-1999 Scriptics Corporation. @@ -22,8 +22,8 @@ * special conditions in the parsing of a format specifier. */ -#define BINARY_ALL -1 /* Use all elements in the argument. */ -#define BINARY_NOCOUNT -2 /* No count was specified in format. */ +#define BINARY_ALL ((size_t)-1) /* Use all elements in the argument. */ +#define BINARY_NOCOUNT ((size_t)-2) /* No count was specified in format. */ /* * The following flags may be ORed together and returned by GetFormatSpec @@ -55,25 +55,22 @@ * Prototypes for local procedures defined in this file: */ -static void DupByteArrayInternalRep(Tcl_Obj *srcPtr, - Tcl_Obj *copyPtr); static void DupProperByteArrayInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); static int FormatNumber(Tcl_Interp *interp, int type, Tcl_Obj *src, unsigned char **cursorPtr); -static void FreeByteArrayInternalRep(Tcl_Obj *objPtr); static void FreeProperByteArrayInternalRep(Tcl_Obj *objPtr); static int GetFormatSpec(const char **formatPtr, char *cmdPtr, - int *countPtr, int *flagsPtr); + size_t *countPtr, int *flagsPtr); static Tcl_Obj * ScanNumber(unsigned char *buffer, int type, int flags, Tcl_HashTable **numberCachePtr); -static int SetByteArrayFromAny(Tcl_Interp *interp, +static int SetByteArrayFromAny(Tcl_Interp *interp, size_t limit, Tcl_Obj *objPtr); static void UpdateStringOfByteArray(Tcl_Obj *listPtr); static void DeleteScanNumberCache(Tcl_HashTable *numberCachePtr); static int NeedReversing(int format); static void CopyNumber(const void *from, void *to, - unsigned int length, int type); + size_t length, int type); /* Binary ensemble commands */ static Tcl_ObjCmdProc BinaryFormatCmd; static Tcl_ObjCmdProc BinaryScanCmd; @@ -143,14 +140,11 @@ static const EnsembleImplMap decodeMap[] = { }; /* - * The following object types represent an array of bytes. The intent is to + * The following Tcl_ObjType represents an array of bytes. The intent is to * allow arbitrary binary data to pass through Tcl as a Tcl value without loss * or damage. Such values are useful for things like encoded strings or Tk * images to name just two. * - * It's strange to have two Tcl_ObjTypes in place for this task when one would - * do, so a bit of detail and history will aid understanding. - * * A bytearray is an ordered sequence of bytes. Each byte is an integer value * in the range [0-255]. To be a Tcl value type, we need a way to encode each * value in the value set as a Tcl string. A simple encoding is to @@ -158,50 +152,9 @@ static const EnsembleImplMap decodeMap[] = { * bytes is encoded into a Tcl string of N characters where the codepoint of * each character is the value of corresponding byte. This approach creates a * one-to-one map between all bytearray values and a subset of Tcl string - * values. - * - * When converting a Tcl string value to the bytearray internal rep, the - * question arises what to do with strings outside that subset? That is, - * those Tcl strings containing at least one codepoint greater than 255? The - * obviously correct answer is to raise an error! That string value does not - * represent any valid bytearray value. - * - * Unfortunately this was not the path taken by the authors of the original - * tclByteArrayType. They chose to accept all Tcl string values as acceptable - * string encodings of the bytearray values that result from masking away the - * high bits of any codepoint value at all. This meant that every bytearray - * value had multiple accepted string representations. - * - * The implications of this choice are truly ugly, and motivated the proposal - * of TIP 568 to migrate away from it and to the more sensible design where - * each bytearray value has only one string representation. Full details are - * recorded in that TIP for those who seek them. - * - * The Tcl_ObjType "properByteArrayType" is (nearly) a correct implementation - * of bytearrays. Any Tcl value with the type properByteArrayType can have - * its bytearray value fetched and used with confidence that acting on that - * value is equivalent to acting on the true Tcl string value. This still - * implies a side testing burden -- past mistakes will not let us avoid that - * immediately, but it is at least a conventional test of type, and can be - * implemented entirely by examining the objPtr fields, with no need to query - * the internalrep, as a canonical flag would require. This benefit is made - * available to extensions through the public routine Tcl_GetBytesFromObj(), - * first available in Tcl 8.7. - * - * The public routines Tcl_GetByteArrayFromObj() and Tcl_SetByteArrayLength() - * must continue to follow their documented behavior through the 8.* series of - * releases. To support that legacy operation, we need a mechanism to retain - * compatibility with the deployed callers of the broken interface. That's - * what the retained "tclByteArrayType" provides. In those unusual - * circumstances where we convert an invalid bytearray value to a bytearray - * type, it is to this legacy type. Essentially any time this legacy type - * shows up, it's a signal of a bug being ignored. - * - * In Tcl 9, the incompatibility in the behavior of these public routines - * has been approved, and the legacy internal rep is no longer retained. - * The internal changes seen below are the limit of what can be done - * in a Tcl 8.* release. They provide a great expansion of the histories - * over which bytearray values can be useful. + * values. Tcl string values outside that subset do no represent any valid + * bytearray value. Attempts to treat those values as bytearrays will lead + * to errors. See TIP 568 for how this differs from Tcl 8. */ static const Tcl_ObjType properByteArrayType = { @@ -209,15 +162,8 @@ static const Tcl_ObjType properByteArrayType = { FreeProperByteArrayInternalRep, DupProperByteArrayInternalRep, UpdateStringOfByteArray, - NULL -}; - -const Tcl_ObjType tclByteArrayType = { - "bytearray", - FreeByteArrayInternalRep, - DupByteArrayInternalRep, NULL, - SetByteArrayFromAny + TCL_OBJTYPE_V0 }; /* @@ -227,26 +173,24 @@ const Tcl_ObjType tclByteArrayType = { * fewer mallocs. */ -typedef struct ByteArray { - unsigned int bad; /* Index of first character that is a nonbyte. - * If all characters are bytes, bad = used. */ - unsigned int used; /* The number of bytes used in the byte - * array. Must be <= allocated. The bytes - * used to store the value are indexed from - * 0 to used-1. */ - unsigned int allocated; /* The number of bytes of space allocated. */ - unsigned char bytes[TCLFLEXARRAY]; - /* The array of bytes. The actual size of this - * field is stored in the 'allocated' field +typedef struct { + size_t used; /* The number of bytes used in the byte + * array. */ + size_t 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_SIZE(len) \ - (offsetof(ByteArray, bytes) + (len)) + ( (offsetof(ByteArray, bytes) + (len) < offsetof(ByteArray, bytes)) \ + ? (Tcl_Panic("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) \ - (irPtr)->twoPtrValue.ptr1 = (void *) (baPtr) - + (irPtr)->twoPtrValue.ptr1 = (baPtr) + int TclIsPureByteArray( Tcl_Obj * objPtr) @@ -263,7 +207,7 @@ TclIsPureByteArray( * from the given array of bytes. * * Results: - * The newly created object is returned. This object has no initial + * The newly create object is returned. This object will have no initial * string representation. The returned object has a ref count of 0. * * Side effects: @@ -278,8 +222,7 @@ Tcl_Obj * Tcl_NewByteArrayObj( const unsigned char *bytes, /* The array of bytes used to initialize the * new object. */ - int numBytes) /* Number of bytes in the array, - * must be >= 0. */ + size_t numBytes) /* Number of bytes in the array */ { #ifdef TCL_MEM_DEBUG return Tcl_DbNewByteArrayObj(bytes, numBytes, "unknown", 0); @@ -322,8 +265,7 @@ Tcl_Obj * Tcl_DbNewByteArrayObj( const unsigned char *bytes, /* The array of bytes used to initialize the * new object. */ - int numBytes, /* Number of bytes in the array, - * must be >= 0. */ + size_t 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 @@ -340,8 +282,7 @@ Tcl_Obj * Tcl_DbNewByteArrayObj( const unsigned char *bytes, /* The array of bytes used to initialize the * new object. */ - int numBytes, /* Number of bytes in the array, - * must be >= 0. */ + size_t numBytes, /* Number of bytes in the array */ TCL_UNUSED(const char *) /*file*/, TCL_UNUSED(int) /*line*/) { @@ -372,8 +313,7 @@ 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. */ - int numBytes) /* Number of bytes in the array, - * must be >= 0. */ + size_t numBytes) /* Number of bytes in the array */ { ByteArray *byteArrayPtr; Tcl_ObjInternalRep ir; @@ -383,9 +323,7 @@ Tcl_SetByteArrayObj( } TclInvalidateStringRep(objPtr); - assert(numBytes >= 0); - byteArrayPtr = (ByteArray *)ckalloc(BYTEARRAY_SIZE(numBytes)); - byteArrayPtr->bad = numBytes; + byteArrayPtr = (ByteArray *)Tcl_Alloc(BYTEARRAY_SIZE(numBytes)); byteArrayPtr->used = numBytes; byteArrayPtr->allocated = numBytes; @@ -400,7 +338,7 @@ Tcl_SetByteArrayObj( /* *---------------------------------------------------------------------- * - * Tcl_GetBytesFromObj/TclGetBytesFromObj -- + * TclGetBytesFromObj -- * * Attempt to extract the value from objPtr in the representation * of a byte sequence. On success return the extracted byte sequence. @@ -414,44 +352,6 @@ Tcl_SetByteArrayObj( *---------------------------------------------------------------------- */ -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 - * in the array here */ -{ - ByteArray *baPtr; - const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objPtr, &properByteArrayType); - - if (irPtr == NULL) { - SetByteArrayFromAny(NULL, objPtr); - irPtr = TclFetchInternalRep(objPtr, &properByteArrayType); - if (irPtr == NULL) { - if (interp) { - const char *nonbyte; - int ucs4; - - irPtr = TclFetchInternalRep(objPtr, &tclByteArrayType); - baPtr = GET_BYTEARRAY(irPtr); - nonbyte = TclUtfAtIndex(Tcl_GetString(objPtr), baPtr->bad); - TclUtfToUCS4(nonbyte, &ucs4); - - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "expected byte sequence but character %d " - "was '%1s' (U+%06X)", baPtr->bad, nonbyte, ucs4)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "BYTES", NULL); - } - return NULL; - } - } - baPtr = GET_BYTEARRAY(irPtr); - - if (numBytesPtr != NULL) { - *numBytesPtr = baPtr->used; - } - return baPtr->bytes; -} #undef Tcl_GetBytesFromObj unsigned char * Tcl_GetBytesFromObj( @@ -461,28 +361,14 @@ Tcl_GetBytesFromObj( * in the array here */ { ByteArray *baPtr; - const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objPtr, &properByteArrayType); + const Tcl_ObjInternalRep *irPtr + = TclFetchInternalRep(objPtr, &properByteArrayType); if (irPtr == NULL) { - SetByteArrayFromAny(NULL, objPtr); - irPtr = TclFetchInternalRep(objPtr, &properByteArrayType); - if (irPtr == NULL) { - if (interp) { - const char *nonbyte; - int ucs4; - - irPtr = TclFetchInternalRep(objPtr, &tclByteArrayType); - baPtr = GET_BYTEARRAY(irPtr); - nonbyte = TclUtfAtIndex(Tcl_GetString(objPtr), baPtr->bad); - TclUtfToUCS4(nonbyte, &ucs4); - - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "expected byte sequence but character %d " - "was '%1s' (U+%06X)", baPtr->bad, nonbyte, ucs4)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "BYTES", NULL); - } + if (TCL_ERROR == SetByteArrayFromAny(interp, TCL_INDEX_NONE, objPtr)) { return NULL; } + irPtr = TclFetchInternalRep(objPtr, &properByteArrayType); } baPtr = GET_BYTEARRAY(irPtr); @@ -491,75 +377,33 @@ Tcl_GetBytesFromObj( } return baPtr->bytes; } - -/* - *---------------------------------------------------------------------- - * - * Tcl_GetByteArrayFromObj/TclGetByteArrayFromObj -- - * - * Attempt to get the array of bytes from the Tcl object. If the object - * is not already a ByteArray object, an attempt will be made to convert - * it to one. - * - * Results: - * Pointer to array of bytes representing the ByteArray object. - * - * Side effects: - * Frees old internal rep. Allocates memory for new internal rep. - * - *---------------------------------------------------------------------- - */ -#undef Tcl_GetByteArrayFromObj unsigned char * -Tcl_GetByteArrayFromObj( - Tcl_Obj *objPtr, /* The ByteArray object. */ +TclGetBytesFromObj( + Tcl_Interp *interp, /* For error reporting */ + Tcl_Obj *objPtr, /* Value to extract from */ int *numBytesPtr) /* If non-NULL, write the number of bytes * in the array here */ { - ByteArray *baPtr; - const Tcl_ObjInternalRep *irPtr; - unsigned char *result = TclGetBytesFromObj(NULL, objPtr, numBytesPtr); - - if (result) { - return result; - } - - irPtr = TclFetchInternalRep(objPtr, &tclByteArrayType); - assert(irPtr != NULL); - - baPtr = GET_BYTEARRAY(irPtr); - - if (numBytesPtr != NULL) { - *numBytesPtr = baPtr->used; - } - return (unsigned char *) baPtr->bytes; -} - -unsigned char * -TclGetByteArrayFromObj( - Tcl_Obj *objPtr, /* The ByteArray object. */ - size_t *numBytesPtr) /* If non-NULL, write the number of bytes - * in the array here */ -{ - ByteArray *baPtr; - const Tcl_ObjInternalRep *irPtr; - unsigned char *result = Tcl_GetBytesFromObj(NULL, objPtr, numBytesPtr); + size_t numBytes = 0; + unsigned char *bytes = Tcl_GetBytesFromObj(interp, objPtr, &numBytes); - if (result) { - return result; - } - - irPtr = TclFetchInternalRep(objPtr, &tclByteArrayType); - assert(irPtr != NULL); - - baPtr = GET_BYTEARRAY(irPtr); + if (bytes && numBytesPtr) { + if (numBytes > INT_MAX) { + /* Caller asked for numBytes to be written to an int, but the + * value is outside the int range. */ - if (numBytesPtr != NULL) { - /* Make sure we return a value between 0 and UINT_MAX-1, or (size_t)-1 */ - *numBytesPtr = ((size_t)(unsigned int)(baPtr->used + 1)) - 1; + if (interp) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "byte sequence length exceeds INT_MAX", -1)); + Tcl_SetErrorCode(interp, "TCL", "API", "OUTDATED", NULL); + } + return NULL; + } else { + *numBytesPtr = (int) numBytes; + } } - return baPtr->bytes; + return bytes; } /* @@ -587,110 +431,156 @@ TclGetByteArrayFromObj( unsigned char * Tcl_SetByteArrayLength( Tcl_Obj *objPtr, /* The ByteArray object. */ - int numBytes) /* Number of bytes in resized array */ + size_t numBytes) /* Number of bytes in resized array */ { ByteArray *byteArrayPtr; - unsigned newLength; Tcl_ObjInternalRep *irPtr; - assert(numBytes >= 0); - newLength = (unsigned int)numBytes; - if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayLength"); } irPtr = TclFetchInternalRep(objPtr, &properByteArrayType); if (irPtr == NULL) { - irPtr = TclFetchInternalRep(objPtr, &tclByteArrayType); - if (irPtr == NULL) { - SetByteArrayFromAny(NULL, objPtr); - irPtr = TclFetchInternalRep(objPtr, &properByteArrayType); - if (irPtr == NULL) { - irPtr = TclFetchInternalRep(objPtr, &tclByteArrayType); - } + if (TCL_ERROR == SetByteArrayFromAny(NULL, numBytes, objPtr)) { + return NULL; } + irPtr = TclFetchInternalRep(objPtr, &properByteArrayType); } - /* Note that during truncation, the implementation does not free - * memory that is no longer needed. */ - byteArrayPtr = GET_BYTEARRAY(irPtr); - if (newLength > byteArrayPtr->allocated) { - byteArrayPtr = (ByteArray *)ckrealloc(byteArrayPtr, BYTEARRAY_SIZE(newLength)); - byteArrayPtr->allocated = newLength; + if (numBytes > byteArrayPtr->allocated) { + byteArrayPtr = (ByteArray *)Tcl_Realloc(byteArrayPtr, + BYTEARRAY_SIZE(numBytes)); + byteArrayPtr->allocated = numBytes; SET_BYTEARRAY(irPtr, byteArrayPtr); } TclInvalidateStringRep(objPtr); - objPtr->typePtr = &properByteArrayType; - byteArrayPtr->bad = newLength; - byteArrayPtr->used = newLength; + byteArrayPtr->used = numBytes; return byteArrayPtr->bytes; } /* *---------------------------------------------------------------------- * + * 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 + * 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 + * code in interp explaining why a proper byte sequence could not be + * made. + * + * Results: + * Returns a boolean indicating whether the bytes generated (up to + * limit bytes) are a proper representation of (a limited prefix of) + * the string. Writes a pointer to the generated ByteArray to + * *byteArrayPtrPtr. If not NULL it needs to be released with Tcl_Free(). + * + *---------------------------------------------------------------------- + */ + +static int +MakeByteArray( + Tcl_Interp *interp, + Tcl_Obj *objPtr, + size_t limit, + int demandProper, + ByteArray **byteArrayPtrPtr) +{ + size_t length; + const char *src = Tcl_GetStringFromObj(objPtr, &length); + size_t numBytes + = (limit != TCL_INDEX_NONE && limit < length) ? limit : length; + ByteArray *byteArrayPtr = (ByteArray *)Tcl_Alloc(BYTEARRAY_SIZE(numBytes)); + unsigned char *dst = byteArrayPtr->bytes; + unsigned char *dstEnd = dst + numBytes; + const char *srcEnd = src + length; + int proper = 1; + + for (; src < srcEnd && dst < dstEnd; ) { + int ch; + int count = TclUtfToUCS4(src, &ch); + + if (ch > 255) { + proper = 0; + if (demandProper) { + if (interp) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "expected byte sequence but character %" + TCL_Z_MODIFIER "u was '%1s' (U+%06X)", + dst - byteArrayPtr->bytes, src, ch)); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "BYTES", NULL); + } + Tcl_Free(byteArrayPtr); + *byteArrayPtrPtr = NULL; + return proper; + } + } + src += count; + *dst++ = UCHAR(ch); + } + byteArrayPtr->used = dst - byteArrayPtr->bytes; + byteArrayPtr->allocated = numBytes; + + *byteArrayPtrPtr = byteArrayPtr; + return proper; +} + +static Tcl_Obj * +TclNarrowToBytes( + Tcl_Obj *objPtr) +{ + if (NULL == TclFetchInternalRep(objPtr, &properByteArrayType)) { + Tcl_ObjInternalRep ir; + ByteArray *byteArrayPtr; + + if (0 == MakeByteArray(NULL, objPtr, TCL_INDEX_NONE, 0, &byteArrayPtr)) { + TclNewObj(objPtr); + TclInvalidateStringRep(objPtr); + } + SET_BYTEARRAY(&ir, byteArrayPtr); + Tcl_StoreInternalRep(objPtr, &properByteArrayType, &ir); + } + Tcl_IncrRefCount(objPtr); + return objPtr; +} + + +/* + *---------------------------------------------------------------------- + * * SetByteArrayFromAny -- * * Generate the ByteArray internal rep from the string rep. * * Results: - * The return value is always TCL_OK. + * Tcl return code indicating OK or ERROR. * * Side effects: - * A ByteArray object is stored as the internal rep of objPtr. + * A ByteArray struct may be stored as the internal rep of objPtr. * *---------------------------------------------------------------------- */ static int SetByteArrayFromAny( - TCL_UNUSED(Tcl_Interp *), + Tcl_Interp *interp, /* For error reporting. */ + size_t limit, /* Create no more than this many bytes */ Tcl_Obj *objPtr) /* The object to convert to type ByteArray. */ { - int length, bad; - const char *src, *srcEnd; - unsigned char *dst; - Tcl_UniChar ch = 0; ByteArray *byteArrayPtr; Tcl_ObjInternalRep ir; - if (TclHasInternalRep(objPtr, &properByteArrayType)) { - return TCL_OK; - } - if (TclHasInternalRep(objPtr, &tclByteArrayType)) { - return TCL_OK; - } - - src = TclGetStringFromObj(objPtr, &length); - bad = length; - srcEnd = src + length; - - /* Note the allocation is over-sized, possibly by a factor of four, - * or even a factor of two with a proper byte array value. */ - - byteArrayPtr = (ByteArray *)ckalloc(BYTEARRAY_SIZE(length)); - for (dst = byteArrayPtr->bytes; src < srcEnd; ) { - src += TclUtfToUniChar(src, &ch); - if ((bad == length) && (ch > 255)) { - bad = dst - byteArrayPtr->bytes; - } - *dst++ = UCHAR(ch); + if (0 == MakeByteArray(interp, objPtr, limit, 1, &byteArrayPtr)) { + return TCL_ERROR; } SET_BYTEARRAY(&ir, byteArrayPtr); - byteArrayPtr->allocated = length; - byteArrayPtr->used = dst - byteArrayPtr->bytes; - - if (bad == length) { - byteArrayPtr->bad = byteArrayPtr->used; - Tcl_StoreInternalRep(objPtr, &properByteArrayType, &ir); - } else { - byteArrayPtr->bad = bad; - Tcl_StoreInternalRep(objPtr, &tclByteArrayType, &ir); - } - + Tcl_StoreInternalRep(objPtr, &properByteArrayType, &ir); return TCL_OK; } @@ -712,17 +602,10 @@ SetByteArrayFromAny( */ static void -FreeByteArrayInternalRep( - Tcl_Obj *objPtr) /* Object with internal rep to free. */ -{ - ckfree(GET_BYTEARRAY(TclFetchInternalRep(objPtr, &tclByteArrayType))); -} - -static void FreeProperByteArrayInternalRep( Tcl_Obj *objPtr) /* Object with internal rep to free. */ { - ckfree(GET_BYTEARRAY(TclFetchInternalRep(objPtr, &properByteArrayType))); + Tcl_Free(GET_BYTEARRAY(TclFetchInternalRep(objPtr, &properByteArrayType))); } /* @@ -743,41 +626,18 @@ FreeProperByteArrayInternalRep( */ static void -DupByteArrayInternalRep( - Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ - Tcl_Obj *copyPtr) /* Object with internal rep to set. */ -{ - unsigned int length; - ByteArray *srcArrayPtr, *copyArrayPtr; - Tcl_ObjInternalRep ir; - - srcArrayPtr = GET_BYTEARRAY(TclFetchInternalRep(srcPtr, &tclByteArrayType)); - length = srcArrayPtr->used; - - copyArrayPtr = (ByteArray *)ckalloc(BYTEARRAY_SIZE(length)); - copyArrayPtr->bad = srcArrayPtr->bad; - copyArrayPtr->used = length; - copyArrayPtr->allocated = length; - memcpy(copyArrayPtr->bytes, srcArrayPtr->bytes, length); - - SET_BYTEARRAY(&ir, copyArrayPtr); - Tcl_StoreInternalRep(copyPtr, &tclByteArrayType, &ir); -} - -static void DupProperByteArrayInternalRep( Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ Tcl_Obj *copyPtr) /* Object with internal rep to set. */ { - unsigned int length; + size_t length; ByteArray *srcArrayPtr, *copyArrayPtr; Tcl_ObjInternalRep ir; srcArrayPtr = GET_BYTEARRAY(TclFetchInternalRep(srcPtr, &properByteArrayType)); length = srcArrayPtr->used; - copyArrayPtr = (ByteArray *)ckalloc(BYTEARRAY_SIZE(length)); - copyArrayPtr->bad = length; + copyArrayPtr = (ByteArray *)Tcl_Alloc(BYTEARRAY_SIZE(length)); copyArrayPtr->used = length; copyArrayPtr->allocated = length; memcpy(copyArrayPtr->bytes, srcArrayPtr->bytes, length); @@ -811,21 +671,18 @@ UpdateStringOfByteArray( const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objPtr, &properByteArrayType); ByteArray *byteArrayPtr = GET_BYTEARRAY(irPtr); unsigned char *src = byteArrayPtr->bytes; - unsigned int i, length = byteArrayPtr->used; - unsigned int size = length; + size_t i, length = byteArrayPtr->used; + size_t size = length; /* * How much space will string rep need? */ - for (i = 0; i < length && size <= INT_MAX; i++) { + for (i = 0; i < length; i++) { if ((src[i] == 0) || (src[i] > 127)) { size++; } } - if (size > INT_MAX) { - Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); - } if (size == length) { char *dst = Tcl_InitStringRep(objPtr, (char *)src, size); @@ -864,16 +721,16 @@ void TclAppendBytesToByteArray( Tcl_Obj *objPtr, const unsigned char *bytes, - int len) + size_t len) { ByteArray *byteArrayPtr; - unsigned int length, needed; + size_t needed; Tcl_ObjInternalRep *irPtr; if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object","TclAppendBytesToByteArray"); } - if (len < 0) { + if (len == TCL_INDEX_NONE) { Tcl_Panic("%s must be called with definite number of bytes to append", "TclAppendBytesToByteArray"); } @@ -885,53 +742,48 @@ TclAppendBytesToByteArray( return; } - length = (unsigned int) len; - irPtr = TclFetchInternalRep(objPtr, &properByteArrayType); if (irPtr == NULL) { - irPtr = TclFetchInternalRep(objPtr, &tclByteArrayType); - if (irPtr == NULL) { - SetByteArrayFromAny(NULL, objPtr); - irPtr = TclFetchInternalRep(objPtr, &properByteArrayType); - if (irPtr == NULL) { - irPtr = TclFetchInternalRep(objPtr, &tclByteArrayType); - } + if (TCL_ERROR == SetByteArrayFromAny(NULL, TCL_INDEX_NONE, objPtr)) { + Tcl_Panic("attempt to append bytes to non-bytearray"); } + irPtr = TclFetchInternalRep(objPtr, &properByteArrayType); } byteArrayPtr = GET_BYTEARRAY(irPtr); - if (length > INT_MAX - byteArrayPtr->used) { - Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); - } - - needed = byteArrayPtr->used + length; /* * 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 (needed > byteArrayPtr->allocated) { ByteArray *ptr = NULL; - unsigned int attempt; - if (needed <= INT_MAX/2) { - /* - * Try to allocate double the total space that is needed. - */ + /* + * Try to allocate double the total space that is needed. + */ - attempt = 2 * needed; - ptr = (ByteArray *)attemptckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt)); + size_t attempt = 2 * needed; + + /* Protection just in case we wrapped around SIZE_MAX */ + if (attempt >= needed) { + ptr = (ByteArray *) Tcl_AttemptRealloc(byteArrayPtr, + BYTEARRAY_SIZE(attempt)); } if (ptr == NULL) { /* * Try to allocate double the increment that is needed (plus). */ - unsigned int limit = INT_MAX - needed; - unsigned int extra = length + TCL_MIN_GROWTH; - int growth = (int) ((extra > limit) ? limit : extra); - - attempt = needed + growth; - ptr = (ByteArray *)attemptckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt)); + attempt = needed + len + TCL_MIN_GROWTH; + if (attempt >= needed) { + ptr = (ByteArray *) Tcl_AttemptRealloc(byteArrayPtr, + BYTEARRAY_SIZE(attempt)); + } } if (ptr == NULL) { /* @@ -939,7 +791,7 @@ TclAppendBytesToByteArray( */ attempt = needed; - ptr = (ByteArray *)ckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt)); + ptr = (ByteArray *)Tcl_Realloc(byteArrayPtr, BYTEARRAY_SIZE(attempt)); } byteArrayPtr = ptr; byteArrayPtr->allocated = attempt; @@ -947,11 +799,10 @@ TclAppendBytesToByteArray( } if (bytes) { - memcpy(byteArrayPtr->bytes + byteArrayPtr->used, bytes, length); + memcpy(byteArrayPtr->bytes + byteArrayPtr->used, bytes, len); } - byteArrayPtr->used += length; + byteArrayPtr->used += len; TclInvalidateStringRep(objPtr); - objPtr->typePtr = &properByteArrayType; } /* @@ -1010,7 +861,7 @@ BinaryFormatCmd( int value = 0; /* Current integer value to be packed. * Initialized to avoid compiler warning. */ char cmd; /* Current format character. */ - int count; /* Count associated with current format + size_t count; /* Count associated with current format * character. */ int flags; /* Format field flags */ const char *format; /* Pointer to current position in format @@ -1022,7 +873,7 @@ BinaryFormatCmd( * cursor has visited.*/ const char *errorString; const char *errorValue, *str; - int offset, size, length; + size_t offset, size, length; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "formatString ?arg ...?"); @@ -1061,7 +912,9 @@ BinaryFormatCmd( goto badIndex; } if (count == BINARY_ALL) { - Tcl_GetByteArrayFromObj(objv[arg], &count); + if (Tcl_GetByteArrayFromObj(objv[arg], &count) == NULL) { + count = Tcl_GetCharLength(objv[arg]); + } } else if (count == BINARY_NOCOUNT) { count = 1; } @@ -1118,7 +971,7 @@ BinaryFormatCmd( arg++; count = 1; } else { - int listc; + size_t listc; Tcl_Obj **listv; /* @@ -1224,8 +1077,9 @@ BinaryFormatCmd( case 'A': { char pad = (char) (cmd == 'a' ? '\0' : ' '); unsigned char *bytes; + Tcl_Obj *copy = TclNarrowToBytes(objv[arg++]); - bytes = Tcl_GetByteArrayFromObj(objv[arg++], &length); + bytes = Tcl_GetByteArrayFromObj(copy, &length); if (count == BINARY_ALL) { count = length; @@ -1239,13 +1093,14 @@ BinaryFormatCmd( memset(cursor + length, pad, count - length); } cursor += count; + Tcl_DecrRefCount(copy); break; } case 'b': case 'B': { unsigned char *last; - str = TclGetStringFromObj(objv[arg], &length); + str = Tcl_GetStringFromObj(objv[arg], &length); arg++; if (count == BINARY_ALL) { count = length; @@ -1307,7 +1162,7 @@ BinaryFormatCmd( unsigned char *last; int c; - str = TclGetStringFromObj(objv[arg], &length); + str = Tcl_GetStringFromObj(objv[arg], &length); arg++; if (count == BINARY_ALL) { count = length; @@ -1394,7 +1249,7 @@ BinaryFormatCmd( case 'q': case 'Q': case 'f': { - int listc, i; + size_t listc, i; Tcl_Obj **listv; if (count == BINARY_NOCOUNT) { @@ -1435,7 +1290,7 @@ BinaryFormatCmd( if (count == BINARY_NOCOUNT) { count = 1; } - if ((count == BINARY_ALL) || (count > (cursor - buffer))) { + if ((count == BINARY_ALL) || (count > (size_t)(cursor - buffer))) { cursor = buffer; } else { cursor -= count; @@ -1515,7 +1370,7 @@ BinaryScanCmd( int value = 0; /* Current integer value to be packed. * Initialized to avoid compiler warning. */ char cmd; /* Current format character. */ - int count; /* Count associated with current format + size_t count; /* Count associated with current format * character. */ int flags; /* Format field flags */ const char *format; /* Pointer to current position in format @@ -1524,7 +1379,7 @@ BinaryScanCmd( unsigned char *buffer; /* Start of result buffer. */ const char *errorString; const char *str; - int offset, size, length, i; + size_t offset, size, length = 0, i; Tcl_Obj *valuePtr, *elementPtr; Tcl_HashTable numberCacheHash; @@ -1535,9 +1390,12 @@ BinaryScanCmd( "value formatString ?varName ...?"); return TCL_ERROR; } + buffer = Tcl_GetBytesFromObj(interp, objv[1], &length); + if (buffer == NULL) { + return TCL_ERROR; + } numberCachePtr = &numberCacheHash; Tcl_InitHashTable(numberCachePtr, TCL_ONE_WORD_KEYS); - buffer = Tcl_GetByteArrayFromObj(objv[1], &length); format = TclGetString(objv[2]); arg = 3; offset = 0; @@ -1563,7 +1421,7 @@ BinaryScanCmd( if (count == BINARY_NOCOUNT) { count = 1; } - if (count > (length - offset)) { + if (count > length - offset) { goto done; } } @@ -1630,7 +1488,7 @@ BinaryScanCmd( if (count == BINARY_NOCOUNT) { count = 1; } - if (count > (length - offset) * 8) { + if (count > (size_t)(length - offset) * 8) { goto done; } } @@ -1761,7 +1619,7 @@ BinaryScanCmd( goto badIndex; } if (count == BINARY_NOCOUNT) { - if ((length - offset) < size) { + if (length < (size_t)size + offset) { goto done; } valuePtr = ScanNumber(buffer+offset, cmd, flags, @@ -1891,7 +1749,7 @@ static int GetFormatSpec( const char **formatPtr, /* Pointer to format string. */ char *cmdPtr, /* Pointer to location of command char. */ - int *countPtr, /* Pointer to repeat count value. */ + size_t *countPtr, /* Pointer to repeat count value. */ int *flagsPtr) /* Pointer to field flags */ { /* @@ -2057,7 +1915,7 @@ static void CopyNumber( const void *from, /* source */ void *to, /* destination */ - unsigned length, /* Number of bytes to copy */ + size_t length, /* Number of bytes to copy */ int type) /* What type of thing are we copying? */ { switch (NeedReversing(type)) { @@ -2124,7 +1982,7 @@ CopyNumber( * * FormatNumber -- * - * This routine is called by BinaryFormatCmd to format a number into a + * This routine is called by Tcl_BinaryObjCmd to format a number into a * location pointed at by cursor. * * Results: @@ -2297,7 +2155,7 @@ FormatNumber( * * ScanNumber -- * - * This routine is called by BinaryScanCmd to scan a number out of a + * This routine is called by Tcl_BinaryObjCmd to scan a number out of a * buffer. * * Results: @@ -2402,9 +2260,9 @@ ScanNumber( if (flags & BINARY_UNSIGNED) { return Tcl_NewWideIntObj((Tcl_WideInt)(unsigned long)value); } - if ((value & (((unsigned) 1) << 31)) && (value > 0)) { - value -= (((unsigned) 1) << 31); - value -= (((unsigned) 1) << 31); + if ((value & (1U << 31)) && (value > 0)) { + value -= (1U << 31); + value -= (1U << 31); } returnNumericObject: @@ -2595,15 +2453,19 @@ BinaryEncodeHex( Tcl_Obj *resultObj = NULL; unsigned char *data = NULL; unsigned char *cursor = NULL; - int offset = 0, count = 0; + size_t offset = 0, count = 0; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "data"); return TCL_ERROR; } + data = Tcl_GetBytesFromObj(interp, objv[1], &count); + if (data == NULL) { + return TCL_ERROR; + } + TclNewObj(resultObj); - data = Tcl_GetByteArrayFromObj(objv[1], &count); cursor = Tcl_SetByteArrayLength(resultObj, count * 2); for (offset = 0; offset < count; ++offset) { *cursor++ = HexDigits[(data[offset] >> 4) & 0x0F]; @@ -2639,7 +2501,8 @@ BinaryDecodeHex( Tcl_Obj *resultObj = NULL; unsigned char *data, *datastart, *dataend; unsigned char *begin, *cursor, c; - int i, index, value, size, pure = 1, count = 0, cut = 0, strict = 0; + int i, index, value, pure = 1, strict = 0; + size_t size, cut = 0, count = 0; int ucs4; enum {OPT_STRICT }; static const char *const optStrings[] = { "-strict", NULL }; @@ -2661,10 +2524,10 @@ BinaryDecodeHex( } TclNewObj(resultObj); - data = TclGetBytesFromObj(NULL, objv[objc - 1], &count); + data = Tcl_GetByteArrayFromObj(objv[objc - 1], &count); if (data == NULL) { pure = 0; - data = (unsigned char *) TclGetStringFromObj(objv[objc - 1], &count); + data = (unsigned char *) Tcl_GetStringFromObj(objv[objc - 1], &count); } datastart = data; dataend = data + count; @@ -2718,8 +2581,8 @@ BinaryDecodeHex( } TclDecrRefCount(resultObj); Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "invalid hexadecimal digit \"%c\" (U+%06X) at position %d", - ucs4, ucs4, (int) (data - datastart - 1))); + "invalid hexadecimal digit \"%c\" (U+%06X) at position %" + TCL_Z_MODIFIER "u", ucs4, ucs4, data - datastart - 1)); Tcl_SetErrorCode(interp, "TCL", "BINARY", "DECODE", "INVALID", NULL); return TCL_ERROR; } @@ -2764,8 +2627,9 @@ BinaryEncode64( unsigned char *data, *limit; int maxlen = 0; const char *wrapchar = "\n"; - int wrapcharlen = 1; - int offset, i, index, size, outindex = 0, count = 0, purewrap = 1; + size_t wrapcharlen = 1; + int i, index, size, outindex = 0, purewrap = 1; + size_t offset, count = 0; enum { OPT_MAXLEN, OPT_WRAPCHAR }; static const char *const optStrings[] = { "-maxlen", "-wrapchar", NULL }; @@ -2793,11 +2657,11 @@ BinaryEncode64( } break; case OPT_WRAPCHAR: - wrapchar = (const char *)TclGetBytesFromObj(NULL, + wrapchar = (const char *)Tcl_GetByteArrayFromObj( objv[i + 1], &wrapcharlen); if (wrapchar == NULL) { purewrap = 0; - wrapchar = TclGetStringFromObj(objv[i + 1], &wrapcharlen); + wrapchar = Tcl_GetStringFromObj(objv[i + 1], &wrapcharlen); } break; } @@ -2806,8 +2670,11 @@ BinaryEncode64( maxlen = 0; } + data = Tcl_GetBytesFromObj(interp, objv[objc - 1], &count); + if (data == NULL) { + return TCL_ERROR; + } TclNewObj(resultObj); - data = Tcl_GetByteArrayFromObj(objv[objc - 1], &count); if (count > 0) { unsigned char *cursor = NULL; @@ -2884,12 +2751,12 @@ BinaryEncodeUu( { Tcl_Obj *resultObj; unsigned char *data, *start, *cursor; - int offset, count, rawLength, i, j, bits, index; + int rawLength, i, bits, index; unsigned int n; int lineLength = 61; const unsigned char SingleNewline[] = { UCHAR('\n') }; const unsigned char *wrapchar = SingleNewline; - int wrapcharlen = sizeof(SingleNewline); + size_t j, offset, count = 0, wrapcharlen = sizeof(SingleNewline); enum { OPT_MAXLEN, OPT_WRAPCHAR }; static const char *const optStrings[] = { "-maxlen", "-wrapchar", NULL }; @@ -2919,11 +2786,11 @@ BinaryEncodeUu( lineLength = ((lineLength - 1) & -4) + 1; /* 5, 9, 13 ... */ break; case OPT_WRAPCHAR: - wrapchar = (const unsigned char *) TclGetStringFromObj( + wrapchar = (const unsigned char *) Tcl_GetStringFromObj( objv[i + 1], &wrapcharlen); { const unsigned char *p = wrapchar; - int numBytes = wrapcharlen; + size_t numBytes = wrapcharlen; while (numBytes) { switch (*p) { @@ -2959,9 +2826,12 @@ BinaryEncodeUu( * enough". */ - TclNewObj(resultObj); offset = 0; - data = Tcl_GetByteArrayFromObj(objv[objc - 1], &count); + data = Tcl_GetBytesFromObj(interp, objv[objc - 1], &count); + if (data == NULL) { + return TCL_ERROR; + } + TclNewObj(resultObj); rawLength = (lineLength - 1) * 3 / 4; start = cursor = Tcl_SetByteArrayLength(resultObj, (lineLength + wrapcharlen) * @@ -3034,7 +2904,8 @@ BinaryDecodeUu( Tcl_Obj *resultObj = NULL; unsigned char *data, *datastart, *dataend; unsigned char *begin, *cursor; - int i, index, size, pure = 1, count = 0, strict = 0, lineLen; + int i, index, pure = 1, strict = 0, lineLen; + size_t size, count = 0; unsigned char c; int ucs4; enum { OPT_STRICT }; @@ -3057,10 +2928,10 @@ BinaryDecodeUu( } TclNewObj(resultObj); - data = TclGetBytesFromObj(NULL, objv[objc - 1], &count); + data = Tcl_GetByteArrayFromObj(objv[objc - 1], &count); if (data == NULL) { pure = 0; - data = (unsigned char *) TclGetStringFromObj(objv[objc - 1], &count); + data = (unsigned char *) Tcl_GetStringFromObj(objv[objc - 1], &count); } datastart = data; dataend = data + count; @@ -3174,8 +3045,8 @@ BinaryDecodeUu( TclUtfToUCS4((const char *)(data - 1), &ucs4); } Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "invalid uuencode character \"%c\" (U+%06X) at position %d", - ucs4, ucs4, (int) (data - datastart - 1))); + "invalid uuencode character \"%c\" (U+%06X) at position %" + TCL_Z_MODIFIER "u", ucs4, ucs4, data - datastart - 1)); Tcl_SetErrorCode(interp, "TCL", "BINARY", "DECODE", "INVALID", NULL); TclDecrRefCount(resultObj); return TCL_ERROR; @@ -3209,7 +3080,8 @@ BinaryDecode64( unsigned char *begin = NULL; unsigned char *cursor = NULL; int pure = 1, strict = 0; - int i, index, size, cut = 0, count = 0; + int i, index, cut = 0; + size_t size, count = 0; int ucs4; enum { OPT_STRICT }; static const char *const optStrings[] = { "-strict", NULL }; @@ -3231,10 +3103,10 @@ BinaryDecode64( } TclNewObj(resultObj); - data = TclGetBytesFromObj(NULL, objv[objc - 1], &count); + data = Tcl_GetByteArrayFromObj(objv[objc - 1], &count); if (data == NULL) { pure = 0; - data = (unsigned char *) TclGetStringFromObj(objv[objc - 1], &count); + data = (unsigned char *) Tcl_GetStringFromObj(objv[objc - 1], &count); } datastart = data; dataend = data + count; @@ -3349,8 +3221,8 @@ BinaryDecode64( } Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "invalid base64 character \"%c\" (U+%06X) at position %d", - ucs4, ucs4, (int) (data - datastart - 1))); + "invalid base64 character \"%c\" (U+%06X) at position %" + TCL_Z_MODIFIER "u", ucs4, ucs4, data - datastart - 1)); Tcl_SetErrorCode(interp, "TCL", "BINARY", "DECODE", "INVALID", NULL); TclDecrRefCount(resultObj); return TCL_ERROR; diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c index 0ad2c46..f7cab9f 100644 --- a/generic/tclCkalloc.c +++ b/generic/tclCkalloc.c @@ -121,7 +121,7 @@ static char dumpFile[100]; /* Records where to dump memory allocation /* * Mutex to serialize allocations. This is a low-level mutex that must be * explicitly initialized. This is necessary because the self initializing - * mutexes use ckalloc... + * mutexes use Tcl_Alloc... */ static Tcl_Mutex *ckallocMutexPtr; @@ -365,7 +365,7 @@ Tcl_DumpActiveMemory( /* *---------------------------------------------------------------------- * - * Tcl_DbCkalloc - debugging ckalloc + * Tcl_DbCkalloc - debugging Tcl_Alloc * * Allocate the requested amount of space plus some extra for guard bands * at both ends of the request, plus a size, panicking if there isn't @@ -374,15 +374,15 @@ Tcl_DumpActiveMemory( * * The second and third arguments are file and line, these contain the * filename and line number corresponding to the caller. These are sent - * by the ckalloc macro; it uses the preprocessor autodefines __FILE__ + * by the Tcl_Alloc macro; it uses the preprocessor autodefines __FILE__ * and __LINE__. * *---------------------------------------------------------------------- */ -char * +void * Tcl_DbCkalloc( - unsigned int size, + size_t size, const char *file, int line) { @@ -393,14 +393,14 @@ Tcl_DbCkalloc( } /* Don't let size argument to TclpAlloc overflow */ - if (size <= UINT_MAX - offsetof(struct mem_header, body) - 1U - HIGH_GUARD_SIZE) { + if (size <= (size_t)-2 - offsetof(struct mem_header, body) - HIGH_GUARD_SIZE) { result = (struct mem_header *) TclpAlloc(size + offsetof(struct mem_header, body) + 1U + HIGH_GUARD_SIZE); } if (result == NULL) { fflush(stdout); TclDumpMemoryInfo(stderr, 0); - Tcl_Panic("unable to alloc %u bytes, %s line %d", size, file, line); + Tcl_Panic("unable to alloc %" TCL_Z_MODIFIER "u bytes, %s line %d", size, file, line); } /* @@ -446,7 +446,7 @@ Tcl_DbCkalloc( } if (alloc_tracing) { - fprintf(stderr,"ckalloc %p %u %s %d\n", + fprintf(stderr,"Tcl_Alloc %p %" TCL_Z_MODIFIER "u %s %d\n", result->body, size, file, line); } @@ -470,9 +470,9 @@ Tcl_DbCkalloc( return result->body; } -char * +void * Tcl_AttemptDbCkalloc( - unsigned int size, + size_t size, const char *file, int line) { @@ -483,7 +483,7 @@ Tcl_AttemptDbCkalloc( } /* Don't let size argument to TclpAlloc overflow */ - if (size <= UINT_MAX - offsetof(struct mem_header, body) - 1U - HIGH_GUARD_SIZE) { + if (size <= (size_t)-2 - offsetof(struct mem_header, body) - HIGH_GUARD_SIZE) { result = (struct mem_header *) TclpAlloc(size + offsetof(struct mem_header, body) + 1U + HIGH_GUARD_SIZE); } @@ -535,7 +535,7 @@ Tcl_AttemptDbCkalloc( } if (alloc_tracing) { - fprintf(stderr,"ckalloc %p %u %s %d\n", + fprintf(stderr,"Tcl_Alloc %p %" TCL_Z_MODIFIER "u %s %d\n", result->body, size, file, line); } @@ -562,7 +562,7 @@ Tcl_AttemptDbCkalloc( /* *---------------------------------------------------------------------- * - * Tcl_DbCkfree - debugging ckfree + * Tcl_DbCkfree - debugging Tcl_Free * * Verify that the low and high guards are intact, and if so then free * the buffer else Tcl_Panic. @@ -571,7 +571,7 @@ Tcl_AttemptDbCkalloc( * * The second and third arguments are file and line, these contain the * filename and line number corresponding to the caller. These are sent - * by the ckfree macro; it uses the preprocessor autodefines __FILE__ and + * by the Tcl_Free macro; it uses the preprocessor autodefines __FILE__ and * __LINE__. * *---------------------------------------------------------------------- @@ -579,7 +579,7 @@ Tcl_AttemptDbCkalloc( void Tcl_DbCkfree( - char *ptr, + void *ptr, const char *file, int line) { @@ -600,7 +600,7 @@ Tcl_DbCkfree( memp = (struct mem_header *) (((size_t) ptr) - BODY_OFFSET); if (alloc_tracing) { - fprintf(stderr, "ckfree %p %" TCL_Z_MODIFIER "u %s %d\n", + fprintf(stderr, "Tcl_Free %p %" TCL_Z_MODIFIER "u %s %d\n", memp->body, memp->length, file, line); } @@ -644,7 +644,7 @@ Tcl_DbCkfree( /* *-------------------------------------------------------------------- * - * Tcl_DbCkrealloc - debugging ckrealloc + * Tcl_DbCkrealloc - debugging Tcl_Realloc * * Reallocate a chunk of memory by allocating a new one of the right * size, copying the old data to the new location, and then freeing the @@ -654,10 +654,10 @@ Tcl_DbCkfree( *-------------------------------------------------------------------- */ -char * +void * Tcl_DbCkrealloc( - char *ptr, - unsigned int size, + void *ptr, + size_t size, const char *file, int line) { @@ -685,10 +685,10 @@ Tcl_DbCkrealloc( return newPtr; } -char * +void * Tcl_AttemptDbCkrealloc( - char *ptr, - unsigned int size, + void *ptr, + size_t size, const char *file, int line) { @@ -737,38 +737,38 @@ Tcl_AttemptDbCkrealloc( *---------------------------------------------------------------------- */ -char * +void * Tcl_Alloc( - unsigned int size) + size_t size) { return Tcl_DbCkalloc(size, "unknown", 0); } -char * +void * Tcl_AttemptAlloc( - unsigned int size) + size_t size) { return Tcl_AttemptDbCkalloc(size, "unknown", 0); } void Tcl_Free( - char *ptr) + void *ptr) { Tcl_DbCkfree(ptr, "unknown", 0); } -char * +void * Tcl_Realloc( - char *ptr, - unsigned int size) + void *ptr, + size_t size) { return Tcl_DbCkrealloc(ptr, size, "unknown", 0); } -char * +void * Tcl_AttemptRealloc( - char *ptr, - unsigned int size) + void *ptr, + size_t size) { return Tcl_AttemptDbCkrealloc(ptr, size, "unknown", 0); } @@ -1030,11 +1030,11 @@ Tcl_InitMemory( *---------------------------------------------------------------------- */ -char * +void * Tcl_Alloc( - unsigned int size) + size_t size) { - char *result = (char *)TclpAlloc(size); + void *result = TclpAlloc(size); /* * Most systems will not alloc(0), instead bumping it to one so that NULL @@ -1047,22 +1047,23 @@ Tcl_Alloc( */ if ((result == NULL) && size) { - Tcl_Panic("unable to alloc %u bytes", size); + Tcl_Panic("unable to alloc %" TCL_Z_MODIFIER "u bytes", size); } return result; } -char * +void * Tcl_DbCkalloc( - unsigned int size, + size_t size, const char *file, int line) { - char *result = (char *)TclpAlloc(size); + void *result = TclpAlloc(size); if ((result == NULL) && size) { fflush(stdout); - Tcl_Panic("unable to alloc %u bytes, %s line %d", size, file, line); + Tcl_Panic("unable to alloc %" TCL_Z_MODIFIER "u bytes, %s line %d", + size, file, line); } return result; } @@ -1078,16 +1079,16 @@ Tcl_DbCkalloc( *---------------------------------------------------------------------- */ -char * +void * Tcl_AttemptAlloc( - unsigned int size) + size_t size) { return (char *)TclpAlloc(size); } -char * +void * Tcl_AttemptDbCkalloc( - unsigned int size, + size_t size, TCL_UNUSED(const char *) /*file*/, TCL_UNUSED(int) /*line*/) { @@ -1105,31 +1106,32 @@ Tcl_AttemptDbCkalloc( *---------------------------------------------------------------------- */ -char * +void * Tcl_Realloc( - char *ptr, - unsigned int size) + void *ptr, + size_t size) { - char *result = (char *)TclpRealloc(ptr, size); + void *result = TclpRealloc(ptr, size); if ((result == NULL) && size) { - Tcl_Panic("unable to realloc %u bytes", size); + Tcl_Panic("unable to realloc %" TCL_Z_MODIFIER "u bytes", size); } return result; } -char * +void * Tcl_DbCkrealloc( - char *ptr, - unsigned int size, + void *ptr, + size_t size, const char *file, int line) { - char *result = (char *)TclpRealloc(ptr, size); + void *result = TclpRealloc(ptr, size); if ((result == NULL) && size) { fflush(stdout); - Tcl_Panic("unable to realloc %u bytes, %s line %d", size, file, line); + Tcl_Panic("unable to realloc %" TCL_Z_MODIFIER "u bytes, %s line %d", + size, file, line); } return result; } @@ -1145,18 +1147,18 @@ Tcl_DbCkrealloc( *---------------------------------------------------------------------- */ -char * +void * Tcl_AttemptRealloc( - char *ptr, - unsigned int size) + void *ptr, + size_t size) { return (char *)TclpRealloc(ptr, size); } -char * +void * Tcl_AttemptDbCkrealloc( - char *ptr, - unsigned int size, + void *ptr, + size_t size, TCL_UNUSED(const char *) /*file*/, TCL_UNUSED(int) /*line*/) { @@ -1177,14 +1179,14 @@ Tcl_AttemptDbCkrealloc( void Tcl_Free( - char *ptr) + void *ptr) { TclpFree(ptr); } void Tcl_DbCkfree( - char *ptr, + void *ptr, TCL_UNUSED(const char *) /*file*/, TCL_UNUSED(int) /*line*/) { diff --git a/generic/tclClock.c b/generic/tclClock.c index d1f08c1..2647da5 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -101,7 +101,7 @@ typedef struct { * Structure containing the fields used in [clock format] and [clock scan] */ -typedef struct TclDateFields { +typedef struct { Tcl_WideInt seconds; /* Time expressed in seconds from the Posix * epoch */ Tcl_WideInt localSeconds; /* Local time expressed in nominal seconds @@ -143,17 +143,17 @@ TCL_DECLARE_MUTEX(clockMutex) static int ConvertUTCToLocal(Tcl_Interp *, TclDateFields *, Tcl_Obj *, int); static int ConvertUTCToLocalUsingTable(Tcl_Interp *, - TclDateFields *, int, Tcl_Obj *const[]); + TclDateFields *, size_t, 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 *, int, Tcl_Obj *const[]); + TclDateFields *, size_t, Tcl_Obj *const[]); static int ConvertLocalToUTCUsingC(Tcl_Interp *, TclDateFields *, int); static Tcl_Obj * LookupLastTransition(Tcl_Interp *, Tcl_WideInt, - int, Tcl_Obj *const *); + size_t, Tcl_Obj *const *); static void GetYearWeekDay(TclDateFields *, int); static void GetGregorianEraYearDay(TclDateFields *, int); static void GetMonthDay(TclDateFields *); @@ -256,9 +256,9 @@ TclClockInit( * Create the client data, which is a refcounted literal pool. */ - data = (ClockClientData *)ckalloc(sizeof(ClockClientData)); + data = (ClockClientData *)Tcl_Alloc(sizeof(ClockClientData)); data->refCount = 0; - data->literals = (Tcl_Obj **)ckalloc(LIT__END * sizeof(Tcl_Obj*)); + data->literals = (Tcl_Obj **)Tcl_Alloc(LIT__END * sizeof(Tcl_Obj*)); for (i = 0; i < LIT__END; ++i) { data->literals[i] = Tcl_NewStringObj(literals[i], -1); Tcl_IncrRefCount(data->literals[i]); @@ -728,7 +728,7 @@ ConvertLocalToUTC( Tcl_Obj *tzdata, /* Time zone data */ int changeover) /* Julian Day of the Gregorian transition */ { - int rowc; /* Number of rows in tzdata */ + size_t 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 */ - int rowc, /* Number of points at which time changes */ + size_t rowc, /* Number of points at which time changes */ Tcl_Obj *const rowv[]) /* Points at which time changes */ { Tcl_Obj *row; - int cellc; + size_t 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 */ { - int rowc; /* Number of rows in tzdata */ + size_t 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 */ - int rowc, /* Number of rows in the conversion table + size_t 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 */ - int cellc; /* Count of cells in the row (must be 4) */ + size_t cellc; /* Count of cells in the row (must be 4) */ Tcl_Obj **cellv; /* Pointers to the cells */ /* @@ -1116,11 +1116,11 @@ static Tcl_Obj * LookupLastTransition( Tcl_Interp *interp, /* Interpreter for error messages */ Tcl_WideInt tick, /* Time from the epoch */ - int rowc, /* Number of rows of tzdata */ + size_t rowc, /* Number of rows of tzdata */ Tcl_Obj *const *rowv) /* Rows in tzdata */ { - int l; - int u; + size_t l; + size_t u; Tcl_Obj *compObj; Tcl_WideInt compVal; @@ -1761,13 +1761,13 @@ ClockClicksObjCmd( switch (index) { case CLICKS_MILLIS: Tcl_GetTime(&now); - clicks = (Tcl_WideInt) now.sec * 1000 + now.usec / 1000; + clicks = (Tcl_WideInt)(unsigned long)now.sec * 1000 + now.usec / 1000; break; case CLICKS_NATIVE: #ifdef TCL_WIDE_CLICKS clicks = TclpGetWideClicks(); #else - clicks = (Tcl_WideInt) TclpGetClicks(); + clicks = (Tcl_WideInt)TclpGetClicks(); #endif break; case CLICKS_MICROS: @@ -1918,7 +1918,7 @@ ClockParseformatargsObjCmd( if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, &optionIndex) != TCL_OK) { Tcl_SetErrorCode(interp, "CLOCK", "badOption", - Tcl_GetString(objv[i]), NULL); + TclGetString(objv[i]), NULL); return TCL_ERROR; } switch (optionIndex) { @@ -2064,13 +2064,13 @@ TzsetIfNecessary(void) || wcscmp(tzIsNow, tzWas) != 0)) { tzset(); if (tzWas != NULL && tzWas != (WCHAR *)INT2PTR(-1)) { - ckfree(tzWas); + Tcl_Free(tzWas); } - tzWas = (WCHAR *)ckalloc(sizeof(WCHAR) * (wcslen(tzIsNow) + 1)); + tzWas = (WCHAR *)Tcl_Alloc(sizeof(WCHAR) * (wcslen(tzIsNow) + 1)); wcscpy(tzWas, tzIsNow); } else if (tzIsNow == NULL && tzWas != NULL) { tzset(); - if (tzWas != (WCHAR *)INT2PTR(-1)) ckfree(tzWas); + if (tzWas != (WCHAR *)INT2PTR(-1)) Tcl_Free(tzWas); tzWas = NULL; } Tcl_MutexUnlock(&clockMutex); @@ -2101,8 +2101,8 @@ ClockDeleteCmdProc( for (i = 0; i < LIT__END; ++i) { Tcl_DecrRefCount(data->literals[i]); } - ckfree(data->literals); - ckfree(data); + Tcl_Free(data->literals); + Tcl_Free(data); } } diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index 9905633..a5384fd 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -28,11 +28,11 @@ struct ForeachState { int bodyIdx; /* The argument index of the body. */ int j, maxj; /* Number of loop iterations. */ int numLists; /* Count of value lists. */ - int *index; /* Array of value list indices. */ - int *varcList; /* # loop variables per list. */ + size_t *index; /* Array of value list indices. */ + size_t *varcList; /* # loop variables per list. */ Tcl_Obj ***varvList; /* Array of var name lists. */ Tcl_Obj **vCopyList; /* Copies of var name list arguments. */ - int *argcList; /* Array of value list sizes. */ + size_t *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, @@ -135,142 +135,6 @@ Tcl_BreakObjCmd( /* *---------------------------------------------------------------------- * - * Tcl_CaseObjCmd -- - * - * This procedure is invoked to process the "case" Tcl command. See the - * user documentation for details on what it does. THIS COMMAND IS - * OBSOLETE AND DEPRECATED. SLATED FOR REMOVAL IN TCL 9.0. - * - * Results: - * A standard Tcl object result. - * - * Side effects: - * See the user documentation. - * - *---------------------------------------------------------------------- - */ -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 -int -Tcl_CaseObjCmd( - TCL_UNUSED(void *), - Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ - Tcl_Obj *const objv[]) /* Argument objects. */ -{ - int i; - int body, result, caseObjc; - const char *stringPtr, *arg; - Tcl_Obj *const *caseObjv; - Tcl_Obj *armPtr; - - if (objc < 3) { - Tcl_WrongNumArgs(interp, 1, objv, - "string ?in? ?pattern body ...? ?default body?"); - return TCL_ERROR; - } - - stringPtr = TclGetString(objv[1]); - body = -1; - - arg = TclGetString(objv[2]); - if (strcmp(arg, "in") == 0) { - i = 3; - } else { - i = 2; - } - caseObjc = objc - i; - caseObjv = objv + i; - - /* - * If all of the pattern/command pairs are lumped into a single argument, - * split them out again. - */ - - if (caseObjc == 1) { - Tcl_Obj **newObjv; - - TclListObjGetElementsM(interp, caseObjv[0], &caseObjc, &newObjv); - caseObjv = newObjv; - } - - for (i = 0; i < caseObjc; i += 2) { - int patObjc, j; - const char **patObjv; - const char *pat, *p; - - if (i == caseObjc-1) { - Tcl_ResetResult(interp); - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "extra case pattern with no body", -1)); - return TCL_ERROR; - } - - /* - * Check for special case of single pattern (no list) with no - * backslash sequences. - */ - - pat = TclGetString(caseObjv[i]); - for (p = pat; *p != '\0'; p++) { - if (TclIsSpaceProcM(*p) || (*p == '\\')) { - break; - } - } - if (*p == '\0') { - if ((*pat == 'd') && (strcmp(pat, "default") == 0)) { - body = i + 1; - } - if (Tcl_StringMatch(stringPtr, pat)) { - body = i + 1; - goto match; - } - continue; - } - - /* - * Break up pattern lists, then check each of the patterns in the - * list. - */ - - result = Tcl_SplitList(interp, pat, &patObjc, &patObjv); - if (result != TCL_OK) { - return result; - } - for (j = 0; j < patObjc; j++) { - if (Tcl_StringMatch(stringPtr, patObjv[j])) { - body = i + 1; - break; - } - } - ckfree(patObjv); - if (j < patObjc) { - break; - } - } - - match: - if (body != -1) { - armPtr = caseObjv[body - 1]; - result = Tcl_EvalObjEx(interp, caseObjv[body], 0); - if (result == TCL_ERROR) { - Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( - "\n (\"%.50s\" arm line %d)", - TclGetString(armPtr), Tcl_GetErrorLine(interp))); - } - return result; - } - - /* - * Nothing matched: return nothing. - */ - - return TCL_OK; -} -#endif /* !TCL_NO_DEPRECATED */ - -/* - *---------------------------------------------------------------------- - * * Tcl_CatchObjCmd -- * * This object-based procedure is invoked to process the "catch" Tcl @@ -408,7 +272,10 @@ Tcl_CdObjCmd( if (objc == 2) { dir = objv[1]; } else { - TclNewLiteralStringObj(dir, "~"); + dir = TclGetHomeDirObj(interp, NULL); + if (dir == NULL) { + return TCL_ERROR; + } Tcl_IncrRefCount(dir); } if (Tcl_FSConvertToPathType(interp, dir) != TCL_OK) { @@ -549,14 +416,10 @@ EncodingConvertfromObjCmd( Tcl_Obj *data; /* Byte array to convert */ Tcl_DString ds; /* Buffer to hold the string */ Tcl_Encoding encoding; /* Encoding to use */ - int length; /* Length of the byte array being converted */ + size_t length = 0; /* Length of the byte array being converted */ const char *bytesPtr; /* Pointer to the first byte of the array */ -#if TCL_MAJOR_VERSION > 8 || defined(TCL_NO_DEPRECATED) - int flags = TCL_ENCODING_STOPONERROR; -#else - int flags = TCL_ENCODING_NOCOMPLAIN; -#endif - int result; + int flags = 0; + size_t result; Tcl_Obj *failVarObj = NULL; /* * Decode parameters: @@ -593,7 +456,6 @@ EncodingConvertfromObjCmd( goto encConvFromError; } failVarObj = objv[2]; - flags = TCL_ENCODING_STOPONERROR; objcUnprocessed -= 2; } switch (objcUnprocessed) { @@ -617,12 +479,7 @@ EncodingConvertfromObjCmd( /* * Convert the string into a byte array in 'ds' */ -#if !defined(TCL_NO_DEPRECATED) && (TCL_MAJOR_VERSION < 9) - if (!(flags & TCL_ENCODING_STOPONERROR)) { - bytesPtr = (char *) Tcl_GetByteArrayFromObj(data, &length); - } else -#endif - bytesPtr = (char *) TclGetBytesFromObj(interp, data, &length); + bytesPtr = (char *) Tcl_GetBytesFromObj(interp, data, &length); if (bytesPtr == NULL) { return TCL_ERROR; } @@ -635,9 +492,9 @@ EncodingConvertfromObjCmd( } } else { char buf[TCL_INTEGER_SPACE]; - sprintf(buf, "%u", result); + sprintf(buf, "%" TCL_Z_MODIFIER "u", result); Tcl_SetObjResult(interp, Tcl_ObjPrintf("unexpected byte sequence starting at index %" - "u: '\\x%X'", result, UCHAR(bytesPtr[result]))); + TCL_Z_MODIFIER "u: '\\x%X'", result, UCHAR(bytesPtr[result]))); Tcl_SetErrorCode(interp, "TCL", "ENCODING", "ILLEGALSEQUENCE", buf, NULL); Tcl_DStringFree(&ds); @@ -689,14 +546,10 @@ EncodingConverttoObjCmd( Tcl_Obj *data; /* String to convert */ Tcl_DString ds; /* Buffer to hold the byte array */ Tcl_Encoding encoding; /* Encoding to use */ - int length; /* Length of the string being converted */ + size_t length; /* Length of the string being converted */ const char *stringPtr; /* Pointer to the first byte of the string */ - int result; -#if TCL_MAJOR_VERSION > 8 || defined(TCL_NO_DEPRECATED) - int flags = TCL_ENCODING_STOPONERROR; -#else - int flags = TCL_ENCODING_NOCOMPLAIN; -#endif + size_t result; + int flags = 0; Tcl_Obj *failVarObj = NULL; /* @@ -732,7 +585,6 @@ EncodingConverttoObjCmd( goto encConvToError; } failVarObj = objv[2]; - flags = TCL_ENCODING_STOPONERROR; objcUnprocessed -= 2; } switch (objcUnprocessed) { @@ -757,7 +609,7 @@ EncodingConverttoObjCmd( * Convert the string to a byte array in 'ds' */ - stringPtr = TclGetStringFromObj(data, &length); + stringPtr = Tcl_GetStringFromObj(data, &length); result = Tcl_UtfToExternalDStringEx(encoding, stringPtr, length, flags, &ds); if ((!(flags & TCL_ENCODING_NOCOMPLAIN) || ((flags & TCL_ENCODING_STRICT) == TCL_ENCODING_STRICT)) && (result != TCL_INDEX_NONE)) { @@ -771,7 +623,7 @@ EncodingConverttoObjCmd( int ucs4; char buf[TCL_INTEGER_SPACE]; TclUtfToUCS4(&stringPtr[result], &ucs4); - sprintf(buf, "%u", result); + sprintf(buf, "%" TCL_Z_MODIFIER "u", result); Tcl_SetObjResult(interp, Tcl_ObjPrintf("unexpected character at index %" TCL_Z_MODIFIER "u: 'U+%06X'", pos, ucs4)); Tcl_SetErrorCode(interp, "TCL", "ENCODING", "ILLEGALSEQUENCE", @@ -1988,7 +1840,7 @@ PathFilesystemCmd( if (fsInfo == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj("unrecognised path", -1)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "FILESYSTEM", - Tcl_GetString(objv[1]), NULL); + TclGetString(objv[1]), NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, fsInfo); @@ -2132,7 +1984,7 @@ PathSplitCmd( Tcl_WrongNumArgs(interp, 1, objv, "name"); return TCL_ERROR; } - res = Tcl_FSSplitPath(objv[1], (int *)NULL); + res = Tcl_FSSplitPath(objv[1], (size_t *)NULL); if (res == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not read \"%s\": no such file or directory", @@ -2240,7 +2092,7 @@ FilesystemSeparatorCmd( Tcl_SetObjResult(interp, Tcl_NewStringObj( "unrecognised path", -1)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "FILESYSTEM", - Tcl_GetString(objv[1]), NULL); + TclGetString(objv[1]), NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, separatorObj); @@ -2825,16 +2677,16 @@ EachloopCmd( */ statePtr = (struct ForeachState *)TclStackAlloc(interp, - sizeof(struct ForeachState) + 3 * numLists * sizeof(int) + sizeof(struct ForeachState) + 3 * numLists * sizeof(size_t) + 2 * numLists * (sizeof(Tcl_Obj **) + sizeof(Tcl_Obj *))); memset(statePtr, 0, - sizeof(struct ForeachState) + 3 * numLists * sizeof(int) + sizeof(struct ForeachState) + 3 * numLists * sizeof(size_t) + 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 = (int *) (statePtr->aCopyList + numLists); + statePtr->index = (size_t *) (statePtr->aCopyList + numLists); statePtr->varcList = statePtr->index + numLists; statePtr->argcList = statePtr->varcList + numLists; @@ -3011,7 +2863,8 @@ ForeachAssignments( Tcl_Interp *interp, struct ForeachState *statePtr) { - int i, v, k; + int i; + size_t v, k; Tcl_Obj *valuePtr, *varValuePtr; for (i=0 ; i<statePtr->numLists ; i++) { diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index e2493c4..2216745 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -20,6 +20,7 @@ #include "tclInt.h" #include "tclRegexp.h" #include "tclArithSeries.h" +#include "tclTomMath.h" #include <math.h> #include <assert.h> @@ -38,7 +39,7 @@ typedef struct SortElement { } collationKey; union { /* Object being sorted, or its index. */ Tcl_Obj *objPtr; - int index; + size_t index; } payload; struct SortElement *nextPtr;/* Next element in the list, or NULL for end * of list. */ @@ -73,7 +74,7 @@ typedef struct { * NULL if no indexes supplied, and points to * singleIndex field when only one * supplied. */ - int indexc; /* Number of indexes in indexv array. */ + size_t indexc; /* Number of indexes in indexv array. */ int singleIndex; /* Static space for common index case. */ int unique; int numElements; @@ -205,7 +206,7 @@ static const EnsembleImplMap defaultInfoMap[] = { int Tcl_IfObjCmd( - ClientData clientData, + void *clientData, Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -215,7 +216,7 @@ Tcl_IfObjCmd( int TclNRIfObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -238,13 +239,13 @@ TclNRIfObjCmd( TclNewObj(boolObj); Tcl_NRAddCallback(interp, IfConditionCallback, INT2PTR(objc), - (ClientData) objv, INT2PTR(1), boolObj); + (void *) objv, INT2PTR(1), boolObj); return Tcl_NRExprObj(interp, objv[1], boolObj); } static int IfConditionCallback( - ClientData data[], + void *data[], Tcl_Interp *interp, int result) { @@ -388,7 +389,7 @@ IfConditionCallback( int Tcl_IncrObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -469,7 +470,7 @@ TclInitInfoCmd( static int InfoArgsCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -532,7 +533,7 @@ InfoArgsCmd( static int InfoBodyCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -540,7 +541,7 @@ InfoBodyCmd( Interp *iPtr = (Interp *) interp; const char *name, *bytes; Proc *procPtr; - int numBytes; + size_t numBytes; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "procname"); @@ -565,7 +566,7 @@ InfoBodyCmd( * the object do not invalidate the internal rep. */ - bytes = TclGetStringFromObj(procPtr->bodyPtr, &numBytes); + bytes = Tcl_GetStringFromObj(procPtr->bodyPtr, &numBytes); Tcl_SetObjResult(interp, Tcl_NewStringObj(bytes, numBytes)); return TCL_OK; } @@ -593,7 +594,7 @@ InfoBodyCmd( static int InfoCmdCountCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -635,7 +636,7 @@ InfoCmdCountCmd( static int InfoCommandsCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -650,7 +651,7 @@ InfoCommandsCmd( Tcl_Obj *listPtr, *elemObjPtr; int specificNsInPattern = 0;/* Init. to avoid compiler warning. */ Tcl_Command cmd; - int i; + size_t i; /* * Get the pattern and find the "effective namespace" in which to list @@ -711,7 +712,7 @@ InfoCommandsCmd( if (entryPtr != NULL) { if (specificNsInPattern) { cmd = (Tcl_Command)Tcl_GetHashValue(entryPtr); - TclNewObj(elemObjPtr); + elemObjPtr = Tcl_NewObj(); Tcl_GetCommandFullName(interp, cmd, elemObjPtr); } else { cmdName = (const char *)Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr); @@ -762,7 +763,7 @@ InfoCommandsCmd( || Tcl_StringMatch(cmdName, simplePattern)) { if (specificNsInPattern) { cmd = (Tcl_Command)Tcl_GetHashValue(entryPtr); - TclNewObj(elemObjPtr); + elemObjPtr = Tcl_NewObj(); Tcl_GetCommandFullName(interp, cmd, elemObjPtr); } else { elemObjPtr = Tcl_NewStringObj(cmdName, -1); @@ -912,7 +913,7 @@ InfoCommandsCmd( static int InfoCompleteCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -949,7 +950,7 @@ InfoCompleteCmd( static int InfoDefaultCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -989,9 +990,8 @@ InfoDefaultCmd( } Tcl_SetObjResult(interp, Tcl_NewWideIntObj(1)); } else { - Tcl_Obj *nullObjPtr; + Tcl_Obj *nullObjPtr = Tcl_NewObj(); - TclNewObj(nullObjPtr); valueObjPtr = Tcl_ObjSetVar2(interp, objv[3], NULL, nullObjPtr, TCL_LEAVE_ERR_MSG); if (valueObjPtr == NULL) { @@ -1032,7 +1032,7 @@ InfoDefaultCmd( static int InfoErrorStackCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -1081,7 +1081,7 @@ InfoErrorStackCmd( int TclInfoExistsCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -1126,7 +1126,7 @@ TclInfoExistsCmd( static int InfoFrameCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -1396,7 +1396,7 @@ TclInfoFrame( ADD_PAIR("proc", procNameObj); } else if (procPtr->cmdPtr->clientData) { ExtraFrameInfo *efiPtr = (ExtraFrameInfo *)procPtr->cmdPtr->clientData; - int i; + size_t i; /* * This is a non-standard command. Luckily, it's told us how to @@ -1466,7 +1466,7 @@ TclInfoFrame( static int InfoFunctionsCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -1531,7 +1531,7 @@ InfoFunctionsCmd( static int InfoHostnameCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -1577,7 +1577,7 @@ InfoHostnameCmd( static int InfoLevelCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -1585,7 +1585,7 @@ InfoLevelCmd( Interp *iPtr = (Interp *) interp; if (objc == 1) { /* Just "info level" */ - Tcl_SetObjResult(interp, Tcl_NewWideIntObj(iPtr->varFramePtr->level)); + Tcl_SetObjResult(interp, Tcl_NewWideIntObj((int)iPtr->varFramePtr->level)); return TCL_OK; } @@ -1604,7 +1604,7 @@ InfoLevelCmd( } for (framePtr=iPtr->varFramePtr ; framePtr!=rootFramePtr; framePtr=framePtr->callerVarPtr) { - if (framePtr->level == level) { + if ((int)framePtr->level == level) { break; } } @@ -1651,7 +1651,7 @@ InfoLevelCmd( static int InfoLibraryCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -1698,7 +1698,7 @@ InfoLibraryCmd( static int InfoLoadedCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -1746,7 +1746,7 @@ InfoLoadedCmd( static int InfoNameOfExecutableCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -1782,7 +1782,7 @@ InfoNameOfExecutableCmd( static int InfoPatchLevelCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -1829,7 +1829,7 @@ InfoPatchLevelCmd( static int InfoProcsCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -1906,7 +1906,7 @@ InfoProcsCmd( } else { simpleProcOK: if (specificNsInPattern) { - TclNewObj(elemObjPtr); + elemObjPtr = Tcl_NewObj(); Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, elemObjPtr); } else { @@ -1927,15 +1927,15 @@ InfoProcsCmd( if (!TclIsProc(cmdPtr)) { realCmdPtr = (Command *) - TclGetOriginalCommand((Tcl_Command)cmdPtr); + TclGetOriginalCommand((Tcl_Command) cmdPtr); if (realCmdPtr != NULL && TclIsProc(realCmdPtr)) { goto procOK; } } else { procOK: if (specificNsInPattern) { - TclNewObj(elemObjPtr); - Tcl_GetCommandFullName(interp, (Tcl_Command)cmdPtr, + elemObjPtr = Tcl_NewObj(); + Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, elemObjPtr); } else { elemObjPtr = Tcl_NewStringObj(cmdName, -1); @@ -2016,7 +2016,7 @@ InfoProcsCmd( static int InfoScriptCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -2064,7 +2064,7 @@ InfoScriptCmd( static int InfoSharedlibCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -2102,7 +2102,7 @@ InfoSharedlibCmd( static int InfoTclVersionCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -2145,7 +2145,7 @@ InfoTclVersionCmd( static int InfoCmdTypeCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -2163,7 +2163,7 @@ InfoCmdTypeCmd( } /* - * There's one special case: safe interpreters can't see aliases as + * There's one special case: safe child interpreters can't see aliases as * aliases as they're part of the security mechanisms. */ @@ -2196,12 +2196,13 @@ InfoCmdTypeCmd( int Tcl_JoinObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { - int length, listLen, isArithSeries = 0; + size_t length, listLen; + int isArithSeries = 0; Tcl_Obj *resObjPtr = NULL, *joinObjPtr, **elemPtrs; if ((objc < 2) || (objc > 3)) { @@ -2245,13 +2246,13 @@ Tcl_JoinObjCmd( joinObjPtr = (objc == 2) ? Tcl_NewStringObj(" ", 1) : objv[2]; Tcl_IncrRefCount(joinObjPtr); - (void) TclGetStringFromObj(joinObjPtr, &length); + (void) Tcl_GetStringFromObj(joinObjPtr, &length); if (length == 0) { resObjPtr = TclStringCat(interp, listLen, elemPtrs, 0); } else { - int i; + size_t i; - TclNewObj(resObjPtr); + resObjPtr = Tcl_NewObj(); if (isArithSeries) { Tcl_Obj *valueObj; for (i = 0; i < listLen; i++) { @@ -2270,7 +2271,6 @@ Tcl_JoinObjCmd( return TCL_ERROR; } Tcl_AppendObjToObj(resObjPtr, valueObj); - Tcl_DecrRefCount(valueObj); } } else { for (i = 0; i < listLen; i++) { @@ -2316,14 +2316,14 @@ Tcl_JoinObjCmd( int Tcl_LassignObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *listCopyPtr; Tcl_Obj **listObjv; /* The contents of the list. */ - int listObjc; /* The length of the list. */ + size_t listObjc; /* The length of the list. */ int code = TCL_OK; if (objc < 2) { @@ -2390,7 +2390,7 @@ Tcl_LassignObjCmd( int Tcl_LindexObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -2448,13 +2448,14 @@ Tcl_LindexObjCmd( int Tcl_LinsertObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *listPtr; - int index, len, result; + size_t len, index; + int result; if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "list index ?element ...?"); @@ -2476,7 +2477,7 @@ Tcl_LinsertObjCmd( if (result != TCL_OK) { return result; } - if (index > len) { + if (index + 1 > len + 1) { index = len; } @@ -2530,7 +2531,7 @@ Tcl_LinsertObjCmd( int Tcl_ListObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) @@ -2566,13 +2567,14 @@ Tcl_ListObjCmd( int Tcl_LlengthObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int listLen, result; + size_t listLen; + int result; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "list"); @@ -2612,13 +2614,14 @@ Tcl_LlengthObjCmd( int Tcl_LpopObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int listLen, result; + size_t listLen; + int result; Tcl_Obj *elemPtr, *stored; Tcl_Obj *listPtr, **elemPtrs; @@ -2713,13 +2716,14 @@ Tcl_LpopObjCmd( int Tcl_LrangeObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int listLen, first, last, result; + int result; + size_t listLen, first, last; if (objc != 4) { Tcl_WrongNumArgs(interp, 1, objv, "list first last"); return TCL_ERROR; @@ -2778,8 +2782,8 @@ LremoveIndexCompare( const void *el1Ptr, const void *el2Ptr) { - int idx1 = *((const int *) el1Ptr); - int idx2 = *((const int *) el2Ptr); + size_t idx1 = *((const size_t *) el1Ptr); + size_t idx2 = *((const size_t *) el2Ptr); /* * This will put the larger element first. @@ -2790,13 +2794,13 @@ LremoveIndexCompare( int Tcl_LremoveObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int i, idxc, listLen, prevIdx, first, num; - int *idxv; + int i, idxc, prevIdx, first, num; + size_t *idxv, listLen; Tcl_Obj *listObj; /* @@ -2818,11 +2822,11 @@ Tcl_LremoveObjCmd( Tcl_SetObjResult(interp, listObj); return TCL_OK; } - idxv = (int *)ckalloc((objc - 2) * sizeof(int)); + idxv = (size_t *)Tcl_Alloc((objc - 2) * sizeof(size_t)); for (i = 2; i < objc; i++) { if (TclGetIntForIndexM(interp, objv[i], /*endValue*/ listLen - 1, &idxv[i - 2]) != TCL_OK) { - ckfree(idxv); + Tcl_Free(idxv); return TCL_ERROR; } } @@ -2833,7 +2837,7 @@ Tcl_LremoveObjCmd( */ if (idxc > 1) { - qsort(idxv, idxc, sizeof(int), LremoveIndexCompare); + qsort(idxv, idxc, sizeof(size_t), LremoveIndexCompare); } /* @@ -2856,7 +2860,7 @@ Tcl_LremoveObjCmd( continue; } prevIdx = idx; - if (idx < 0 || idx >= listLen) { + if (idx < 0 || idx >= (int)listLen) { continue; } @@ -2885,7 +2889,7 @@ Tcl_LremoveObjCmd( if (num != 0) { (void) Tcl_ListObjReplace(interp, listObj, first, num, 0, NULL); } - ckfree(idxv); + Tcl_Free(idxv); Tcl_SetObjResult(interp, listObj); return TCL_OK; } @@ -2909,7 +2913,7 @@ Tcl_LremoveObjCmd( int Tcl_LrepeatObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) @@ -2947,9 +2951,9 @@ Tcl_LrepeatObjCmd( /* Final sanity check. Do not exceed limits on max list length. */ - if (elementCount && objc > LIST_MAX/elementCount) { + if (elementCount && (size_t)objc > LIST_MAX/elementCount) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "max length of a Tcl list (%d elements) exceeded", LIST_MAX)); + "max length of a Tcl list (%" TCL_Z_MODIFIER "u elements) exceeded", LIST_MAX)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); return TCL_ERROR; } @@ -3023,14 +3027,14 @@ Tcl_LrepeatObjCmd( int Tcl_LreplaceObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *listPtr; - int first, last; - int listLen, numToDelete, result; + size_t numToDelete, listLen, first, last; + int result; if (objc < 4) { Tcl_WrongNumArgs(interp, 1, objv, @@ -3065,10 +3069,10 @@ Tcl_LreplaceObjCmd( first = listLen; } - if (last >= listLen) { + if (last + 1 > listLen) { last = listLen - 1; } - if (first <= last) { + if (first + 1 <= last + 1) { numToDelete = last - first + 1; } else { numToDelete = 0; @@ -3124,13 +3128,13 @@ Tcl_LreplaceObjCmd( int Tcl_LreverseObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument values. */ { Tcl_Obj **elemv; - int elemc, i, j; + size_t elemc, i, j; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "list"); @@ -3226,17 +3230,17 @@ Tcl_LreverseObjCmd( int Tcl_LsearchObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument values. */ { const char *bytes, *patternBytes; - int i, match, index, result=TCL_OK, listc, bisect; - int length, elemLen, start, groupSize, groupOffset, lower, upper; + int match, index, result=TCL_OK, bisect; + size_t i, length = 0, listc, elemLen, start, groupSize, groupOffset, lower, upper; int allocatedIndexVector = 0; - int dataType, isIncreasing; - Tcl_WideInt patWide, objWide; + int isIncreasing; + Tcl_WideInt patWide, objWide, wide; int allMatches, inlineReturn, negatedMatch, returnSubindices, noCase; double patDouble, objDouble; SortInfo sortInfo; @@ -3259,7 +3263,7 @@ Tcl_LsearchObjCmd( }; enum datatypes { ASCII, DICTIONARY, INTEGER, REAL - }; + } dataType; enum modes { EXACT, GLOB, REGEXP, SORTED }; @@ -3292,13 +3296,14 @@ Tcl_LsearchObjCmd( return TCL_ERROR; } - for (i = 1; i < objc-2; i++) { - if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, &index) + for (i = 1; i < (size_t)objc-2; i++) { + enum lsearchoptions idx; + if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, &idx) != TCL_OK) { result = TCL_ERROR; goto done; } - switch ((enum lsearchoptions) index) { + switch (idx) { case LSEARCH_ALL: /* -all */ allMatches = 1; break; @@ -3361,7 +3366,7 @@ Tcl_LsearchObjCmd( Tcl_DecrRefCount(startPtr); startPtr = NULL; } - if (i > objc-4) { + if (i + 4 > (size_t)objc) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "missing starting index", -1)); Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL); @@ -3384,7 +3389,7 @@ Tcl_LsearchObjCmd( Tcl_IncrRefCount(startPtr); break; case LSEARCH_STRIDE: /* -stride */ - if (i > objc-4) { + if (i + 4 > (size_t)objc) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "\"-stride\" option must be " "followed by stride length", -1)); @@ -3392,11 +3397,11 @@ Tcl_LsearchObjCmd( result = TCL_ERROR; goto done; } - if (Tcl_GetIntFromObj(interp, objv[i+1], &groupSize) != TCL_OK) { + if (Tcl_GetWideIntFromObj(interp, objv[i+1], &wide) != TCL_OK) { result = TCL_ERROR; goto done; } - if (groupSize < 1) { + if (wide < 1) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "stride length must be at least 1", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH", @@ -3404,17 +3409,18 @@ Tcl_LsearchObjCmd( result = TCL_ERROR; goto done; } + groupSize = wide; i++; break; case LSEARCH_INDEX: { /* -index */ Tcl_Obj **indices; - int j; + size_t j; if (allocatedIndexVector) { TclStackFree(interp, sortInfo.indexv); allocatedIndexVector = 0; } - if (i > objc-4) { + if (i + 4 > (size_t)objc) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "\"-index\" option must be followed by list index", -1)); @@ -3471,7 +3477,7 @@ Tcl_LsearchObjCmd( } if (result == TCL_ERROR) { Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( - "\n (-index option item number %d)", j)); + "\n (-index option item number %" TCL_Z_MODIFIER "u)", j)); goto done; } sortInfo.indexv[j] = encoded; @@ -3563,7 +3569,7 @@ Tcl_LsearchObjCmd( */ groupOffset = TclIndexDecode(sortInfo.indexv[0], groupSize - 1); - if (groupOffset < 0 || groupOffset >= groupSize) { + if (groupOffset >= groupSize) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "when used with \"-stride\", the leading \"-index\"" " value must be within the group", -1)); @@ -3603,7 +3609,7 @@ Tcl_LsearchObjCmd( * "did not match anything at all" result straight away. [Bug 1374778] */ - if (start > listc-1) { + if (start >= (size_t)listc) { if (allMatches || inlineReturn) { Tcl_ResetResult(interp); } else { @@ -3625,10 +3631,10 @@ Tcl_LsearchObjCmd( patObj = objv[objc - 1]; patternBytes = NULL; if (mode == EXACT || mode == SORTED) { - switch ((enum datatypes) dataType) { + switch (dataType) { case ASCII: case DICTIONARY: - patternBytes = TclGetStringFromObj(patObj, &length); + patternBytes = Tcl_GetStringFromObj(patObj, &length); break; case INTEGER: result = TclGetWideIntFromObj(interp, patObj, &patWide); @@ -3658,7 +3664,7 @@ Tcl_LsearchObjCmd( break; } } else { - patternBytes = TclGetStringFromObj(patObj, &length); + patternBytes = Tcl_GetStringFromObj(patObj, &length); } /* @@ -3695,7 +3701,7 @@ Tcl_LsearchObjCmd( } else { itemPtr = listv[i+groupOffset]; } - switch ((enum datatypes) dataType) { + switch (dataType) { case ASCII: bytes = TclGetString(itemPtr); match = strCmpFn(patternBytes, bytes); @@ -3800,9 +3806,9 @@ Tcl_LsearchObjCmd( switch (mode) { case SORTED: case EXACT: - switch ((enum datatypes) dataType) { + switch (dataType) { case ASCII: - bytes = TclGetStringFromObj(itemPtr, &elemLen); + bytes = Tcl_GetStringFromObj(itemPtr, &elemLen); if (length == elemLen) { /* * This split allows for more optimal compilation of @@ -3894,12 +3900,13 @@ Tcl_LsearchObjCmd( Tcl_ListObjAppendElement(interp, listPtr, itemPtr); } } else if (returnSubindices) { - int j; + size_t j; TclNewIndexObj(itemPtr, i+groupOffset); for (j=0 ; j<sortInfo.indexc ; j++) { Tcl_Obj *elObj; - TclNewIndexObj(elObj, TclIndexDecode(sortInfo.indexv[j], listc)); + size_t elValue = TclIndexDecode(sortInfo.indexv[j], listc); + TclNewIndexObj(elObj, elValue); Tcl_ListObjAppendElement(interp, itemPtr, elObj); } Tcl_ListObjAppendElement(interp, listPtr, itemPtr); @@ -3917,12 +3924,13 @@ Tcl_LsearchObjCmd( Tcl_SetObjResult(interp, listPtr); } else if (!inlineReturn) { if (returnSubindices) { - int j; + size_t j; TclNewIndexObj(itemPtr, index+groupOffset); for (j=0 ; j<sortInfo.indexc ; j++) { Tcl_Obj *elObj; - TclNewIndexObj(elObj, TclIndexDecode(sortInfo.indexv[j], listc)); + size_t elValue = TclIndexDecode(sortInfo.indexv[j], listc); + TclNewIndexObj(elObj, elValue); Tcl_ListObjAppendElement(interp, itemPtr, elObj); } Tcl_SetObjResult(interp, itemPtr); @@ -3983,7 +3991,7 @@ Tcl_LsearchObjCmd( int Tcl_LsetObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument values. */ @@ -4179,7 +4187,7 @@ SequenceIdentifyArgument( int Tcl_LseqObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ @@ -4468,16 +4476,18 @@ Tcl_LseqObjCmd( int Tcl_LsortObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument values. */ { - int i, j, index, indices, length, nocase = 0, indexc; + int indices, nocase = 0, indexc; int sortMode = SORTMODE_ASCII; - int group, groupSize, groupOffset, idx, allocatedIndexVector = 0; + int group, allocatedIndexVector = 0; + size_t j, idx, groupSize, groupOffset, length; + Tcl_WideInt wide; Tcl_Obj *resultPtr, *cmdPtr, **listObjPtrs, *listObj, *indexPtr; - size_t elmArrSize; + size_t i, elmArrSize; SortElement *elementArray = NULL, *elementPtr; SortInfo sortInfo; /* Information about this sort that needs to * be passed to the comparison function. */ @@ -4497,7 +4507,7 @@ Tcl_LsortObjCmd( LSORT_ASCII, LSORT_COMMAND, LSORT_DECREASING, LSORT_DICTIONARY, LSORT_INCREASING, LSORT_INDEX, LSORT_INDICES, LSORT_INTEGER, LSORT_NOCASE, LSORT_REAL, LSORT_STRIDE, LSORT_UNIQUE - }; + } index; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "?-option value ...? list"); @@ -4521,18 +4531,18 @@ Tcl_LsortObjCmd( groupSize = 1; groupOffset = 0; indexPtr = NULL; - for (i = 1; i < objc-1; i++) { + for (i = 1; i < (size_t)objc-1; i++) { if (Tcl_GetIndexFromObj(interp, objv[i], switches, "option", 0, &index) != TCL_OK) { sortInfo.resultCode = TCL_ERROR; goto done; } - switch ((enum Lsort_Switches) index) { + switch (index) { case LSORT_ASCII: sortInfo.sortMode = SORTMODE_ASCII; break; case LSORT_COMMAND: - if (i == objc-2) { + if (i + 2 == (size_t)objc) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "\"-command\" option must be followed " "by comparison command", -1)); @@ -4554,10 +4564,10 @@ Tcl_LsortObjCmd( sortInfo.isIncreasing = 1; break; case LSORT_INDEX: { - int sortindex; + size_t sortindex; Tcl_Obj **indexv; - if (i == objc-2) { + if (i + 2 == (size_t)objc) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "\"-index\" option must be followed by list index", -1)); @@ -4594,7 +4604,7 @@ Tcl_LsortObjCmd( } if (result == TCL_ERROR) { Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( - "\n (-index option item number %d)", j)); + "\n (-index option item number %" TCL_Z_MODIFIER "u)", j)); sortInfo.resultCode = TCL_ERROR; goto done; } @@ -4619,7 +4629,7 @@ Tcl_LsortObjCmd( indices = 1; break; case LSORT_STRIDE: - if (i == objc-2) { + if (i + 2 == (size_t)objc) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "\"-stride\" option must be " "followed by stride length", -1)); @@ -4627,11 +4637,11 @@ Tcl_LsortObjCmd( sortInfo.resultCode = TCL_ERROR; goto done; } - if (Tcl_GetIntFromObj(interp, objv[i+1], &groupSize) != TCL_OK) { + if (Tcl_GetWideIntFromObj(interp, objv[i+1], &wide) != TCL_OK) { sortInfo.resultCode = TCL_ERROR; goto done; } - if (groupSize < 2) { + if (wide < 2) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "stride length must be at least 2", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSORT", @@ -4639,6 +4649,7 @@ Tcl_LsortObjCmd( sortInfo.resultCode = TCL_ERROR; goto done; } + groupSize = wide; group = 1; i++; break; @@ -4751,7 +4762,7 @@ Tcl_LsortObjCmd( */ groupOffset = TclIndexDecode(sortInfo.indexv[0], groupSize - 1); - if (groupOffset < 0 || groupOffset >= groupSize) { + if (groupOffset >= groupSize) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "when used with \"-stride\", the leading \"-index\"" " value must be within the group", -1)); @@ -4811,13 +4822,13 @@ Tcl_LsortObjCmd( elmArrSize = length * sizeof(SortElement); if (elmArrSize <= MAXCALLOC) { - elementArray = (SortElement *)ckalloc(elmArrSize); + elementArray = (SortElement *)Tcl_Alloc(elmArrSize); } else { elementArray = (SortElement *)malloc(elmArrSize); } if (!elementArray) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "no enough memory to proccess sort of %d items", length)); + "no enough memory to proccess sort of %" TCL_Z_MODIFIER "u items", length)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); sortInfo.resultCode = TCL_ERROR; goto done; @@ -4959,7 +4970,7 @@ Tcl_LsortObjCmd( } if (elementArray) { if (elmArrSize <= MAXCALLOC) { - ckfree((char *)elementArray); + Tcl_Free(elementArray); } else { free((char *)elementArray); } @@ -4986,7 +4997,7 @@ Tcl_LsortObjCmd( int Tcl_LeditObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument values. */ @@ -4995,10 +5006,10 @@ Tcl_LeditObjCmd( Tcl_Obj *finalValuePtr; /* Value finally assigned to the variable. */ int createdNewObj; int result; - int first; - int last; - int listLen; - int numToDelete; + size_t first; + size_t last; + size_t listLen; + size_t numToDelete; if (objc < 4) { Tcl_WrongNumArgs(interp, 1, objv, @@ -5037,10 +5048,11 @@ Tcl_LeditObjCmd( first = listLen; } - if (last >= listLen) { + /* The +1 in comparisons are necessitated by indices being unsigned */ + if ((last + 1) > listLen) { last = listLen - 1; } - if (first <= last) { + if ((first + 1) <= (last + 1)) { numToDelete = last - first + 1; } else { numToDelete = 0; @@ -5063,7 +5075,7 @@ Tcl_LeditObjCmd( } /* - * Tcl_ObjSetVar2 mau return a value different from listPtr in the + * Tcl_ObjSetVar2 may return a value different from listPtr in the * presence of traces etc.. Note that finalValuePtr will always have a * reference count of at least 1 corresponding to the reference from the * var. If it is same as listPtr, then ref count will be at least 2 @@ -5236,7 +5248,7 @@ SortCompare( order = ((a >= b) - (a <= b)); } else { Tcl_Obj **objv, *paramObjv[2]; - int objc; + size_t objc; Tcl_Obj *objPtr1, *objPtr2; if (infoPtr->resultCode != TCL_OK) { @@ -5454,7 +5466,7 @@ SelectObjFromSublist( SortInfo *infoPtr) /* Information passed from the top-level * "lsearch" or "lsort" command. */ { - int i; + size_t i; /* * Quick check for case when no "-index" option is there. @@ -5470,7 +5482,8 @@ SelectObjFromSublist( */ for (i=0 ; i<infoPtr->indexc ; i++) { - int listLen, index; + size_t listLen; + int index; Tcl_Obj *currentObj; if (TclListObjLengthM(infoPtr->interp, objPtr, &listLen) != TCL_OK) { diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 57541f9..26cbbe4 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -20,6 +20,7 @@ #include "tclCompile.h" #include "tclRegexp.h" #include "tclStringTrim.h" +#include "tclTomMath.h" static inline Tcl_Obj * During(Tcl_Interp *interp, int resultCode, Tcl_Obj *oldOptions, Tcl_Obj *errorInfo); @@ -82,7 +83,7 @@ const char tclDefaultTrimSet[] = int Tcl_PwdObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -122,13 +123,13 @@ Tcl_PwdObjCmd( int Tcl_RegexpObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int i, indices, match, about, offset, all, doinline, numMatchesSaved; - int cflags, eflags, stringLength, matchLength; + size_t offset, stringLength, matchLength, cflags, eflags; + int i, indices, match, about, all, doinline, numMatchesSaved; Tcl_RegExp regExpr; Tcl_Obj *objPtr, *startIndex = NULL, *resultPtr = NULL; Tcl_RegExpInfo info; @@ -141,18 +142,17 @@ Tcl_RegexpObjCmd( REGEXP_ALL, REGEXP_ABOUT, REGEXP_INDICES, REGEXP_INLINE, REGEXP_EXPANDED,REGEXP_LINE, REGEXP_LINESTOP,REGEXP_LINEANCHOR, REGEXP_NOCASE, REGEXP_START, REGEXP_LAST - }; + } index; indices = 0; about = 0; cflags = TCL_REG_ADVANCED; - offset = 0; + offset = TCL_INDEX_START; all = 0; doinline = 0; for (i = 1; i < objc; i++) { const char *name; - int index; name = TclGetString(objv[i]); if (name[0] != '-') { @@ -162,7 +162,7 @@ Tcl_RegexpObjCmd( &index) != TCL_OK) { goto optionError; } - switch ((enum regexpoptions) index) { + switch (index) { case REGEXP_ALL: all = 1; break; @@ -191,11 +191,11 @@ Tcl_RegexpObjCmd( cflags |= TCL_REG_NLANCH; break; case REGEXP_START: { - int temp; + size_t temp; if (++i >= objc) { goto endOfForLoop; } - if (TclGetIntForIndexM(interp, objv[i], INT_MAX - 1, &temp) != TCL_OK) { + if (TclGetIntForIndexM(interp, objv[i], (size_t)WIDE_MAX - 1, &temp) != TCL_OK) { goto optionError; } if (startIndex) { @@ -256,13 +256,13 @@ Tcl_RegexpObjCmd( */ objPtr = objv[1]; - stringLength = TclGetCharLength(objPtr); + stringLength = Tcl_GetCharLength(objPtr); if (startIndex) { TclGetIntForIndexM(interp, startIndex, stringLength, &offset); Tcl_DecrRefCount(startIndex); - if (offset < 0) { - offset = 0; + if (offset == TCL_INDEX_NONE) { + offset = TCL_INDEX_START; } } @@ -306,11 +306,11 @@ Tcl_RegexpObjCmd( * start of the string unless the previous character is a newline. */ - if (offset == 0) { + if (offset == TCL_INDEX_START) { eflags = 0; - } else if (offset > stringLength) { + } else if (offset + 1 > stringLength + 1) { eflags = TCL_REG_NOTBOL; - } else if (TclGetUniChar(objPtr, offset-1) == '\n') { + } else if (Tcl_GetUniChar(objPtr, offset-1) == '\n') { eflags = 0; } else { eflags = TCL_REG_NOTBOL; @@ -357,14 +357,14 @@ Tcl_RegexpObjCmd( objc = info.nsubs + 1; if (all <= 1) { - TclNewObj(resultPtr); + resultPtr = Tcl_NewObj(); } } for (i = 0; i < objc; i++) { Tcl_Obj *newPtr; if (indices) { - int start, end; + size_t start, end; Tcl_Obj *objs[2]; /* @@ -372,7 +372,7 @@ Tcl_RegexpObjCmd( * area. (Scriptics Bug 4391/SF Bug #219232) */ - if (i <= info.nsubs && info.matches[i].start >= 0) { + if (i <= (int)info.nsubs && info.matches[i].start != TCL_INDEX_NONE) { 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 >= offset) { + if (end + 1 >= offset + 1) { end--; } } else { @@ -394,12 +394,12 @@ Tcl_RegexpObjCmd( newPtr = Tcl_NewListObj(2, objs); } else { - if ((i <= info.nsubs) && (info.matches[i].end > 0)) { - newPtr = TclGetRange(objPtr, + if ((i <= (int)info.nsubs) && (info.matches[i].end + 1 > 1)) { + newPtr = Tcl_GetRange(objPtr, offset + info.matches[i].start, offset + info.matches[i].end - 1); } else { - TclNewObj(newPtr); + newPtr = Tcl_NewObj(); } } if (doinline) { @@ -444,7 +444,7 @@ Tcl_RegexpObjCmd( offset++; } all++; - if (offset >= stringLength) { + if (offset + 1 >= stringLength + 1) { break; } } @@ -482,13 +482,14 @@ Tcl_RegexpObjCmd( int Tcl_RegsubObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int idx, result, cflags, all, wlen, wsublen, numMatches, offset; - int start, end, subStart, subEnd, match, command, numParts; + int result, cflags, all, match, command; + size_t idx, wlen, wsublen = 0, offset, numMatches, numParts; + size_t start, end, subStart, subEnd; Tcl_RegExp regExpr; Tcl_RegExpInfo info; Tcl_Obj *resultPtr, *subPtr, *objPtr, *startIndex = NULL; @@ -503,17 +504,16 @@ Tcl_RegsubObjCmd( REGSUB_ALL, REGSUB_COMMAND, REGSUB_EXPANDED, REGSUB_LINE, REGSUB_LINESTOP, REGSUB_LINEANCHOR, REGSUB_NOCASE, REGSUB_START, REGSUB_LAST - }; + } index; cflags = TCL_REG_ADVANCED; all = 0; - offset = 0; + offset = TCL_INDEX_START; command = 0; resultPtr = NULL; - for (idx = 1; idx < objc; idx++) { + for (idx = 1; idx < (size_t)objc; idx++) { const char *name; - int index; name = TclGetString(objv[idx]); if (name[0] != '-') { @@ -523,7 +523,7 @@ Tcl_RegsubObjCmd( TCL_EXACT, &index) != TCL_OK) { goto optionError; } - switch ((enum regsubobjoptions) index) { + switch (index) { case REGSUB_ALL: all = 1; break; @@ -546,11 +546,11 @@ Tcl_RegsubObjCmd( cflags |= TCL_REG_NLANCH; break; case REGSUB_START: { - int temp; - if (++idx >= objc) { + size_t temp; + if (++idx >= (size_t)objc) { goto endOfForLoop; } - if (TclGetIntForIndexM(interp, objv[idx], INT_MAX - 1, &temp) != TCL_OK) { + if (TclGetIntForIndexM(interp, objv[idx], (size_t)WIDE_MAX - 1, &temp) != TCL_OK) { goto optionError; } if (startIndex) { @@ -567,7 +567,7 @@ Tcl_RegsubObjCmd( } endOfForLoop: - if (objc-idx < 3 || objc-idx > 4) { + if ((size_t)objc < idx + 3 || (size_t)objc > idx + 4) { Tcl_WrongNumArgs(interp, 1, objv, "?-option ...? exp string subSpec ?varName?"); optionError: @@ -581,16 +581,16 @@ Tcl_RegsubObjCmd( objv += idx; if (startIndex) { - int stringLength = TclGetCharLength(objv[1]); + size_t stringLength = Tcl_GetCharLength(objv[1]); TclGetIntForIndexM(interp, startIndex, stringLength, &offset); Tcl_DecrRefCount(startIndex); - if (offset < 0) { - offset = 0; + if (offset == TCL_INDEX_NONE) { + offset = TCL_INDEX_START; } } - if (all && (offset == 0) && (command == 0) + if (all && (offset == TCL_INDEX_START) && (command == 0) && (strpbrk(TclGetString(objv[2]), "&\\") == NULL) && (strpbrk(TclGetString(objv[0]), "*+?{}()[].\\|^$") == NULL)) { /* @@ -598,17 +598,18 @@ Tcl_RegsubObjCmd( * slightly modified version of the one pair STR_MAP code. */ - int slen, nocase, wsrclc; - int (*strCmpFn)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned long); + size_t slen; + int nocase, wsrclc; + int (*strCmpFn)(const Tcl_UniChar*,const Tcl_UniChar*,size_t); Tcl_UniChar *p; numMatches = 0; nocase = (cflags & TCL_REG_NOCASE); strCmpFn = nocase ? TclUniCharNcasecmp : TclUniCharNcmp; - wsrc = TclGetUnicodeFromObj_(objv[0], &slen); - wstring = TclGetUnicodeFromObj_(objv[1], &wlen); - wsubspec = TclGetUnicodeFromObj_(objv[2], &wsublen); + wsrc = Tcl_GetUnicodeFromObj(objv[0], &slen); + wstring = Tcl_GetUnicodeFromObj(objv[1], &wlen); + wsubspec = Tcl_GetUnicodeFromObj(objv[2], &wsublen); wend = wstring + wlen - (slen ? slen - 1 : 0); result = TCL_OK; @@ -619,11 +620,11 @@ Tcl_RegsubObjCmd( */ if (wstring < wend) { - resultPtr = TclNewUnicodeObj(wstring, 0); + resultPtr = Tcl_NewUnicodeObj(wstring, 0); Tcl_IncrRefCount(resultPtr); for (; wstring < wend; wstring++) { - TclAppendUnicodeToObj(resultPtr, wsubspec, wsublen); - TclAppendUnicodeToObj(resultPtr, wstring, 1); + Tcl_AppendUnicodeToObj(resultPtr, wsubspec, wsublen); + Tcl_AppendUnicodeToObj(resultPtr, wstring, 1); numMatches++; } wlen = 0; @@ -633,21 +634,20 @@ Tcl_RegsubObjCmd( for (p = wfirstChar = wstring; wstring < wend; wstring++) { if ((*wstring == *wsrc || (nocase && Tcl_UniCharToLower(*wstring)==wsrclc)) && - (slen==1 || (strCmpFn(wstring, wsrc, - (unsigned long) slen) == 0))) { + (slen==1 || (strCmpFn(wstring, wsrc, slen) == 0))) { if (numMatches == 0) { - resultPtr = TclNewUnicodeObj(wstring, 0); + resultPtr = Tcl_NewUnicodeObj(wstring, 0); Tcl_IncrRefCount(resultPtr); } if (p != wstring) { - TclAppendUnicodeToObj(resultPtr, p, wstring - p); + Tcl_AppendUnicodeToObj(resultPtr, p, wstring - p); p = wstring + slen; } else { p += slen; } wstring = p - 1; - TclAppendUnicodeToObj(resultPtr, wsubspec, wsublen); + Tcl_AppendUnicodeToObj(resultPtr, wsubspec, wsublen); numMatches++; } } @@ -699,14 +699,14 @@ Tcl_RegsubObjCmd( } else { objPtr = objv[1]; } - wstring = TclGetUnicodeFromObj_(objPtr, &wlen); + wstring = Tcl_GetUnicodeFromObj(objPtr, &wlen); if (objv[2] == objv[0]) { subPtr = Tcl_DuplicateObj(objv[2]); } else { subPtr = objv[2]; } if (!command) { - wsubspec = TclGetUnicodeFromObj_(subPtr, &wsublen); + wsubspec = Tcl_GetUnicodeFromObj(subPtr, &wsublen); } result = TCL_OK; @@ -742,15 +742,15 @@ Tcl_RegsubObjCmd( break; } if (numMatches == 0) { - resultPtr = TclNewUnicodeObj(wstring, 0); + resultPtr = Tcl_NewUnicodeObj(wstring, 0); Tcl_IncrRefCount(resultPtr); - if (offset > 0) { + if (offset > TCL_INDEX_START) { /* * Copy the initial portion of the string in if an offset was * specified. */ - TclAppendUnicodeToObj(resultPtr, wstring, offset); + Tcl_AppendUnicodeToObj(resultPtr, wstring, offset); } } numMatches++; @@ -763,7 +763,7 @@ Tcl_RegsubObjCmd( Tcl_RegExpGetInfo(regExpr, &info); start = info.matches[0].start; end = info.matches[0].end; - TclAppendUnicodeToObj(resultPtr, wstring + offset, start); + Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, start); /* * In command-prefix mode, the substitutions are added as quoted @@ -774,21 +774,21 @@ Tcl_RegsubObjCmd( if (command) { Tcl_Obj **args = NULL, **parts; - int numArgs; + size_t numArgs; TclListObjGetElementsM(interp, subPtr, &numParts, &parts); numArgs = numParts + info.nsubs + 1; - args = (Tcl_Obj **)ckalloc(sizeof(Tcl_Obj*) * numArgs); + args = (Tcl_Obj **)Tcl_Alloc(sizeof(Tcl_Obj*) * numArgs); memcpy(args, parts, sizeof(Tcl_Obj*) * numParts); for (idx = 0 ; idx <= info.nsubs ; idx++) { subStart = info.matches[idx].start; subEnd = info.matches[idx].end; - if ((subStart >= 0) && (subEnd >= 0)) { - args[idx + numParts] = TclNewUnicodeObj( + if ((subStart != TCL_INDEX_NONE) && (subEnd != TCL_INDEX_NONE)) { + args[idx + numParts] = Tcl_NewUnicodeObj( wstring + offset + subStart, subEnd - subStart); } else { - TclNewObj(args[idx + numParts]); + args[idx + numParts] = Tcl_NewObj(); } Tcl_IncrRefCount(args[idx + numParts]); } @@ -808,7 +808,7 @@ Tcl_RegsubObjCmd( for (idx = 0 ; idx <= info.nsubs ; idx++) { TclDecrRefCount(args[idx + numParts]); } - ckfree(args); + Tcl_Free(args); if (result != TCL_OK) { if (result == TCL_ERROR) { Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( @@ -826,7 +826,7 @@ Tcl_RegsubObjCmd( * the user code. */ - wstring = TclGetUnicodeFromObj_(objPtr, &wlen); + wstring = Tcl_GetUnicodeFromObj(objPtr, &wlen); offset += end; if (end == 0 || start == end) { @@ -838,7 +838,7 @@ Tcl_RegsubObjCmd( */ if (offset < wlen) { - TclAppendUnicodeToObj(resultPtr, wstring + offset, 1); + Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, 1); } offset++; } @@ -867,7 +867,7 @@ Tcl_RegsubObjCmd( idx = ch - '0'; } else if ((ch == '\\') || (ch == '&')) { *wsrc = ch; - TclAppendUnicodeToObj(resultPtr, wfirstChar, + Tcl_AppendUnicodeToObj(resultPtr, wfirstChar, wsrc - wfirstChar + 1); *wsrc = '\\'; wfirstChar = wsrc + 2; @@ -881,15 +881,15 @@ Tcl_RegsubObjCmd( } if (wfirstChar != wsrc) { - TclAppendUnicodeToObj(resultPtr, wfirstChar, + Tcl_AppendUnicodeToObj(resultPtr, wfirstChar, wsrc - wfirstChar); } if (idx <= info.nsubs) { subStart = info.matches[idx].start; subEnd = info.matches[idx].end; - if ((subStart >= 0) && (subEnd >= 0)) { - TclAppendUnicodeToObj(resultPtr, + if ((subStart != TCL_INDEX_NONE) && (subEnd != TCL_INDEX_NONE)) { + Tcl_AppendUnicodeToObj(resultPtr, wstring + offset + subStart, subEnd - subStart); } } @@ -901,7 +901,7 @@ Tcl_RegsubObjCmd( } if (wfirstChar != wsrc) { - TclAppendUnicodeToObj(resultPtr, wfirstChar, wsrc - wfirstChar); + Tcl_AppendUnicodeToObj(resultPtr, wfirstChar, wsrc - wfirstChar); } if (end == 0) { @@ -911,7 +911,7 @@ Tcl_RegsubObjCmd( */ if (offset < wlen) { - TclAppendUnicodeToObj(resultPtr, wstring + offset, 1); + Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, 1); } offset++; } else { @@ -923,7 +923,7 @@ Tcl_RegsubObjCmd( */ if (offset < wlen) { - TclAppendUnicodeToObj(resultPtr, wstring + offset, 1); + Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, 1); } offset++; } @@ -948,7 +948,7 @@ Tcl_RegsubObjCmd( resultPtr = objv[1]; Tcl_IncrRefCount(resultPtr); } else if (offset < wlen) { - TclAppendUnicodeToObj(resultPtr, wstring + offset, wlen - offset); + Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, wlen - offset); } if (objc == 4) { if (Tcl_ObjSetVar2(interp, objv[3], NULL, resultPtr, @@ -1002,7 +1002,7 @@ Tcl_RegsubObjCmd( int Tcl_RenameObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -1038,7 +1038,7 @@ Tcl_RenameObjCmd( int Tcl_ReturnObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -1085,7 +1085,7 @@ Tcl_ReturnObjCmd( int Tcl_SourceObjCmd( - ClientData clientData, + void *clientData, Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -1095,7 +1095,7 @@ Tcl_SourceObjCmd( int TclNRSourceObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -1169,7 +1169,7 @@ TclNRSourceObjCmd( int Tcl_SplitObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -1179,22 +1179,22 @@ Tcl_SplitObjCmd( const char *splitChars; const char *stringPtr; const char *end; - int splitCharLen, stringLen; + size_t splitCharLen, stringLen; Tcl_Obj *listPtr, *objPtr; if (objc == 2) { splitChars = " \n\t\r"; splitCharLen = 4; } else if (objc == 3) { - splitChars = TclGetStringFromObj(objv[2], &splitCharLen); + splitChars = Tcl_GetStringFromObj(objv[2], &splitCharLen); } else { Tcl_WrongNumArgs(interp, 1, objv, "string ?splitChars?"); return TCL_ERROR; } - stringPtr = TclGetStringFromObj(objv[1], &stringLen); + stringPtr = Tcl_GetStringFromObj(objv[1], &stringLen); end = stringPtr + stringLen; - TclNewObj(listPtr); + listPtr = Tcl_NewObj(); if (stringLen == 0) { /* @@ -1243,7 +1243,7 @@ Tcl_SplitObjCmd( * byte in length. */ - while (*stringPtr && (p=strchr(stringPtr,(int)*splitChars)) != NULL) { + while (*stringPtr && (p=strchr(stringPtr,*splitChars)) != NULL) { objPtr = Tcl_NewStringObj(stringPtr, p - stringPtr); Tcl_ListObjAppendElement(NULL, listPtr, objPtr); stringPtr = p + 1; @@ -1252,7 +1252,7 @@ Tcl_SplitObjCmd( Tcl_ListObjAppendElement(NULL, listPtr, objPtr); } else { const char *element, *p, *splitEnd; - int splitLen; + size_t splitLen; int splitChar; /* @@ -1302,12 +1302,12 @@ Tcl_SplitObjCmd( static int StringFirstCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int start = 0; + size_t start = TCL_INDEX_START; if (objc < 3 || objc > 4) { Tcl_WrongNumArgs(interp, 1, objv, @@ -1316,9 +1316,9 @@ StringFirstCmd( } if (objc == 4) { - int size = TclGetCharLength(objv[2]); + size_t end = Tcl_GetCharLength(objv[2]) - 1; - if (TCL_OK != TclGetIntForIndexM(interp, objv[3], size - 1, &start)) { + if (TCL_OK != TclGetIntForIndexM(interp, objv[3], end, &start)) { return TCL_ERROR; } } @@ -1346,12 +1346,12 @@ StringFirstCmd( static int StringLastCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int last = INT_MAX - 1; + size_t last = TCL_INDEX_END; if (objc < 3 || objc > 4) { Tcl_WrongNumArgs(interp, 1, objv, @@ -1360,9 +1360,9 @@ StringLastCmd( } if (objc == 4) { - int size = TclGetCharLength(objv[2]); + size_t end = Tcl_GetCharLength(objv[2]) - 1; - if (TCL_OK != TclGetIntForIndexM(interp, objv[3], size - 1, &last)) { + if (TCL_OK != TclGetIntForIndexM(interp, objv[3], end, &last)) { return TCL_ERROR; } } @@ -1390,12 +1390,12 @@ StringLastCmd( static int StringIndexCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int length, index; + size_t index, end; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "string charIndex"); @@ -1406,13 +1406,13 @@ StringIndexCmd( * Get the char length to calculate what 'end' means. */ - length = TclGetCharLength(objv[1]); - if (TclGetIntForIndexM(interp, objv[2], length-1, &index) != TCL_OK) { + end = Tcl_GetCharLength(objv[1]) - 1; + if (TclGetIntForIndexM(interp, objv[2], end, &index) != TCL_OK) { return TCL_ERROR; } - if ((index >= 0) && (index < length)) { - int ch = TclGetUniChar(objv[1], index); + if ((index != TCL_INDEX_NONE) && (index + 1 <= end + 1)) { + int ch = Tcl_GetUniChar(objv[1], index); if (ch == -1) { return TCL_OK; @@ -1430,11 +1430,13 @@ StringIndexCmd( } else { char buf[4] = ""; - length = Tcl_UniCharToUtf(ch, buf); - if ((ch >= 0xD800) && (length < 3)) { - length += Tcl_UniCharToUtf(-1, buf + length); + end = Tcl_UniCharToUtf(ch, buf); +#if TCL_UTF_MAX < 4 + if ((ch >= 0xD800) && (end < 3)) { + end += Tcl_UniCharToUtf(-1, buf + end); } - Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, length)); +#endif + Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, end)); } } return TCL_OK; @@ -1460,13 +1462,13 @@ StringIndexCmd( static int StringInsertCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter */ int objc, /* Number of arguments */ Tcl_Obj *const objv[]) /* Argument objects */ { - int length; /* String length */ - int index; /* Insert index */ + size_t length; /* String length */ + size_t index; /* Insert index */ Tcl_Obj *outObj; /* Output object */ if (objc != 4) { @@ -1474,13 +1476,13 @@ StringInsertCmd( return TCL_ERROR; } - length = TclGetCharLength(objv[1]); + length = Tcl_GetCharLength(objv[1]); if (TclGetIntForIndexM(interp, objv[2], length, &index) != TCL_OK) { return TCL_ERROR; } - if (index < 0) { - index = 0; + if (index == TCL_INDEX_NONE) { + index = TCL_INDEX_START; } if (index > length) { index = length; @@ -1517,14 +1519,15 @@ StringInsertCmd( static int StringIsCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *string1, *end, *stop; int (*chcomp)(int) = NULL; /* The UniChar comparison function. */ - int i, failat = 0, result = 1, strict = 0, index, length1, length2; + int i, result = 1, strict = 0; + size_t failat = 0, length1, length2, length3; Tcl_Obj *objPtr, *failVarObj = NULL; Tcl_WideInt w; @@ -1543,13 +1546,13 @@ StringIsCmd( STR_IS_LIST, STR_IS_LOWER, STR_IS_PRINT, STR_IS_PUNCT, STR_IS_SPACE, STR_IS_TRUE, STR_IS_UPPER, STR_IS_UNICODE, STR_IS_WIDE, STR_IS_WORD, STR_IS_XDIGIT - }; + } index; static const char *const isOptions[] = { "-strict", "-failindex", NULL }; enum isOptionsEnum { OPT_STRICT, OPT_FAILIDX - }; + } idx2; if (objc < 3 || objc > 6) { Tcl_WrongNumArgs(interp, 1, objv, @@ -1563,13 +1566,11 @@ StringIsCmd( if (objc != 3) { for (i = 2; i < objc-1; i++) { - int idx2; - if (Tcl_GetIndexFromObj(interp, objv[i], isOptions, "option", 0, &idx2) != TCL_OK) { return TCL_ERROR; } - switch ((enum isOptionsEnum) idx2) { + switch (idx2) { case OPT_STRICT: strict = 1; break; @@ -1598,7 +1599,7 @@ StringIsCmd( * When entering here, result == 1 and failat == 0. */ - switch ((enum isClassesEnum) index) { + switch (index) { case STR_IS_ALNUM: chcomp = Tcl_UniCharIsAlnum; break; @@ -1616,21 +1617,20 @@ StringIsCmd( if (strict) { result = 0; } else { - string1 = TclGetStringFromObj(objPtr, &length1); + string1 = Tcl_GetStringFromObj(objPtr, &length1); result = length1 == 0; } - } else if (index != STR_IS_BOOL) { - TclGetBooleanFromObj(NULL, objPtr, &i); - if ((index == STR_IS_TRUE) ^ i) { - result = 0; - } + } else if ((objPtr->internalRep.wideValue != 0) + ? (index == STR_IS_FALSE) : (index == STR_IS_TRUE)) { + result = 0; } break; case STR_IS_CONTROL: chcomp = Tcl_UniCharIsControl; break; case STR_IS_DICT: { - int dresult, dsize; + int dresult; + size_t dsize; dresult = Tcl_DictObjSize(interp, objPtr, &dsize); Tcl_ResetResult(interp); @@ -1643,10 +1643,11 @@ StringIsCmd( */ const char *elemStart, *nextElem; - int lenRemain, elemSize; + int lenRemain; + size_t elemSize; const char *p; - string1 = TclGetStringFromObj(objPtr, &length1); + string1 = Tcl_GetStringFromObj(objPtr, &length1); end = string1 + length1; failat = -1; for (p=string1, lenRemain=length1; lenRemain > 0; @@ -1669,7 +1670,7 @@ StringIsCmd( p++; } TclNewStringObj(tmpStr, string1, p-string1); - failat = TclGetCharLength(tmpStr); + failat = Tcl_GetCharLength(tmpStr); TclDecrRefCount(tmpStr); break; } @@ -1686,7 +1687,7 @@ StringIsCmd( TclHasInternalRep(objPtr, &tclBignumType)) { break; } - string1 = TclGetStringFromObj(objPtr, &length1); + string1 = Tcl_GetStringFromObj(objPtr, &length1); if (length1 == 0) { if (strict) { result = 0; @@ -1716,7 +1717,7 @@ StringIsCmd( TclHasInternalRep(objPtr, &tclBignumType)) { break; } - string1 = TclGetStringFromObj(objPtr, &length1); + string1 = Tcl_GetStringFromObj(objPtr, &length1); if (length1 == 0) { if (strict) { result = 0; @@ -1758,7 +1759,7 @@ StringIsCmd( break; } - string1 = TclGetStringFromObj(objPtr, &length1); + string1 = Tcl_GetStringFromObj(objPtr, &length1); if (length1 == 0) { if (strict) { result = 0; @@ -1811,7 +1812,7 @@ StringIsCmd( * well-formed lists. */ - if (TCL_OK == TclListObjLengthM(NULL, objPtr, &length2)) { + if (TCL_OK == TclListObjLengthM(NULL, objPtr, &length3)) { break; } @@ -1823,10 +1824,11 @@ StringIsCmd( */ const char *elemStart, *nextElem; - int lenRemain, elemSize; + size_t lenRemain; + size_t elemSize; const char *p; - string1 = TclGetStringFromObj(objPtr, &length1); + string1 = Tcl_GetStringFromObj(objPtr, &length1); end = string1 + length1; failat = -1; for (p=string1, lenRemain=length1; lenRemain > 0; @@ -1849,7 +1851,7 @@ StringIsCmd( p++; } TclNewStringObj(tmpStr, string1, p-string1); - failat = TclGetCharLength(tmpStr); + failat = Tcl_GetCharLength(tmpStr); TclDecrRefCount(tmpStr); break; } @@ -1884,7 +1886,7 @@ StringIsCmd( } if (chcomp != NULL) { - string1 = TclGetStringFromObj(objPtr, &length1); + string1 = Tcl_GetStringFromObj(objPtr, &length1); if (length1 == 0) { if (strict) { result = 0; @@ -1953,16 +1955,16 @@ UniCharIsHexDigit( static int StringMapCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int length1, length2, mapElemc, index; + size_t length1, length2, mapElemc, index; int nocase = 0, mapWithDict = 0, copySource = 0; Tcl_Obj **mapElemv, *sourceObj, *resultPtr; Tcl_UniChar *ustring1, *ustring2, *p, *end; - int (*strCmpFn)(const Tcl_UniChar*, const Tcl_UniChar*, unsigned long); + int (*strCmpFn)(const Tcl_UniChar*, const Tcl_UniChar*, size_t); if (objc < 3 || objc > 4) { Tcl_WrongNumArgs(interp, 1, objv, "?-nocase? charMap string"); @@ -1970,7 +1972,7 @@ StringMapCmd( } if (objc == 4) { - const char *string = TclGetStringFromObj(objv[1], &length2); + const char *string = Tcl_GetStringFromObj(objv[1], &length2); if ((length2 > 1) && strncmp(string, "-nocase", length2) == 0) { @@ -1991,7 +1993,8 @@ StringMapCmd( if (!TclHasStringRep(objv[objc-2]) && TclHasInternalRep(objv[objc-2], &tclDictType)) { - int i, done; + size_t i; + int done; Tcl_DictSearch search; /* @@ -1999,8 +2002,8 @@ StringMapCmd( * sure. This shortens this code quite a bit. */ - Tcl_DictObjSize(interp, objv[objc-2], &mapElemc); - if (mapElemc == 0) { + Tcl_DictObjSize(interp, objv[objc-2], &i); + if (i == 0) { /* * Empty charMap, just return whatever string was given. */ @@ -2009,7 +2012,7 @@ StringMapCmd( return TCL_OK; } - mapElemc *= 2; + mapElemc = 2 * i; mapWithDict = 1; /* @@ -2020,15 +2023,17 @@ StringMapCmd( mapElemv = (Tcl_Obj **)TclStackAlloc(interp, sizeof(Tcl_Obj *) * mapElemc); Tcl_DictObjFirst(interp, objv[objc-2], &search, mapElemv+0, mapElemv+1, &done); - for (i=2 ; i<mapElemc ; i+=2) { - Tcl_DictObjNext(&search, mapElemv+i, mapElemv+i+1, &done); + for (index=2 ; index<mapElemc ; index+=2) { + Tcl_DictObjNext(&search, mapElemv+index, mapElemv+index+1, &done); } Tcl_DictObjDone(&search); } else { - if (TclListObjGetElementsM(interp, objv[objc-2], &mapElemc, + size_t i; + if (TclListObjGetElementsM(interp, objv[objc-2], &i, &mapElemv) != TCL_OK) { return TCL_ERROR; } + mapElemc = i; if (mapElemc == 0) { /* * empty charMap, just return whatever string was given. @@ -2060,7 +2065,7 @@ StringMapCmd( } else { sourceObj = objv[objc-1]; } - ustring1 = TclGetUnicodeFromObj_(sourceObj, &length1); + ustring1 = Tcl_GetUnicodeFromObj(sourceObj, &length1); if (length1 == 0) { /* * Empty input string, just stop now. @@ -2076,7 +2081,7 @@ StringMapCmd( * Force result to be Unicode */ - resultPtr = TclNewUnicodeObj(ustring1, 0); + resultPtr = Tcl_NewUnicodeObj(ustring1, 0); if (mapElemc == 2) { /* @@ -2086,10 +2091,11 @@ StringMapCmd( * larger strings. */ - int mapLen, u2lc; + size_t mapLen; + int u2lc; Tcl_UniChar *mapString; - ustring2 = TclGetUnicodeFromObj_(mapElemv[0], &length2); + ustring2 = Tcl_GetUnicodeFromObj(mapElemv[0], &length2); p = ustring1; if ((length2 > length1) || (length2 == 0)) { /* @@ -2098,28 +2104,29 @@ StringMapCmd( ustring1 = end; } else { - mapString = TclGetUnicodeFromObj_(mapElemv[1], &mapLen); + mapString = Tcl_GetUnicodeFromObj(mapElemv[1], &mapLen); u2lc = (nocase ? Tcl_UniCharToLower(*ustring2) : 0); for (; ustring1 < end; ustring1++) { if (((*ustring1 == *ustring2) || (nocase&&Tcl_UniCharToLower(*ustring1)==u2lc)) && (length2==1 || strCmpFn(ustring1, ustring2, - (unsigned long) length2) == 0)) { + length2) == 0)) { if (p != ustring1) { - TclAppendUnicodeToObj(resultPtr, p, ustring1-p); + Tcl_AppendUnicodeToObj(resultPtr, p, ustring1-p); p = ustring1 + length2; } else { p += length2; } ustring1 = p - 1; - TclAppendUnicodeToObj(resultPtr, mapString, mapLen); + Tcl_AppendUnicodeToObj(resultPtr, mapString, mapLen); } } } } else { Tcl_UniChar **mapStrings; - int *mapLens, *u2lc = NULL; + size_t *mapLens; + int *u2lc = 0; /* * Precompute pointers to the unicode string and length. This saves us @@ -2128,13 +2135,13 @@ StringMapCmd( * case. */ - mapStrings = (Tcl_UniChar **)TclStackAlloc(interp, mapElemc*2*sizeof(Tcl_UniChar *)); - mapLens = (int *)TclStackAlloc(interp, mapElemc * 2 * sizeof(int)); + mapStrings = (Tcl_UniChar **)TclStackAlloc(interp, mapElemc*sizeof(Tcl_UniChar *)*2); + mapLens = (size_t *)TclStackAlloc(interp, mapElemc * sizeof(size_t) * 2); if (nocase) { u2lc = (int *)TclStackAlloc(interp, mapElemc * sizeof(int)); } for (index = 0; index < mapElemc; index++) { - mapStrings[index] = TclGetUnicodeFromObj_(mapElemv[index], + mapStrings[index] = Tcl_GetUnicodeFromObj(mapElemv[index], mapLens+index); if (nocase && ((index % 2) == 0)) { u2lc[index/2] = Tcl_UniCharToLower(*mapStrings[index]); @@ -2151,14 +2158,14 @@ StringMapCmd( if ((length2 > 0) && ((*ustring1 == *ustring2) || (nocase && (Tcl_UniCharToLower(*ustring1) == u2lc[index/2]))) && /* Restrict max compare length. */ - (end-ustring1 >= length2) && ((length2 == 1) || + ((size_t)(end-ustring1) >= length2) && ((length2 == 1) || !strCmpFn(ustring2, ustring1, length2))) { if (p != ustring1) { /* * Put the skipped chars onto the result first. */ - TclAppendUnicodeToObj(resultPtr, p, ustring1-p); + Tcl_AppendUnicodeToObj(resultPtr, p, ustring1-p); p = ustring1 + length2; } else { p += length2; @@ -2174,7 +2181,7 @@ StringMapCmd( * Append the map value to the unicode string. */ - TclAppendUnicodeToObj(resultPtr, + Tcl_AppendUnicodeToObj(resultPtr, mapStrings[index+1], mapLens[index+1]); break; } @@ -2191,7 +2198,7 @@ StringMapCmd( * Put the rest of the unmapped chars onto result. */ - TclAppendUnicodeToObj(resultPtr, p, ustring1 - p); + Tcl_AppendUnicodeToObj(resultPtr, p, ustring1 - p); } Tcl_SetObjResult(interp, resultPtr); done: @@ -2224,7 +2231,7 @@ StringMapCmd( static int StringMatchCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -2237,8 +2244,8 @@ StringMatchCmd( } if (objc == 4) { - int length; - const char *string = TclGetStringFromObj(objv[1], &length); + size_t length; + const char *string = Tcl_GetStringFromObj(objv[1], &length); if ((length > 1) && strncmp(string, "-nocase", length) == 0) { @@ -2276,12 +2283,12 @@ StringMatchCmd( static int StringRangeCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int length, first, last; + size_t first, last, end; if (objc != 4) { Tcl_WrongNumArgs(interp, 1, objv, "string first last"); @@ -2293,15 +2300,15 @@ StringRangeCmd( * 'end' refers to the last character, not one past it. */ - length = TclGetCharLength(objv[1]) - 1; + end = Tcl_GetCharLength(objv[1]) - 1; - if (TclGetIntForIndexM(interp, objv[2], length, &first) != TCL_OK || - TclGetIntForIndexM(interp, objv[3], length, &last) != TCL_OK) { + if (TclGetIntForIndexM(interp, objv[2], end, &first) != TCL_OK || + TclGetIntForIndexM(interp, objv[3], end, &last) != TCL_OK) { return TCL_ERROR; } - if (last >= 0) { - Tcl_SetObjResult(interp, TclGetRange(objv[1], first, last)); + if (last != TCL_INDEX_NONE) { + Tcl_SetObjResult(interp, Tcl_GetRange(objv[1], first, last)); } return TCL_OK; } @@ -2326,12 +2333,12 @@ StringRangeCmd( static int StringReptCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int count; + Tcl_WideInt count; Tcl_Obj *resultPtr; if (objc != 3) { @@ -2339,7 +2346,7 @@ StringReptCmd( return TCL_ERROR; } - if (TclGetIntFromObj(interp, objv[2], &count) != TCL_OK) { + if (TclGetWideIntFromObj(interp, objv[2], &count) != TCL_OK) { return TCL_ERROR; } @@ -2382,20 +2389,19 @@ StringReptCmd( static int StringRplcCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int first, last, length, end; + size_t first, last, end; if (objc < 4 || objc > 5) { Tcl_WrongNumArgs(interp, 1, objv, "string first last ?string?"); return TCL_ERROR; } - length = TclGetCharLength(objv[1]); - end = length - 1; + end = Tcl_GetCharLength(objv[1]) - 1; if (TclGetIntForIndexM(interp, objv[2], end, &first) != TCL_OK || TclGetIntForIndexM(interp, objv[3], end, &last) != TCL_OK) { @@ -2408,10 +2414,9 @@ StringRplcCmd( * result is the original string. */ - if ((last < 0) || /* Range ends before start of string */ - (first > end) || /* Range begins after end of string */ - (last < first)) { /* Range begins after it starts */ - + 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 */ /* * BUT!!! when (end < 0) -- an empty original string -- we can * have (first <= end < 0 <= last) and an empty string is permitted @@ -2422,10 +2427,10 @@ StringRplcCmd( } else { Tcl_Obj *resultPtr; - if (first < 0) { - first = 0; + if (first == TCL_INDEX_NONE) { + first = TCL_INDEX_START; } - if (last > end) { + if (last + 1 > end + 1) { last = end; } @@ -2433,6 +2438,9 @@ StringRplcCmd( last + 1 - first, (objc == 5) ? objv[4] : NULL, TCL_STRING_IN_PLACE); + if (resultPtr == NULL) { + return TCL_ERROR; + } Tcl_SetObjResult(interp, resultPtr); } return TCL_OK; @@ -2458,7 +2466,7 @@ StringRplcCmd( static int StringRevCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -2491,14 +2499,14 @@ StringRevCmd( static int StringStartCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int ch; const Tcl_UniChar *p, *string; - int cur, index, length; + size_t cur, index, length; Tcl_Obj *obj; if (objc != 3) { @@ -2506,19 +2514,19 @@ StringStartCmd( return TCL_ERROR; } - string = TclGetUnicodeFromObj_(objv[1], &length); + string = Tcl_GetUnicodeFromObj(objv[1], &length); if (TclGetIntForIndexM(interp, objv[2], length-1, &index) != TCL_OK) { return TCL_ERROR; } - if (index >= length) { + if (index + 1 >= length + 1) { index = length - 1; } cur = 0; - if (index > 0) { + if (index + 1 > 1) { p = &string[index]; (void)TclUniCharToUCS4(p, &ch); - for (cur = index; cur >= 0; cur--) { + for (cur = index; cur != TCL_INDEX_NONE; cur--) { int delta = 0; const Tcl_UniChar *next; @@ -2561,14 +2569,14 @@ StringStartCmd( static int StringEndCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int ch; const Tcl_UniChar *p, *end, *string; - int cur, index, length; + size_t cur, index, length; Tcl_Obj *obj; if (objc != 3) { @@ -2576,14 +2584,14 @@ StringEndCmd( return TCL_ERROR; } - string = TclGetUnicodeFromObj_(objv[1], &length); + string = Tcl_GetUnicodeFromObj(objv[1], &length); if (TclGetIntForIndexM(interp, objv[2], length-1, &index) != TCL_OK) { return TCL_ERROR; } - if (index < 0) { - index = 0; + if (index == TCL_INDEX_NONE) { + index = TCL_INDEX_START; } - if (index < length) { + if (index + 1 <= length + 1) { p = &string[index]; end = string+length; for (cur = index; p < end; cur++) { @@ -2623,7 +2631,7 @@ StringEndCmd( static int StringEqualCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -2635,7 +2643,8 @@ StringEqualCmd( */ const char *string2; - int length, i, match, nocase = 0, reqlength = -1; + int i, match, nocase = 0, reqlength = -1; + size_t length; if (objc < 3 || objc > 6) { str_cmp_args: @@ -2645,7 +2654,7 @@ StringEqualCmd( } for (i = 1; i < objc-2; i++) { - string2 = TclGetStringFromObj(objv[i], &length); + string2 = Tcl_GetStringFromObj(objv[i], &length); if ((length > 1) && !strncmp(string2, "-nocase", length)) { nocase = 1; } else if ((length > 1) @@ -2698,7 +2707,7 @@ StringEqualCmd( static int StringCmpCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -2730,7 +2739,8 @@ TclStringCmpOpts( int *nocase, int *reqlength) { - int i, length; + int i; + size_t length; const char *string; *reqlength = -1; @@ -2743,7 +2753,7 @@ TclStringCmpOpts( } for (i = 1; i < objc-2; i++) { - string = TclGetStringFromObj(objv[i], &length); + string = Tcl_GetStringFromObj(objv[i], &length); if ((length > 1) && !strncmp(string, "-nocase", length)) { *nocase = 1; } else if ((length > 1) @@ -2786,7 +2796,7 @@ TclStringCmpOpts( static int StringCatCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -2814,45 +2824,6 @@ StringCatCmd( /* *---------------------------------------------------------------------- * - * StringBytesCmd -- - * - * This procedure is invoked to process the "string bytelength" Tcl - * command. See the user documentation for details on what it does. Note - * that this command only functions correctly on properly formed Tcl UTF - * strings. - * - * Results: - * A standard Tcl result. - * - * Side effects: - * See the user documentation. - * - *---------------------------------------------------------------------- - */ -#if TCL_MAJOR_VERSION < 9 && !defined(TCL_NO_DEPRECATED) -static int -StringBytesCmd( - TCL_UNUSED(ClientData), - Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ - Tcl_Obj *const objv[]) /* Argument objects. */ -{ - int length; - - if (objc != 2) { - Tcl_WrongNumArgs(interp, 1, objv, "string"); - return TCL_ERROR; - } - - (void) TclGetStringFromObj(objv[1], &length); - Tcl_SetObjResult(interp, Tcl_NewWideIntObj(length)); - return TCL_OK; -} -#endif - -/* - *---------------------------------------------------------------------- - * * StringLenCmd -- * * This procedure is invoked to process the "string length" Tcl command. @@ -2870,7 +2841,7 @@ StringBytesCmd( static int StringLenCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -2880,7 +2851,7 @@ StringLenCmd( return TCL_ERROR; } - Tcl_SetObjResult(interp, Tcl_NewWideIntObj(TclGetCharLength(objv[1]))); + Tcl_SetObjResult(interp, Tcl_NewWideIntObj(Tcl_GetCharLength(objv[1]))); return TCL_OK; } @@ -2904,12 +2875,12 @@ StringLenCmd( static int StringLowerCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int length1, length2; + size_t length1, length2; const char *string1; char *string2; @@ -2918,7 +2889,7 @@ StringLowerCmd( return TCL_ERROR; } - string1 = TclGetStringFromObj(objv[1], &length1); + string1 = Tcl_GetStringFromObj(objv[1], &length1); if (objc == 2) { Tcl_Obj *resultPtr = Tcl_NewStringObj(string1, length1); @@ -2927,7 +2898,7 @@ StringLowerCmd( Tcl_SetObjLength(resultPtr, length1); Tcl_SetObjResult(interp, resultPtr); } else { - int first, last; + size_t first, last; const char *start, *end; Tcl_Obj *resultPtr; @@ -2935,7 +2906,7 @@ StringLowerCmd( if (TclGetIntForIndexM(interp,objv[2],length1, &first) != TCL_OK) { return TCL_ERROR; } - if (first < 0) { + if (first == TCL_INDEX_NONE) { first = 0; } last = first; @@ -2945,17 +2916,17 @@ StringLowerCmd( return TCL_ERROR; } - if (last >= length1) { + if (last + 1 >= length1 + 1) { last = length1; } - if (last < first) { + if (last + 1 < first + 1) { Tcl_SetObjResult(interp, objv[1]); return TCL_OK; } - string1 = TclGetStringFromObj(objv[1], &length1); - start = TclUtfAtIndex(string1, first); - end = TclUtfAtIndex(start, last - first + 1); + string1 = Tcl_GetStringFromObj(objv[1], &length1); + start = Tcl_UtfAtIndex(string1, first); + end = Tcl_UtfAtIndex(start, last - first + 1); resultPtr = Tcl_NewStringObj(string1, end - string1); string2 = TclGetString(resultPtr) + (start - string1); @@ -2989,12 +2960,12 @@ StringLowerCmd( static int StringUpperCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int length1, length2; + size_t length1, length2; const char *string1; char *string2; @@ -3003,7 +2974,7 @@ StringUpperCmd( return TCL_ERROR; } - string1 = TclGetStringFromObj(objv[1], &length1); + string1 = Tcl_GetStringFromObj(objv[1], &length1); if (objc == 2) { Tcl_Obj *resultPtr = Tcl_NewStringObj(string1, length1); @@ -3012,7 +2983,7 @@ StringUpperCmd( Tcl_SetObjLength(resultPtr, length1); Tcl_SetObjResult(interp, resultPtr); } else { - int first, last; + size_t first, last; const char *start, *end; Tcl_Obj *resultPtr; @@ -3020,8 +2991,8 @@ StringUpperCmd( if (TclGetIntForIndexM(interp,objv[2],length1, &first) != TCL_OK) { return TCL_ERROR; } - if (first < 0) { - first = 0; + if (first == TCL_INDEX_NONE) { + first = TCL_INDEX_START; } last = first; @@ -3030,17 +3001,17 @@ StringUpperCmd( return TCL_ERROR; } - if (last >= length1) { + if (last + 1 >= length1 + 1) { last = length1; } - if (last < first) { + if (last + 1 < first + 1) { Tcl_SetObjResult(interp, objv[1]); return TCL_OK; } - string1 = TclGetStringFromObj(objv[1], &length1); - start = TclUtfAtIndex(string1, first); - end = TclUtfAtIndex(start, last - first + 1); + string1 = Tcl_GetStringFromObj(objv[1], &length1); + start = Tcl_UtfAtIndex(string1, first); + end = Tcl_UtfAtIndex(start, last - first + 1); resultPtr = Tcl_NewStringObj(string1, end - string1); string2 = TclGetString(resultPtr) + (start - string1); @@ -3074,12 +3045,12 @@ StringUpperCmd( static int StringTitleCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int length1, length2; + size_t length1, length2; const char *string1; char *string2; @@ -3088,7 +3059,7 @@ StringTitleCmd( return TCL_ERROR; } - string1 = TclGetStringFromObj(objv[1], &length1); + string1 = Tcl_GetStringFromObj(objv[1], &length1); if (objc == 2) { Tcl_Obj *resultPtr = Tcl_NewStringObj(string1, length1); @@ -3097,7 +3068,7 @@ StringTitleCmd( Tcl_SetObjLength(resultPtr, length1); Tcl_SetObjResult(interp, resultPtr); } else { - int first, last; + size_t first, last; const char *start, *end; Tcl_Obj *resultPtr; @@ -3105,8 +3076,8 @@ StringTitleCmd( if (TclGetIntForIndexM(interp,objv[2],length1, &first) != TCL_OK) { return TCL_ERROR; } - if (first < 0) { - first = 0; + if (first == TCL_INDEX_NONE) { + first = TCL_INDEX_START; } last = first; @@ -3115,17 +3086,17 @@ StringTitleCmd( return TCL_ERROR; } - if (last >= length1) { + if (last + 1 >= length1 + 1) { last = length1; } - if (last < first) { + if (last + 1 < first + 1) { Tcl_SetObjResult(interp, objv[1]); return TCL_OK; } - string1 = TclGetStringFromObj(objv[1], &length1); - start = TclUtfAtIndex(string1, first); - end = TclUtfAtIndex(start, last - first + 1); + string1 = Tcl_GetStringFromObj(objv[1], &length1); + start = Tcl_UtfAtIndex(string1, first); + end = Tcl_UtfAtIndex(start, last - first + 1); resultPtr = Tcl_NewStringObj(string1, end - string1); string2 = TclGetString(resultPtr) + (start - string1); @@ -3159,16 +3130,16 @@ StringTitleCmd( static int StringTrimCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *string1, *string2; - int triml, trimr, length1, length2; + size_t triml, trimr, length1, length2; if (objc == 3) { - string2 = TclGetStringFromObj(objv[2], &length2); + string2 = Tcl_GetStringFromObj(objv[2], &length2); } else if (objc == 2) { string2 = tclDefaultTrimSet; length2 = strlen(tclDefaultTrimSet); @@ -3176,7 +3147,7 @@ StringTrimCmd( Tcl_WrongNumArgs(interp, 1, objv, "string ?chars?"); return TCL_ERROR; } - string1 = TclGetStringFromObj(objv[1], &length1); + string1 = Tcl_GetStringFromObj(objv[1], &length1); triml = TclTrim(string1, length1, string2, length2, &trimr); @@ -3206,16 +3177,17 @@ StringTrimCmd( static int StringTrimLCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *string1, *string2; - int trim, length1, length2; + int trim; + size_t length1, length2; if (objc == 3) { - string2 = TclGetStringFromObj(objv[2], &length2); + string2 = Tcl_GetStringFromObj(objv[2], &length2); } else if (objc == 2) { string2 = tclDefaultTrimSet; length2 = strlen(tclDefaultTrimSet); @@ -3223,7 +3195,7 @@ StringTrimLCmd( Tcl_WrongNumArgs(interp, 1, objv, "string ?chars?"); return TCL_ERROR; } - string1 = TclGetStringFromObj(objv[1], &length1); + string1 = Tcl_GetStringFromObj(objv[1], &length1); trim = TclTrimLeft(string1, length1, string2, length2); @@ -3252,16 +3224,17 @@ StringTrimLCmd( static int StringTrimRCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *string1, *string2; - int trim, length1, length2; + int trim; + size_t length1, length2; if (objc == 3) { - string2 = TclGetStringFromObj(objv[2], &length2); + string2 = Tcl_GetStringFromObj(objv[2], &length2); } else if (objc == 2) { string2 = tclDefaultTrimSet; length2 = strlen(tclDefaultTrimSet); @@ -3269,7 +3242,7 @@ StringTrimRCmd( Tcl_WrongNumArgs(interp, 1, objv, "string ?chars?"); return TCL_ERROR; } - string1 = TclGetStringFromObj(objv[1], &length1); + string1 = Tcl_GetStringFromObj(objv[1], &length1); trim = TclTrimRight(string1, length1, string2, length2); @@ -3305,9 +3278,6 @@ TclInitStringCmd( Tcl_Interp *interp) /* Current interpreter. */ { static const EnsembleImplMap stringImplMap[] = { -#if TCL_MAJOR_VERSION < 9 && !defined(TCL_NO_DEPRECATED) - {"bytelength", StringBytesCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, -#endif {"cat", StringCatCmd, TclCompileStringCatCmd, NULL, NULL, 0}, {"compare", StringCmpCmd, TclCompileStringCmpCmd, NULL, NULL, 0}, {"equal", StringEqualCmd, TclCompileStringEqualCmd, NULL, NULL, 0}, @@ -3358,7 +3328,7 @@ TclInitStringCmd( int TclSubstOptions( Tcl_Interp *interp, - int numOpts, + size_t numOpts1, Tcl_Obj *const opts[], int *flagPtr) { @@ -3369,6 +3339,7 @@ TclSubstOptions( SUBST_NOBACKSLASHES, SUBST_NOCOMMANDS, SUBST_NOVARS }; int i, flags = TCL_SUBST_ALL; + int numOpts = numOpts1; for (i = 0; i < numOpts; i++) { int optionIndex; @@ -3397,7 +3368,7 @@ TclSubstOptions( int Tcl_SubstObjCmd( - ClientData clientData, + void *clientData, Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -3407,7 +3378,7 @@ Tcl_SubstObjCmd( int TclNRSubstObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -3445,7 +3416,7 @@ TclNRSubstObjCmd( int Tcl_SwitchObjCmd( - ClientData clientData, + void *clientData, Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -3454,13 +3425,14 @@ Tcl_SwitchObjCmd( } int TclNRSwitchObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int i,j, index, mode, foundmode, splitObjs, numMatchesSaved; - int noCase, patternLength; + int i, mode, foundmode, splitObjs, numMatchesSaved; + int noCase; + size_t patternLength, j; const char *pattern; Tcl_Obj *stringObj, *indexVarObj, *matchVarObj; Tcl_Obj *const *savedObjv = objv; @@ -3484,7 +3456,7 @@ TclNRSwitchObjCmd( enum switchOptionsEnum { OPT_EXACT, OPT_GLOB, OPT_INDEXV, OPT_MATCHV, OPT_NOCASE, OPT_REGEXP, OPT_LAST - }; + } index; typedef int (*strCmpFn_t)(const char *, const char *); strCmpFn_t strCmpFn = TclUtfCmp; @@ -3502,7 +3474,7 @@ TclNRSwitchObjCmd( &index) != TCL_OK) { return TCL_ERROR; } - switch ((enum switchOptionsEnum) index) { + switch (index) { /* * General options. */ @@ -3608,9 +3580,10 @@ TclNRSwitchObjCmd( splitObjs = 0; if (objc == 1) { Tcl_Obj **listv; + size_t listc; blist = objv[0]; - if (TclListObjGetElementsM(interp, objv[0], &objc, &listv) != TCL_OK) { + if (TclListObjGetElementsM(interp, objv[0], &listc, &listv) != TCL_OK) { return TCL_ERROR; } @@ -3618,11 +3591,12 @@ TclNRSwitchObjCmd( * Ensure that the list is non-empty. */ - if (objc < 1) { + if (listc < 1 || listc > INT_MAX) { Tcl_WrongNumArgs(interp, 1, savedObjv, "?-option ...? string {?pattern body ...? ?default body?}"); return TCL_ERROR; } + objc = listc; objv = listv; splitObjs = 1; } @@ -3683,7 +3657,7 @@ TclNRSwitchObjCmd( * See if the pattern matches the string. */ - pattern = TclGetStringFromObj(objv[i], &patternLength); + pattern = Tcl_GetStringFromObj(objv[i], &patternLength); if ((i == objc - 2) && (*pattern == 'd') && (strcmp(pattern, "default") == 0)) { @@ -3771,7 +3745,7 @@ TclNRSwitchObjCmd( if (indexVarObj != NULL) { Tcl_Obj *rangeObjAry[2]; - if (info.matches[j].end > 0) { + if (info.matches[j].end + 1 > 1) { TclNewIndexObj(rangeObjAry[0], info.matches[j].start); TclNewIndexObj(rangeObjAry[1], info.matches[j].end-1); } else { @@ -3790,8 +3764,8 @@ TclNRSwitchObjCmd( if (matchVarObj != NULL) { Tcl_Obj *substringObj; - if (info.matches[j].end > 0) { - substringObj = TclGetRange(stringObj, + if (info.matches[j].end + 1 > 1) { + substringObj = Tcl_GetRange(stringObj, info.matches[j].start, info.matches[j].end-1); } else { TclNewObj(substringObj); @@ -3872,7 +3846,7 @@ TclNRSwitchObjCmd( if (ctxPtr->type == TCL_LOCATION_SOURCE && ctxPtr->line[bidx] >= 0) { int bline = ctxPtr->line[bidx]; - ctxPtr->line = (int *)ckalloc(objc * sizeof(int)); + ctxPtr->line = (int *)Tcl_Alloc(objc * sizeof(int)); ctxPtr->nline = objc; TclListLines(blist, bline, objc, ctxPtr->line, objv); } else { @@ -3886,7 +3860,7 @@ TclNRSwitchObjCmd( int k; - ctxPtr->line = (int *)ckalloc(objc * sizeof(int)); + ctxPtr->line = (int *)Tcl_Alloc(objc * sizeof(int)); ctxPtr->nline = objc; for (k=0; k < objc; k++) { ctxPtr->line[k] = -1; @@ -3895,7 +3869,7 @@ TclNRSwitchObjCmd( } for (j = i + 1; ; j += 2) { - if (j >= objc) { + if (j >= (size_t)objc) { /* * This shouldn't happen since we've checked that the last body is * not a continuation... @@ -3913,13 +3887,13 @@ TclNRSwitchObjCmd( */ Tcl_NRAddCallback(interp, SwitchPostProc, INT2PTR(splitObjs), ctxPtr, - INT2PTR(pc), (ClientData) pattern); + INT2PTR(pc), (void *)pattern); return TclNREvalObjEx(interp, objv[j], 0, ctxPtr, splitObjs ? j : bidx+j); } static int SwitchPostProc( - ClientData data[], /* Data passed from Tcl_NRAddCallback above */ + void *data[], /* Data passed from Tcl_NRAddCallback above */ Tcl_Interp *interp, /* Tcl interpreter */ int result) /* Result to return*/ { @@ -3929,14 +3903,14 @@ SwitchPostProc( CmdFrame *ctxPtr = (CmdFrame *)data[1]; int pc = PTR2INT(data[2]); const char *pattern = (const char *)data[3]; - int patternLength = strlen(pattern); + size_t patternLength = strlen(pattern); /* * Clean up TIP 280 context information */ if (splitObjs) { - ckfree(ctxPtr->line); + Tcl_Free(ctxPtr->line); if (pc && (ctxPtr->type == TCL_LOCATION_SOURCE)) { /* * Death of SrcInfo reference. @@ -3951,12 +3925,12 @@ SwitchPostProc( */ if (result == TCL_ERROR) { - int limit = 50; + unsigned limit = 50; int overflow = (patternLength > limit); Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (\"%.*s%s\" arm line %d)", - (overflow ? limit : patternLength), pattern, + (overflow ? limit : (unsigned)patternLength), pattern, (overflow ? "..." : ""), Tcl_GetErrorLine(interp))); } TclStackFree(interp, ctxPtr); @@ -3982,13 +3956,13 @@ SwitchPostProc( int Tcl_ThrowObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *options; - int len; + size_t len; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "type message"); @@ -4044,7 +4018,7 @@ Tcl_ThrowObjCmd( int Tcl_TimeObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -4142,7 +4116,7 @@ Tcl_TimeObjCmd( int Tcl_TimeRateObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -4179,7 +4153,7 @@ Tcl_TimeRateObjCmd( ByteCode *codePtr = NULL; for (i = 1; i < objc - 1; i++) { - int index; + enum timeRateOptionsEnum index; if (Tcl_GetIndexFromObj(NULL, objv[i], options, "option", TCL_EXACT, &index) != TCL_OK) { @@ -4189,7 +4163,7 @@ Tcl_TimeRateObjCmd( i++; break; } - switch ((enum timeRateOptionsEnum)index) { + switch (index) { case TMRT_EV_DIRECT: direct = objv[i]; break; @@ -4688,7 +4662,7 @@ Tcl_TimeRateObjCmd( int Tcl_TryObjCmd( - ClientData clientData, + void *clientData, Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -4698,13 +4672,14 @@ Tcl_TryObjCmd( int TclNRTryObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *bodyObj, *handlersObj, *finallyObj = NULL; - int i, bodyShared, haveHandlers, dummy, code; + int i, bodyShared, haveHandlers, code; + size_t dummy; static const char *const handlerNames[] = { "finally", "on", "trap", NULL }; @@ -4724,11 +4699,11 @@ TclNRTryObjCmd( return TCL_ERROR; } bodyObj = objv[1]; - TclNewObj(handlersObj); + handlersObj = Tcl_NewObj(); bodyShared = 0; haveHandlers = 0; for (i=2 ; i<objc ; i++) { - int type; + enum Handlers type; Tcl_Obj *info[5]; if (Tcl_GetIndexFromObj(interp, objv[i], handlerNames, "handler type", @@ -4736,7 +4711,7 @@ TclNRTryObjCmd( Tcl_DecrRefCount(handlersObj); return TCL_ERROR; } - switch ((enum Handlers) type) { + switch (type) { case TryFinally: /* finally script */ if (i < objc-2) { Tcl_SetObjResult(interp, Tcl_NewStringObj( @@ -4790,7 +4765,7 @@ TclNRTryObjCmd( if (TclListObjLengthM(NULL, objv[i+1], &dummy) != TCL_OK) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad prefix '%s': must be a list", - Tcl_GetString(objv[i+1]))); + TclGetString(objv[i+1]))); Tcl_DecrRefCount(handlersObj); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "TRAP", "EXNFORMAT", NULL); @@ -4838,7 +4813,7 @@ TclNRTryObjCmd( */ Tcl_NRAddCallback(interp, TryPostBody, handlersObj, finallyObj, - (ClientData)objv, INT2PTR(objc)); + (void *)objv, INT2PTR(objc)); return TclNREvalObjEx(interp, bodyObj, 0, ((Interp *) interp)->cmdFramePtr, 1); } @@ -4896,13 +4871,13 @@ During( static int TryPostBody( - ClientData data[], + void *data[], Tcl_Interp *interp, int result) { Tcl_Obj *resultObj, *options, *handlersObj, *finallyObj, *cmdObj, **objv; - int i, code, objc; - int numHandlers = 0; + int code, objc; + size_t i, numHandlers = 0; handlersObj = (Tcl_Obj *)data[0]; finallyObj = (Tcl_Obj *)data[1]; @@ -4952,7 +4927,7 @@ TryPostBody( TclListObjGetElementsM(NULL, handlersObj, &numHandlers, &handlers); for (i=0 ; i<numHandlers ; i++) { Tcl_Obj *handlerBodyObj; - int numElems = 0; + size_t numElems = 0; TclListObjGetElementsM(NULL, handlers[i], &numElems, &info); if (!found) { @@ -4970,7 +4945,7 @@ TryPostBody( if (code == TCL_ERROR) { Tcl_Obj *errorCodeName, *errcode, **bits1, **bits2; - int len1, len2, j; + size_t len1, len2, j; TclNewLiteralStringObj(errorCodeName, "-errorcode"); Tcl_DictObjGet(NULL, options, errorCodeName, &errcode); @@ -5112,7 +5087,7 @@ TryPostBody( static int TryPostHandler( - ClientData data[], + void *data[], Tcl_Interp *interp, int result) { @@ -5198,7 +5173,7 @@ TryPostHandler( static int TryPostFinal( - ClientData data[], + void *data[], Tcl_Interp *interp, int result) { @@ -5265,7 +5240,7 @@ TryPostFinal( int Tcl_WhileObjCmd( - ClientData clientData, + void *clientData, Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -5275,7 +5250,7 @@ Tcl_WhileObjCmd( int TclNRWhileObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -5324,13 +5299,13 @@ TclListLines( Tcl_Obj *listObj, /* Pointer to obj holding a string with list * structure. Assumed to be valid. Assumed to * contain n elements. */ - int line, /* Line the list as a whole starts on. */ + size_t line, /* Line the list as a whole starts on. */ int n, /* #elements in lines */ int *lines, /* Array of line numbers, to fill. */ Tcl_Obj *const *elems) /* The list elems as Tcl_Obj*, in need of * derived continuation data */ { - const char *listStr = Tcl_GetString(listObj); + const char *listStr = TclGetString(listObj); const char *listHead = listStr; int i, length = strlen(listStr); const char *element = NULL, *next = NULL; diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 340efc9..cb3cf1e 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -286,7 +286,8 @@ TclCompileArraySetCmd( DefineLineInformation; /* TIP #280 */ Tcl_Token *varTokenPtr, *dataTokenPtr; int isScalar, localIndex, code = TCL_OK; - int isDataLiteral, isDataValid, isDataEven, len; + int isDataLiteral, isDataValid, isDataEven; + size_t len; int keyVar, valVar, infoIndex; int fwd, offsetBack, offsetFwd; Tcl_Obj *literalObj; @@ -390,9 +391,9 @@ TclCompileArraySetCmd( keyVar = AnonymousLocal(envPtr); valVar = AnonymousLocal(envPtr); - infoPtr = (ForeachInfo *)ckalloc(offsetof(ForeachInfo, varLists) + sizeof(ForeachVarList *)); + infoPtr = (ForeachInfo *)Tcl_Alloc(offsetof(ForeachInfo, varLists) + sizeof(ForeachVarList *)); infoPtr->numLists = 1; - infoPtr->varLists[0] = (ForeachVarList *)ckalloc(offsetof(ForeachVarList, varIndexes) + 2 * sizeof(int)); + infoPtr->varLists[0] = (ForeachVarList *)Tcl_Alloc(offsetof(ForeachVarList, varIndexes) + 2 * sizeof(size_t)); infoPtr->varLists[0]->numVars = 2; infoPtr->varLists[0]->varIndexes[0] = keyVar; infoPtr->varLists[0]->varIndexes[1] = valVar; @@ -583,7 +584,7 @@ TclCompileCatchCmd( * Let runtime checks determine if syntax has changed. */ - if ((parsePtr->numWords < 2) || (parsePtr->numWords > 4)) { + if (((int)parsePtr->numWords < 2) || ((int)parsePtr->numWords > 4)) { return TCL_ERROR; } @@ -592,7 +593,7 @@ TclCompileCatchCmd( * (not in a procedure), don't compile it inline: the payoff is too small. */ - if ((parsePtr->numWords >= 3) && !EnvHasLVT(envPtr)) { + if (((int)parsePtr->numWords >= 3) && !EnvHasLVT(envPtr)) { return TCL_ERROR; } @@ -603,7 +604,7 @@ TclCompileCatchCmd( resultIndex = optsIndex = -1; cmdTokenPtr = TokenAfter(parsePtr->tokenPtr); - if (parsePtr->numWords >= 3) { + if ((int)parsePtr->numWords >= 3) { resultNameTokenPtr = TokenAfter(cmdTokenPtr); /* DGP */ resultIndex = LocalScalarFromToken(resultNameTokenPtr, envPtr); @@ -686,8 +687,8 @@ TclCompileCatchCmd( /* Stack at this point on both branches: result returnCode */ if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) { - Tcl_Panic("TclCompileCatchCmd: bad jump distance %d", - (int)(CurrentOffset(envPtr) - jumpFixup.codeOffset)); + Tcl_Panic("TclCompileCatchCmd: bad jump distance %" TCL_Z_MODIFIER "d", + (CurrentOffset(envPtr) - jumpFixup.codeOffset)); } /* @@ -876,7 +877,7 @@ TclCompileConcatCmd( */ TclNewObj(listObj); - for (i = 1, tokenPtr = parsePtr->tokenPtr; i < parsePtr->numWords; i++) { + for (i = 1, tokenPtr = parsePtr->tokenPtr; i < (int)parsePtr->numWords; i++) { tokenPtr = TokenAfter(tokenPtr); TclNewObj(objPtr); if (!TclWordKnownAtCompileTime(tokenPtr, objPtr)) { @@ -890,13 +891,13 @@ TclCompileConcatCmd( if (listObj != NULL) { Tcl_Obj **objs; const char *bytes; - int len; + size_t len, slen; TclListObjGetElementsM(NULL, listObj, &len, &objs); objPtr = Tcl_ConcatObj(len, objs); Tcl_DecrRefCount(listObj); - bytes = TclGetStringFromObj(objPtr, &len); - PushLiteral(envPtr, bytes, len); + bytes = Tcl_GetStringFromObj(objPtr, &slen); + PushLiteral(envPtr, bytes, slen); Tcl_DecrRefCount(objPtr); return TCL_OK; } @@ -905,7 +906,7 @@ TclCompileConcatCmd( * General case: runtime concat. */ - for (i = 1, tokenPtr = parsePtr->tokenPtr; i < parsePtr->numWords; i++) { + for (i = 1, tokenPtr = parsePtr->tokenPtr; i < (int)parsePtr->numWords; i++) { tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, i); } @@ -1012,7 +1013,7 @@ TclCompileDictSetCmd( * There must be at least one argument after the command. */ - if (parsePtr->numWords < 4) { + if ((int)parsePtr->numWords < 4) { return TCL_ERROR; } @@ -1033,7 +1034,7 @@ TclCompileDictSetCmd( */ tokenPtr = TokenAfter(varTokenPtr); - for (i=2 ; i< parsePtr->numWords ; i++) { + for (i=2 ; i< (int)parsePtr->numWords ; i++) { CompileWord(envPtr, tokenPtr, interp, i); tokenPtr = TokenAfter(tokenPtr); } @@ -1042,7 +1043,7 @@ TclCompileDictSetCmd( * Now emit the instruction to do the dict manipulation. */ - TclEmitInstInt4( INST_DICT_SET, parsePtr->numWords-3, envPtr); + TclEmitInstInt4( INST_DICT_SET, (int)parsePtr->numWords-3, envPtr); TclEmitInt4( dictVarIndex, envPtr); TclAdjustStackDepth(-1, envPtr); return TCL_OK; @@ -1065,7 +1066,7 @@ TclCompileDictIncrCmd( * There must be at least two arguments after the command. */ - if (parsePtr->numWords < 3 || parsePtr->numWords > 4) { + if ((int)parsePtr->numWords < 3 || (int)parsePtr->numWords > 4) { return TCL_ERROR; } varTokenPtr = TokenAfter(parsePtr->tokenPtr); @@ -1077,7 +1078,8 @@ TclCompileDictIncrCmd( if (parsePtr->numWords == 4) { const char *word; - int numBytes, code; + size_t numBytes; + int code; Tcl_Token *incrTokenPtr; Tcl_Obj *intObj; @@ -1138,7 +1140,7 @@ TclCompileDictGetCmd( */ /* TODO: Consider support for compiling expanded args. */ - if (parsePtr->numWords < 3) { + if ((int)parsePtr->numWords < 3) { return TCL_ERROR; } tokenPtr = TokenAfter(parsePtr->tokenPtr); @@ -1147,11 +1149,11 @@ TclCompileDictGetCmd( * Only compile this because we need INST_DICT_GET anyway. */ - for (i=1 ; i<parsePtr->numWords ; i++) { + for (i=1 ; i<(int)parsePtr->numWords ; i++) { CompileWord(envPtr, tokenPtr, interp, i); tokenPtr = TokenAfter(tokenPtr); } - TclEmitInstInt4(INST_DICT_GET, parsePtr->numWords-2, envPtr); + TclEmitInstInt4(INST_DICT_GET, (int)parsePtr->numWords-2, envPtr); TclAdjustStackDepth(-1, envPtr); return TCL_OK; } @@ -1173,16 +1175,16 @@ TclCompileDictGetWithDefaultCmd( */ /* TODO: Consider support for compiling expanded args. */ - if (parsePtr->numWords < 4) { + if ((int)parsePtr->numWords < 4) { return TCL_ERROR; } tokenPtr = TokenAfter(parsePtr->tokenPtr); - for (i=1 ; i<parsePtr->numWords ; i++) { + for (i=1 ; i<(int)parsePtr->numWords ; i++) { CompileWord(envPtr, tokenPtr, interp, i); tokenPtr = TokenAfter(tokenPtr); } - TclEmitInstInt4(INST_DICT_GET_DEF, parsePtr->numWords-3, envPtr); + TclEmitInstInt4(INST_DICT_GET_DEF, (int)parsePtr->numWords-3, envPtr); TclAdjustStackDepth(-2, envPtr); return TCL_OK; } @@ -1205,7 +1207,7 @@ TclCompileDictExistsCmd( */ /* TODO: Consider support for compiling expanded args. */ - if (parsePtr->numWords < 3) { + if ((int)parsePtr->numWords < 3) { return TCL_ERROR; } tokenPtr = TokenAfter(parsePtr->tokenPtr); @@ -1214,11 +1216,11 @@ TclCompileDictExistsCmd( * Now we do the code generation. */ - for (i=1 ; i<parsePtr->numWords ; i++) { + for (i=1 ; i<(int)parsePtr->numWords ; i++) { CompileWord(envPtr, tokenPtr, interp, i); tokenPtr = TokenAfter(tokenPtr); } - TclEmitInstInt4(INST_DICT_EXISTS, parsePtr->numWords-2, envPtr); + TclEmitInstInt4(INST_DICT_EXISTS, (int)parsePtr->numWords-2, envPtr); TclAdjustStackDepth(-1, envPtr); return TCL_OK; } @@ -1242,7 +1244,7 @@ TclCompileDictUnsetCmd( */ /* TODO: Consider support for compiling expanded args. */ - if (parsePtr->numWords < 3) { + if ((int)parsePtr->numWords < 3) { return TCL_ERROR; } @@ -1262,7 +1264,7 @@ TclCompileDictUnsetCmd( * Remaining words (the key path) can be handled normally. */ - for (i=2 ; i<parsePtr->numWords ; i++) { + for (i=2 ; i<(int)parsePtr->numWords ; i++) { tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, i); } @@ -1271,7 +1273,7 @@ TclCompileDictUnsetCmd( * Now emit the instruction to do the dict manipulation. */ - TclEmitInstInt4( INST_DICT_UNSET, parsePtr->numWords-2, envPtr); + TclEmitInstInt4( INST_DICT_UNSET, (int)parsePtr->numWords-2, envPtr); TclEmitInt4( dictVarIndex, envPtr); return TCL_OK; } @@ -1290,7 +1292,8 @@ TclCompileDictCreateCmd( Tcl_Token *tokenPtr; Tcl_Obj *keyObj, *valueObj, *dictObj; const char *bytes; - int i, len; + int i; + size_t len; if ((parsePtr->numWords & 1) == 0) { return TCL_ERROR; @@ -1303,7 +1306,7 @@ TclCompileDictCreateCmd( tokenPtr = TokenAfter(parsePtr->tokenPtr); TclNewObj(dictObj); Tcl_IncrRefCount(dictObj); - for (i=1 ; i<parsePtr->numWords ; i+=2) { + for (i=1 ; i<(int)parsePtr->numWords ; i+=2) { TclNewObj(keyObj); Tcl_IncrRefCount(keyObj); if (!TclWordKnownAtCompileTime(tokenPtr, keyObj)) { @@ -1330,7 +1333,7 @@ TclCompileDictCreateCmd( * We did! Excellent. The "verifyDict" is to do type forcing. */ - bytes = TclGetStringFromObj(dictObj, &len); + bytes = Tcl_GetStringFromObj(dictObj, &len); PushLiteral(envPtr, bytes, len); TclEmitOpcode( INST_DUP, envPtr); TclEmitOpcode( INST_DICT_VERIFY, envPtr); @@ -1353,7 +1356,7 @@ TclCompileDictCreateCmd( Emit14Inst( INST_STORE_SCALAR, worker, envPtr); TclEmitOpcode( INST_POP, envPtr); tokenPtr = TokenAfter(parsePtr->tokenPtr); - for (i=1 ; i<parsePtr->numWords ; i+=2) { + for (i=1 ; i<(int)parsePtr->numWords ; i+=2) { CompileWord(envPtr, tokenPtr, interp, i); tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, i+1); @@ -1388,7 +1391,7 @@ TclCompileDictMergeCmd( */ /* TODO: Consider support for compiling expanded args. (less likely) */ - if (parsePtr->numWords < 2) { + if ((int)parsePtr->numWords < 2) { PushStringLiteral(envPtr, ""); return TCL_OK; } else if (parsePtr->numWords == 2) { @@ -1430,7 +1433,7 @@ TclCompileDictMergeCmd( outLoop = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr); TclEmitInstInt4( INST_BEGIN_CATCH4, outLoop, envPtr); ExceptionRangeStarts(envPtr, outLoop); - for (i=2 ; i<parsePtr->numWords ; i++) { + for (i=2 ; i<(int)parsePtr->numWords ; i++) { /* * Get the dictionary, and merge its pairs into the first dict (using * a small loop). @@ -1525,7 +1528,8 @@ CompileDictEachCmd( Tcl_Token *varsTokenPtr, *dictTokenPtr, *bodyTokenPtr; int keyVarIndex, valueVarIndex, nameChars, loopRange, catchRange; int infoIndex, jumpDisplacement, bodyTargetOffset, emptyTargetOffset; - int numVars, endTargetOffset; + size_t numVars; + int endTargetOffset; int collectVar = -1; /* Index of temp var holding the result * dict. */ const char **argv; @@ -1573,7 +1577,7 @@ CompileDictEachCmd( } Tcl_DStringFree(&buffer); if (numVars != 2) { - ckfree(argv); + Tcl_Free((void *)argv); return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr); } @@ -1581,7 +1585,7 @@ CompileDictEachCmd( keyVarIndex = LocalScalar(argv[0], nameChars, envPtr); nameChars = strlen(argv[1]); valueVarIndex = LocalScalar(argv[1], nameChars, envPtr); - ckfree(argv); + Tcl_Free((void *)argv); if ((keyVarIndex < 0) || (valueVarIndex < 0)) { return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr); @@ -1757,7 +1761,7 @@ TclCompileDictUpdateCmd( * There must be at least one argument after the command. */ - if (parsePtr->numWords < 5) { + if ((int)parsePtr->numWords < 5) { return TCL_ERROR; } @@ -1766,7 +1770,7 @@ TclCompileDictUpdateCmd( * dict update <lit(eral)> <any> <lit> ?<any> <lit> ...? <lit> */ - if ((parsePtr->numWords - 1) & 1) { + if (((int)parsePtr->numWords - 1) & 1) { return TCL_ERROR; } numVars = (parsePtr->numWords - 3) / 2; @@ -1789,7 +1793,7 @@ TclCompileDictUpdateCmd( * that are to be used. */ - duiPtr = (DictUpdateInfo *)ckalloc(offsetof(DictUpdateInfo, varIndices) + sizeof(int) * numVars); + duiPtr = (DictUpdateInfo *)Tcl_Alloc(offsetof(DictUpdateInfo, varIndices) + sizeof(size_t) * numVars); duiPtr->length = numVars; keyTokenPtrs = (Tcl_Token **)TclStackAlloc(interp, sizeof(Tcl_Token *) * numVars); tokenPtr = TokenAfter(dictVarTokenPtr); @@ -1808,7 +1812,7 @@ TclCompileDictUpdateCmd( */ duiPtr->varIndices[i] = LocalScalarFromToken(tokenPtr, envPtr); - if (duiPtr->varIndices[i] < 0) { + if (duiPtr->varIndices[i] == TCL_INDEX_NONE) { goto failedUpdateInfoAssembly; } tokenPtr = TokenAfter(tokenPtr); @@ -1872,8 +1876,8 @@ TclCompileDictUpdateCmd( TclEmitInvoke(envPtr,INST_RETURN_STK); if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) { - Tcl_Panic("TclCompileDictCmd(update): bad jump distance %d", - (int) (CurrentOffset(envPtr) - jumpFixup.codeOffset)); + Tcl_Panic("TclCompileDictCmd(update): bad jump distance %" TCL_Z_MODIFIER "d", + CurrentOffset(envPtr) - jumpFixup.codeOffset); } TclStackFree(interp, keyTokenPtrs); return TCL_OK; @@ -1883,7 +1887,7 @@ TclCompileDictUpdateCmd( */ failedUpdateInfoAssembly: - ckfree(duiPtr); + Tcl_Free(duiPtr); TclStackFree(interp, keyTokenPtrs); issueFallback: return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, envPtr); @@ -1909,7 +1913,7 @@ TclCompileDictAppendCmd( */ /* TODO: Consider support for compiling expanded args. */ - if (parsePtr->numWords<4 || parsePtr->numWords>100) { + if ((int)parsePtr->numWords<4 || (int)parsePtr->numWords>100) { return TCL_ERROR; } @@ -1928,12 +1932,12 @@ TclCompileDictAppendCmd( */ tokenPtr = TokenAfter(tokenPtr); - for (i=2 ; i<parsePtr->numWords ; i++) { + for (i=2 ; i<(int)parsePtr->numWords ; i++) { CompileWord(envPtr, tokenPtr, interp, i); tokenPtr = TokenAfter(tokenPtr); } - if (parsePtr->numWords > 4) { - TclEmitInstInt1(INST_STR_CONCAT1, parsePtr->numWords-3, envPtr); + if ((int)parsePtr->numWords > 4) { + TclEmitInstInt1(INST_STR_CONCAT1, (int)parsePtr->numWords-3, envPtr); } /* @@ -2010,7 +2014,7 @@ TclCompileDictWithCmd( */ /* TODO: Consider support for compiling expanded args. */ - if (parsePtr->numWords < 3) { + if ((int)parsePtr->numWords < 3) { return TCL_ERROR; } @@ -2021,7 +2025,7 @@ TclCompileDictWithCmd( varTokenPtr = TokenAfter(parsePtr->tokenPtr); tokenPtr = TokenAfter(varTokenPtr); - for (i=3 ; i<parsePtr->numWords ; i++) { + for (i=3 ; i<(int)parsePtr->numWords ; i++) { tokenPtr = TokenAfter(tokenPtr); } if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { @@ -2049,7 +2053,7 @@ TclCompileDictWithCmd( * Determine if we're manipulating a dict in a simple local variable. */ - gotPath = (parsePtr->numWords > 3); + gotPath = ((int)parsePtr->numWords > 3); dictVar = LocalScalarFromToken(varTokenPtr, envPtr); /* @@ -2068,11 +2072,11 @@ TclCompileDictWithCmd( */ tokenPtr = TokenAfter(varTokenPtr); - for (i=2 ; i<parsePtr->numWords-1 ; i++) { + for (i=2 ; i<(int)parsePtr->numWords-1 ; i++) { CompileWord(envPtr, tokenPtr, interp, i); tokenPtr = TokenAfter(tokenPtr); } - TclEmitInstInt4(INST_LIST, parsePtr->numWords-3,envPtr); + TclEmitInstInt4(INST_LIST, (int)parsePtr->numWords-3,envPtr); Emit14Inst( INST_LOAD_SCALAR, dictVar, envPtr); TclEmitInstInt4(INST_OVER, 1, envPtr); TclEmitOpcode( INST_DICT_EXPAND, envPtr); @@ -2095,11 +2099,11 @@ TclCompileDictWithCmd( */ tokenPtr = varTokenPtr; - for (i=1 ; i<parsePtr->numWords-1 ; i++) { + for (i=1 ; i<(int)parsePtr->numWords-1 ; i++) { CompileWord(envPtr, tokenPtr, interp, i); tokenPtr = TokenAfter(tokenPtr); } - TclEmitInstInt4(INST_LIST, parsePtr->numWords-3,envPtr); + TclEmitInstInt4(INST_LIST, (int)parsePtr->numWords-3,envPtr); TclEmitInstInt4(INST_OVER, 1, envPtr); TclEmitOpcode( INST_LOAD_STK, envPtr); TclEmitInstInt4(INST_OVER, 1, envPtr); @@ -2150,11 +2154,11 @@ TclCompileDictWithCmd( } tokenPtr = TokenAfter(varTokenPtr); if (gotPath) { - for (i=2 ; i<parsePtr->numWords-1 ; i++) { + for (i=2 ; i<(int)parsePtr->numWords-1 ; i++) { CompileWord(envPtr, tokenPtr, interp, i); tokenPtr = TokenAfter(tokenPtr); } - TclEmitInstInt4( INST_LIST, parsePtr->numWords-3,envPtr); + TclEmitInstInt4( INST_LIST, (int)parsePtr->numWords-3,envPtr); Emit14Inst( INST_STORE_SCALAR, pathTmp, envPtr); TclEmitOpcode( INST_POP, envPtr); } @@ -2216,7 +2220,7 @@ TclCompileDictWithCmd( if (dictVar == -1) { Emit14Inst( INST_LOAD_SCALAR, varNameTmp, envPtr); } - if (parsePtr->numWords > 3) { + if ((int)parsePtr->numWords > 3) { Emit14Inst( INST_LOAD_SCALAR, pathTmp, envPtr); } else { PushStringLiteral(envPtr, ""); @@ -2234,8 +2238,8 @@ TclCompileDictWithCmd( */ if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) { - Tcl_Panic("TclCompileDictCmd(update): bad jump distance %d", - (int) (CurrentOffset(envPtr) - jumpFixup.codeOffset)); + Tcl_Panic("TclCompileDictCmd(update): bad jump distance %" TCL_Z_MODIFIER "d", + CurrentOffset(envPtr) - jumpFixup.codeOffset); } return TCL_OK; } @@ -2271,8 +2275,8 @@ DupDictUpdateInfo( size_t len; dui1Ptr = (DictUpdateInfo *)clientData; - len = offsetof(DictUpdateInfo, varIndices) + sizeof(int) * dui1Ptr->length; - dui2Ptr = (DictUpdateInfo *)ckalloc(len); + len = offsetof(DictUpdateInfo, varIndices) + sizeof(size_t) * dui1Ptr->length; + dui2Ptr = (DictUpdateInfo *)Tcl_Alloc(len); memcpy(dui2Ptr, dui1Ptr, len); return dui2Ptr; } @@ -2281,7 +2285,7 @@ static void FreeDictUpdateInfo( void *clientData) { - ckfree(clientData); + Tcl_Free(clientData); } static void @@ -2289,16 +2293,16 @@ PrintDictUpdateInfo( void *clientData, Tcl_Obj *appendObj, TCL_UNUSED(ByteCode *), - TCL_UNUSED(unsigned int)) + TCL_UNUSED(size_t)) { DictUpdateInfo *duiPtr = (DictUpdateInfo *)clientData; - int i; + size_t i; for (i=0 ; i<duiPtr->length ; i++) { if (i) { Tcl_AppendToObj(appendObj, ", ", -1); } - Tcl_AppendPrintfToObj(appendObj, "%%v%u", duiPtr->varIndices[i]); + Tcl_AppendPrintfToObj(appendObj, "%%v%" TCL_Z_MODIFIER "u", duiPtr->varIndices[i]); } } @@ -2307,10 +2311,10 @@ DisassembleDictUpdateInfo( void *clientData, Tcl_Obj *dictObj, TCL_UNUSED(ByteCode *), - TCL_UNUSED(unsigned int)) + TCL_UNUSED(size_t)) { DictUpdateInfo *duiPtr = (DictUpdateInfo *)clientData; - int i; + size_t i; Tcl_Obj *variables; TclNewObj(variables); @@ -2355,7 +2359,7 @@ TclCompileErrorCmd( * General syntax: [error message ?errorInfo? ?errorCode?] */ - if (parsePtr->numWords < 2 || parsePtr->numWords > 4) { + if ((int)parsePtr->numWords < 2 || (int)parsePtr->numWords > 4) { return TCL_ERROR; } @@ -2435,7 +2439,7 @@ TclCompileExprCmd( envPtr->extCmdMapPtr->nuloc-1].line[1]; firstWordPtr = TokenAfter(parsePtr->tokenPtr); - TclCompileExprWords(interp, firstWordPtr, parsePtr->numWords-1, envPtr); + TclCompileExprWords(interp, firstWordPtr, (int)parsePtr->numWords-1, envPtr); return TCL_OK; } @@ -2685,7 +2689,8 @@ CompileEachloopCmd( Tcl_Token *tokenPtr, *bodyTokenPtr; int jumpBackOffset, infoIndex, range; - int numWords, numLists, i, j, code = TCL_OK; + int numWords, numLists, i, code = TCL_OK; + size_t j; Tcl_Obj *varListObj = NULL; /* @@ -2697,7 +2702,7 @@ CompileEachloopCmd( return TCL_ERROR; } - numWords = parsePtr->numWords; + numWords = (int)parsePtr->numWords; if ((numWords < 4) || (numWords%2 != 0)) { return TCL_ERROR; } @@ -2722,7 +2727,7 @@ CompileEachloopCmd( */ numLists = (numWords - 2)/2; - infoPtr = (ForeachInfo *)ckalloc(offsetof(ForeachInfo, varLists) + infoPtr = (ForeachInfo *)Tcl_Alloc(offsetof(ForeachInfo, varLists) + numLists * sizeof(ForeachVarList *)); infoPtr->numLists = 0; /* Count this up as we go */ @@ -2737,7 +2742,7 @@ CompileEachloopCmd( i < numWords-1; i++, tokenPtr = TokenAfter(tokenPtr)) { ForeachVarList *varListPtr; - int numVars; + size_t numVars; if (i%2 != 1) { continue; @@ -2756,8 +2761,8 @@ CompileEachloopCmd( goto done; } - varListPtr = (ForeachVarList *)ckalloc(offsetof(ForeachVarList, varIndexes) - + numVars * sizeof(int)); + varListPtr = (ForeachVarList *)Tcl_Alloc(offsetof(ForeachVarList, varIndexes) + + numVars * sizeof(size_t)); varListPtr->numVars = numVars; infoPtr->varLists[i/2] = varListPtr; infoPtr->numLists++; @@ -2765,11 +2770,13 @@ CompileEachloopCmd( for (j = 0; j < numVars; j++) { Tcl_Obj *varNameObj; const char *bytes; - int numBytes, varIndex; + int varIndex; + size_t length; + Tcl_ListObjIndex(NULL, varListObj, j, &varNameObj); - bytes = TclGetStringFromObj(varNameObj, &numBytes); - varIndex = LocalScalar(bytes, numBytes, envPtr); + bytes = Tcl_GetStringFromObj(varNameObj, &length); + varIndex = LocalScalar(bytes, length, envPtr); if (varIndex < 0) { code = TCL_ERROR; goto done; @@ -2892,7 +2899,7 @@ DupForeachInfo( ForeachVarList *srcListPtr, *dupListPtr; int numVars, i, j, numLists = srcPtr->numLists; - dupPtr = (ForeachInfo *)ckalloc(offsetof(ForeachInfo, varLists) + dupPtr = (ForeachInfo *)Tcl_Alloc(offsetof(ForeachInfo, varLists) + numLists * sizeof(ForeachVarList *)); dupPtr->numLists = numLists; dupPtr->firstValueTemp = srcPtr->firstValueTemp; @@ -2901,8 +2908,8 @@ DupForeachInfo( for (i = 0; i < numLists; i++) { srcListPtr = srcPtr->varLists[i]; numVars = srcListPtr->numVars; - dupListPtr = (ForeachVarList *)ckalloc(offsetof(ForeachVarList, varIndexes) - + numVars * sizeof(int)); + dupListPtr = (ForeachVarList *)Tcl_Alloc(offsetof(ForeachVarList, varIndexes) + + numVars * sizeof(size_t)); dupListPtr->numVars = numVars; for (j = 0; j < numVars; j++) { dupListPtr->varIndexes[j] = srcListPtr->varIndexes[j]; @@ -2938,14 +2945,13 @@ FreeForeachInfo( { ForeachInfo *infoPtr = (ForeachInfo *)clientData; ForeachVarList *listPtr; - int numLists = infoPtr->numLists; - int i; + size_t i, numLists = infoPtr->numLists; for (i = 0; i < numLists; i++) { listPtr = infoPtr->varLists[i]; - ckfree(listPtr); + Tcl_Free(listPtr); } - ckfree(infoPtr); + Tcl_Free(infoPtr); } /* @@ -2970,11 +2976,11 @@ PrintForeachInfo( void *clientData, Tcl_Obj *appendObj, TCL_UNUSED(ByteCode *), - TCL_UNUSED(unsigned int)) + TCL_UNUSED(size_t)) { ForeachInfo *infoPtr = (ForeachInfo *)clientData; ForeachVarList *varsPtr; - int i, j; + size_t i, j; Tcl_AppendToObj(appendObj, "data=[", -1); @@ -2982,24 +2988,24 @@ PrintForeachInfo( if (i) { Tcl_AppendToObj(appendObj, ", ", -1); } - Tcl_AppendPrintfToObj(appendObj, "%%v%u", - (unsigned) (infoPtr->firstValueTemp + i)); + Tcl_AppendPrintfToObj(appendObj, "%%v%" TCL_Z_MODIFIER "u", + (infoPtr->firstValueTemp + i)); } - Tcl_AppendPrintfToObj(appendObj, "], loop=%%v%u", - (unsigned) infoPtr->loopCtTemp); + Tcl_AppendPrintfToObj(appendObj, "], loop=%%v%" TCL_Z_MODIFIER "u", + infoPtr->loopCtTemp); for (i=0 ; i<infoPtr->numLists ; i++) { if (i) { Tcl_AppendToObj(appendObj, ",", -1); } - Tcl_AppendPrintfToObj(appendObj, "\n\t\t it%%v%u\t[", - (unsigned) (infoPtr->firstValueTemp + i)); + Tcl_AppendPrintfToObj(appendObj, "\n\t\t it%%v%" TCL_Z_MODIFIER "u\t[", + (infoPtr->firstValueTemp + i)); varsPtr = infoPtr->varLists[i]; for (j=0 ; j<varsPtr->numVars ; j++) { if (j) { Tcl_AppendToObj(appendObj, ", ", -1); } - Tcl_AppendPrintfToObj(appendObj, "%%v%u", - (unsigned) varsPtr->varIndexes[j]); + Tcl_AppendPrintfToObj(appendObj, "%%v%" TCL_Z_MODIFIER "u", + varsPtr->varIndexes[j]); } Tcl_AppendToObj(appendObj, "]", -1); } @@ -3010,13 +3016,13 @@ PrintNewForeachInfo( void *clientData, Tcl_Obj *appendObj, TCL_UNUSED(ByteCode *), - TCL_UNUSED(unsigned int)) + TCL_UNUSED(size_t)) { ForeachInfo *infoPtr = (ForeachInfo *)clientData; ForeachVarList *varsPtr; - int i, j; + size_t i, j; - Tcl_AppendPrintfToObj(appendObj, "jumpOffset=%+d, vars=", + Tcl_AppendPrintfToObj(appendObj, "jumpOffset=%+" TCL_Z_MODIFIER "d, vars=", infoPtr->loopCtTemp); for (i=0 ; i<infoPtr->numLists ; i++) { if (i) { @@ -3028,8 +3034,8 @@ PrintNewForeachInfo( if (j) { Tcl_AppendToObj(appendObj, ",", -1); } - Tcl_AppendPrintfToObj(appendObj, "%%v%u", - (unsigned) varsPtr->varIndexes[j]); + Tcl_AppendPrintfToObj(appendObj, "%%v%" TCL_Z_MODIFIER "u", + varsPtr->varIndexes[j]); } Tcl_AppendToObj(appendObj, "]", -1); } @@ -3040,11 +3046,11 @@ DisassembleForeachInfo( void *clientData, Tcl_Obj *dictObj, TCL_UNUSED(ByteCode *), - TCL_UNUSED(unsigned int)) + TCL_UNUSED(size_t)) { ForeachInfo *infoPtr = (ForeachInfo *)clientData; ForeachVarList *varsPtr; - int i, j; + size_t i, j; Tcl_Obj *objPtr, *innerPtr; /* @@ -3087,11 +3093,11 @@ DisassembleNewForeachInfo( void *clientData, Tcl_Obj *dictObj, TCL_UNUSED(ByteCode *), - TCL_UNUSED(unsigned int)) + TCL_UNUSED(size_t)) { ForeachInfo *infoPtr = (ForeachInfo *)clientData; ForeachVarList *varsPtr; - int i, j; + size_t i, j; Tcl_Obj *objPtr, *innerPtr; /* @@ -3149,13 +3155,14 @@ TclCompileFormatCmd( Tcl_Token *tokenPtr = parsePtr->tokenPtr; Tcl_Obj **objv, *formatObj, *tmpObj; const char *bytes, *start; - int i, j, len; + int i, j; + size_t len; /* * Don't handle any guaranteed-error cases. */ - if (parsePtr->numWords < 2) { + if ((int)parsePtr->numWords < 2) { return TCL_ERROR; } @@ -3172,8 +3179,8 @@ TclCompileFormatCmd( return TCL_ERROR; } - objv = (Tcl_Obj **)ckalloc((parsePtr->numWords-2) * sizeof(Tcl_Obj *)); - for (i=0 ; i+2 < parsePtr->numWords ; i++) { + objv = (Tcl_Obj **)Tcl_Alloc(((int)parsePtr->numWords-2) * sizeof(Tcl_Obj *)); + for (i=0 ; i+2 < (int)parsePtr->numWords ; i++) { tokenPtr = TokenAfter(tokenPtr); TclNewObj(objv[i]); Tcl_IncrRefCount(objv[i]); @@ -3187,12 +3194,12 @@ TclCompileFormatCmd( * the format is broken). Do the format now. */ - tmpObj = Tcl_Format(interp, Tcl_GetString(formatObj), - parsePtr->numWords-2, objv); + tmpObj = Tcl_Format(interp, TclGetString(formatObj), + (int)parsePtr->numWords-2, objv); for (; --i>=0 ;) { Tcl_DecrRefCount(objv[i]); } - ckfree(objv); + Tcl_Free(objv); Tcl_DecrRefCount(formatObj); if (tmpObj == NULL) { TclCompileSyntaxError(interp, envPtr); @@ -3204,7 +3211,7 @@ TclCompileFormatCmd( * literal. Job done. */ - bytes = TclGetStringFromObj(tmpObj, &len); + bytes = Tcl_GetStringFromObj(tmpObj, &len); PushLiteral(envPtr, bytes, len); Tcl_DecrRefCount(tmpObj); return TCL_OK; @@ -3222,7 +3229,7 @@ TclCompileFormatCmd( for (; i>=0 ; i--) { Tcl_DecrRefCount(objv[i]); } - ckfree(objv); + Tcl_Free(objv); tokenPtr = TokenAfter(parsePtr->tokenPtr); tokenPtr = TokenAfter(tokenPtr); i = 0; @@ -3231,7 +3238,7 @@ TclCompileFormatCmd( * Now scan through and check for non-%s and non-%% substitutions. */ - for (bytes = Tcl_GetString(formatObj) ; *bytes ; bytes++) { + for (bytes = TclGetString(formatObj) ; *bytes ; bytes++) { if (*bytes == '%') { bytes++; if (*bytes == 's') { @@ -3249,7 +3256,7 @@ TclCompileFormatCmd( * Check if the number of things to concatenate will fit in a byte. */ - if (i+2 != parsePtr->numWords || i > 125) { + if (i+2 != (int)parsePtr->numWords || i > 125) { Tcl_DecrRefCount(formatObj); return TCL_ERROR; } @@ -3264,7 +3271,7 @@ TclCompileFormatCmd( i = 0; /* The count of things to concat. */ j = 2; /* The index into the argument tokens, for * TIP#280 handling. */ - start = Tcl_GetString(formatObj); + start = TclGetString(formatObj); /* The start of the currently-scanned literal * in the format string. */ TclNewObj(tmpObj); /* The buffer used to accumulate the literal @@ -3275,7 +3282,7 @@ TclCompileFormatCmd( if (*++bytes == '%') { Tcl_AppendToObj(tmpObj, "%", 1); } else { - const char *b = TclGetStringFromObj(tmpObj, &len); + const char *b = Tcl_GetStringFromObj(tmpObj, &len); /* * If there is a non-empty literal from the format string, @@ -3309,7 +3316,7 @@ TclCompileFormatCmd( */ Tcl_AppendToObj(tmpObj, start, bytes - start); - bytes = TclGetStringFromObj(tmpObj, &len); + bytes = Tcl_GetStringFromObj(tmpObj, &len); if (len > 0) { PushLiteral(envPtr, bytes, len); i++; @@ -3339,15 +3346,15 @@ TclCompileFormatCmd( * Returns the non-negative integer index value into the table of * compiled locals corresponding to a local scalar variable name. * If the arguments passed in do not identify a local scalar variable - * then return -1. + * then return TCL_INDEX_NONE. * * Side effects: - * May add an entery into the table of compiled locals. + * May add an entry into the table of compiled locals. * *---------------------------------------------------------------------- */ -int +size_t TclLocalScalarFromToken( Tcl_Token *tokenPtr, CompileEnv *envPtr) @@ -3361,10 +3368,10 @@ TclLocalScalarFromToken( return index; } -int +size_t TclLocalScalar( const char *bytes, - int numBytes, + size_t numBytes, CompileEnv *envPtr) { Tcl_Token token[2] = {{TCL_TOKEN_SIMPLE_WORD, NULL, 0, 1}, @@ -3415,9 +3422,10 @@ TclPushVarName( { const char *p; const char *last, *name, *elName; - int n; + size_t n; Tcl_Token *elemTokenPtr = NULL; - int nameLen, elNameLen, simpleVarName, localIndex; + size_t nameLen, elNameLen; + int simpleVarName, localIndex; int elemTokenCount = 0, allocedTokens = 0, removedParen = 0; /* @@ -3492,7 +3500,7 @@ TclPushVarName( } } if (simpleVarName) { - int remainingLen; + size_t remainingLen; /* * Check the last token: if it is just ')', do not count it. diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c index 7bb06ab..c86d369 100644 --- a/generic/tclCompCmdsGR.c +++ b/generic/tclCompCmdsGR.c @@ -49,8 +49,8 @@ static int IndexTailVarIfKnown(Tcl_Interp *interp, int TclGetIndexFromToken( Tcl_Token *tokenPtr, - int before, - int after, + size_t before, + size_t after, int *indexPtr) { Tcl_Obj *tmpObj; @@ -181,7 +181,7 @@ TclCompileIfCmd( * determined. */ Tcl_Token *tokenPtr, *testTokenPtr; int jumpIndex = 0; /* Avoid compiler warning. */ - int numBytes, j; + size_t numBytes, j; int jumpFalseDist, numWords, wordIdx, code; const char *word; int realCond = 1; /* Set to 0 for static conditions: @@ -498,7 +498,7 @@ TclCompileIncrCmd( incrTokenPtr = TokenAfter(varTokenPtr); if (incrTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { const char *word = incrTokenPtr[1].start; - int numBytes = incrTokenPtr[1].size; + size_t numBytes = incrTokenPtr[1].size; int code; Tcl_Obj *intObj = Tcl_NewStringObj(word, numBytes); @@ -1359,7 +1359,7 @@ TclCompileLinsertCmd( Tcl_Token *tokenPtr; int i; - if (parsePtr->numWords < 3) { + if ((int)parsePtr->numWords < 3) { return TCL_ERROR; } @@ -1370,7 +1370,7 @@ TclCompileLinsertCmd( CompileWord(envPtr, tokenPtr, interp, 2); /* Push new elements to be inserted */ - for (i=3 ; i<parsePtr->numWords ; i++) { + for (i=3 ; i<(int)parsePtr->numWords ; i++) { tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, i); } @@ -1424,7 +1424,7 @@ TclCompileLreplaceCmd( CompileWord(envPtr, tokenPtr, interp, 3); /* Push new elements to be inserted */ - for (i=4 ; i<parsePtr->numWords ; i++) { + for (i=4 ; i< (int)parsePtr->numWords ; i++) { tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, i); } @@ -1502,7 +1502,7 @@ TclCompileLsetCmd( */ /* TODO: Consider support for compiling expanded args. */ - if (parsePtr->numWords < 3) { + if ((int)parsePtr->numWords < 3) { /* * Fail at run time, not in compilation. */ @@ -1526,7 +1526,7 @@ TclCompileLsetCmd( * Push the "index" args and the new element value. */ - for (i=2 ; i<parsePtr->numWords ; ++i) { + for (i=2 ; i<(int)parsePtr->numWords ; ++i) { varTokenPtr = TokenAfter(varTokenPtr); CompileWord(envPtr, varTokenPtr, interp, i); } @@ -1811,7 +1811,7 @@ TclCompileNamespaceUpvarCmd( * Only compile [namespace upvar ...]: needs an even number of args, >=4 */ - numWords = parsePtr->numWords; + numWords = (int)parsePtr->numWords; if ((numWords % 2) || (numWords < 4)) { return TCL_ERROR; } @@ -1863,7 +1863,7 @@ TclCompileNamespaceWhichCmd( Tcl_Token *tokenPtr, *opt; int idx; - if (parsePtr->numWords < 2 || parsePtr->numWords > 3) { + if ((int)parsePtr->numWords < 2 || (int)parsePtr->numWords > 3) { return TCL_ERROR; } tokenPtr = TokenAfter(parsePtr->tokenPtr); @@ -1925,7 +1925,7 @@ TclCompileRegexpCmd( DefineLineInformation; /* TIP #280 */ Tcl_Token *varTokenPtr; /* Pointer to the Tcl_Token representing the * parse of the RE or string. */ - int len; + size_t len; int i, nocase, exact, sawLast, simple; const char *str; @@ -1936,7 +1936,7 @@ TclCompileRegexpCmd( * regexp ?-nocase? ?--? {^staticString$} $var */ - if (parsePtr->numWords < 3) { + if ((int)parsePtr->numWords < 3) { return TCL_ERROR; } @@ -1951,7 +1951,7 @@ TclCompileRegexpCmd( * handling, but satisfies our stricter needs. */ - for (i = 1; i < parsePtr->numWords - 2; i++) { + for (i = 1; i < (int)parsePtr->numWords - 2; i++) { varTokenPtr = TokenAfter(varTokenPtr); if (varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { /* @@ -1977,7 +1977,7 @@ TclCompileRegexpCmd( } } - if ((parsePtr->numWords - i) != 2) { + if (((int)parsePtr->numWords - i) != 2) { /* * We don't support capturing to variables. */ @@ -2030,7 +2030,7 @@ TclCompileRegexpCmd( } if (!simple) { - CompileWord(envPtr, varTokenPtr, interp, parsePtr->numWords - 2); + CompileWord(envPtr, varTokenPtr, interp, (int)parsePtr->numWords - 2); } /* @@ -2038,7 +2038,7 @@ TclCompileRegexpCmd( */ varTokenPtr = TokenAfter(varTokenPtr); - CompileWord(envPtr, varTokenPtr, interp, parsePtr->numWords - 1); + CompileWord(envPtr, varTokenPtr, interp, (int)parsePtr->numWords - 1); if (simple) { if (exact && !nocase) { @@ -2113,9 +2113,9 @@ TclCompileRegsubCmd( Tcl_DString pattern; const char *bytes; int exact, quantified, result = TCL_ERROR; - int len; + size_t len; - if (parsePtr->numWords < 5 || parsePtr->numWords > 6) { + if ((int)parsePtr->numWords < 5 || (int)parsePtr->numWords > 6) { return TCL_ERROR; } @@ -2172,7 +2172,7 @@ TclCompileRegsubCmd( * replacement "simple"? */ - bytes = TclGetStringFromObj(patternObj, &len); + bytes = Tcl_GetStringFromObj(patternObj, &len); if (TclReToGlob(NULL, bytes, len, &pattern, &exact, &quantified) != TCL_OK || exact || quantified) { goto done; @@ -2191,7 +2191,7 @@ TclCompileRegsubCmd( */ len = Tcl_DStringLength(&pattern) - 2; - if (len > 0) { + if (len + 2 > 2) { goto isSimpleGlob; } @@ -2220,9 +2220,9 @@ TclCompileRegsubCmd( result = TCL_OK; bytes = Tcl_DStringValue(&pattern) + 1; PushLiteral(envPtr, bytes, len); - bytes = TclGetStringFromObj(replacementObj, &len); + bytes = Tcl_GetStringFromObj(replacementObj, &len); PushLiteral(envPtr, bytes, len); - CompileWord(envPtr, stringTokenPtr, interp, parsePtr->numWords - 2); + CompileWord(envPtr, stringTokenPtr, interp, (int)parsePtr->numWords - 2); TclEmitOpcode( INST_STR_MAP, envPtr); done: @@ -2268,7 +2268,7 @@ TclCompileReturnCmd( * An even number of words means an explicit result argument is present. */ int level, code, objc, status = TCL_OK; - int size; + size_t size; int numWords = parsePtr->numWords; int explicitResult = (0 == (numWords % 2)); int numOptionWords = numWords - 1 - explicitResult; @@ -2478,8 +2478,8 @@ TclCompileSyntaxError( CompileEnv *envPtr) { Tcl_Obj *msg = Tcl_GetObjResult(interp); - int numBytes; - const char *bytes = TclGetStringFromObj(msg, &numBytes); + size_t numBytes; + const char *bytes = Tcl_GetStringFromObj(msg, &numBytes); TclErrorStackResetIf(interp, bytes, numBytes); TclEmitPush(TclRegisterLiteral(envPtr, bytes, numBytes, 0), envPtr); @@ -2705,7 +2705,7 @@ IndexTailVarIfKnown( Tcl_Obj *tailPtr; const char *tailName, *p; int n = varTokenPtr->numComponents; - int len; + size_t len; Tcl_Token *lastTokenPtr; int full, localIndex; @@ -2737,7 +2737,7 @@ IndexTailVarIfKnown( Tcl_SetStringObj(tailPtr, lastTokenPtr->start, lastTokenPtr->size); } - tailName = TclGetStringFromObj(tailPtr, &len); + tailName = Tcl_GetStringFromObj(tailPtr, &len); if (len) { if (*(tailName + len - 1) == ')') { @@ -2798,11 +2798,11 @@ TclCompileObjectNextCmd( Tcl_Token *tokenPtr = parsePtr->tokenPtr; int i; - if (parsePtr->numWords > 255) { + if ((int)parsePtr->numWords > 255) { return TCL_ERROR; } - for (i=0 ; i<parsePtr->numWords ; i++) { + for (i=0 ; i<(int)parsePtr->numWords ; i++) { CompileWord(envPtr, tokenPtr, interp, i); tokenPtr = TokenAfter(tokenPtr); } @@ -2822,11 +2822,11 @@ TclCompileObjectNextToCmd( Tcl_Token *tokenPtr = parsePtr->tokenPtr; int i; - if (parsePtr->numWords < 2 || parsePtr->numWords > 255) { + if ((int)parsePtr->numWords < 2 || (int)parsePtr->numWords > 255) { return TCL_ERROR; } - for (i=0 ; i<parsePtr->numWords ; i++) { + for (i=0 ; i<(int)parsePtr->numWords ; i++) { CompileWord(envPtr, tokenPtr, interp, i); tokenPtr = TokenAfter(tokenPtr); } diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c index 40ad82b..0e98584 100644 --- a/generic/tclCompCmdsSZ.c +++ b/generic/tclCompCmdsSZ.c @@ -252,8 +252,8 @@ TclCompileStringCatCmd( } else { Tcl_DecrRefCount(obj); if (folded) { - int len; - const char *bytes = TclGetStringFromObj(folded, &len); + size_t len; + const char *bytes = Tcl_GetStringFromObj(folded, &len); PushLiteral(envPtr, bytes, len); Tcl_DecrRefCount(folded); @@ -270,8 +270,8 @@ TclCompileStringCatCmd( wordTokenPtr = TokenAfter(wordTokenPtr); } if (folded) { - int len; - const char *bytes = TclGetStringFromObj(folded, &len); + size_t len; + const char *bytes = Tcl_GetStringFromObj(folded, &len); PushLiteral(envPtr, bytes, len); Tcl_DecrRefCount(folded); @@ -518,8 +518,8 @@ TclCompileStringIsCmd( STR_IS_LIST, STR_IS_LOWER, STR_IS_PRINT, STR_IS_PUNCT, STR_IS_SPACE, STR_IS_TRUE, STR_IS_UPPER, STR_IS_UNICODE, STR_IS_WIDE, STR_IS_WORD, STR_IS_XDIGIT - }; - int t, range, allowEmpty = 0, end; + } t; + int range, allowEmpty = 0, end; InstStringClassType strClassType; Tcl_Obj *isClass; @@ -573,9 +573,9 @@ TclCompileStringIsCmd( * 5. Lists */ - CompileWord(envPtr, tokenPtr, interp, parsePtr->numWords-1); + CompileWord(envPtr, tokenPtr, interp, (int)parsePtr->numWords-1); - switch ((enum isClassesEnum) t) { + switch (t) { case STR_IS_ALNUM: strClassType = STR_CLASS_ALNUM; goto compileStrClass; @@ -683,6 +683,8 @@ TclCompileStringIsCmd( FIXJUMP1( over); OP( LNOT); return TCL_OK; + default: + break; } break; @@ -748,6 +750,8 @@ TclCompileStringIsCmd( PUSH( "3"); OP( LE); break; + default: + break; } FIXJUMP1( end); return TCL_OK; @@ -794,7 +798,8 @@ TclCompileStringMatchCmd( { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr; - int i, length, exactMatch = 0, nocase = 0; + size_t length; + int i, exactMatch = 0, nocase = 0; const char *str; if (parsePtr->numWords < 3 || parsePtr->numWords > 4) { @@ -890,9 +895,9 @@ TclCompileStringLenCmd( */ char buf[TCL_INTEGER_SPACE]; - int len = TclGetCharLength(objPtr); + size_t len = Tcl_GetCharLength(objPtr); - len = sprintf(buf, "%d", len); + len = sprintf(buf, "%" TCL_Z_MODIFIER "u", len); PushLiteral(envPtr, buf, len); } else { SetLineInformation(1); @@ -916,7 +921,7 @@ TclCompileStringMapCmd( Tcl_Token *mapTokenPtr, *stringTokenPtr; Tcl_Obj *mapObj, **objv; const char *bytes; - int len; + size_t len, slen; /* * We only handle the case: @@ -952,13 +957,13 @@ TclCompileStringMapCmd( * correct semantics for mapping. */ - bytes = TclGetStringFromObj(objv[0], &len); - if (len == 0) { + bytes = Tcl_GetStringFromObj(objv[0], &slen); + if (slen == 0) { CompileWord(envPtr, stringTokenPtr, interp, 2); } else { - PushLiteral(envPtr, bytes, len); - bytes = TclGetStringFromObj(objv[1], &len); - PushLiteral(envPtr, bytes, len); + PushLiteral(envPtr, bytes, slen); + bytes = Tcl_GetStringFromObj(objv[1], &slen); + PushLiteral(envPtr, bytes, slen); CompileWord(envPtr, stringTokenPtr, interp, 2); OP(STR_MAP); } @@ -1053,7 +1058,7 @@ TclCompileStringReplaceCmd( Tcl_Token *tokenPtr, *valueTokenPtr; int first, last; - if (parsePtr->numWords < 4 || parsePtr->numWords > 5) { + if ((int)parsePtr->numWords < 4 || (int)parsePtr->numWords > 5) { return TCL_ERROR; } @@ -1512,13 +1517,14 @@ void TclSubstCompile( Tcl_Interp *interp, const char *bytes, - int numBytes, + size_t numBytes, int flags, - int line, + size_t line, CompileEnv *envPtr) { Tcl_Token *endTokenPtr, *tokenPtr; - int breakOffset = 0, count = 0, bline = line; + int breakOffset = 0, count = 0; + size_t bline = line; Tcl_Parse parse; Tcl_InterpState state = NULL; @@ -1543,7 +1549,8 @@ TclSubstCompile( for (endTokenPtr = tokenPtr + parse.numTokens; tokenPtr < endTokenPtr; tokenPtr = TokenAfter(tokenPtr)) { - int length, literal, catchRange, breakJump; + size_t length; + int literal, catchRange, breakJump; char buf[4] = ""; JumpFixup startFixup, okFixup, returnFixup, breakFixup; JumpFixup continueFixup, otherFixup, endFixup; @@ -1574,7 +1581,8 @@ TclSubstCompile( */ if (tokenPtr->numComponents > 1) { - int i, foundCommand = 0; + size_t i; + int foundCommand = 0; for (i=2 ; i<=tokenPtr->numComponents ; i++) { if (tokenPtr[i].type == TCL_TOKEN_COMMAND) { @@ -1613,8 +1621,8 @@ TclSubstCompile( /* Start */ if (TclFixupForwardJumpToHere(envPtr, &startFixup, 127)) { - Tcl_Panic("TclCompileSubstCmd: bad start jump distance %d", - (int) (CurrentOffset(envPtr) - startFixup.codeOffset)); + Tcl_Panic("TclCompileSubstCmd: bad start jump distance %" TCL_Z_MODIFIER "d", + CurrentOffset(envPtr) - startFixup.codeOffset); } } @@ -1672,8 +1680,8 @@ TclSubstCompile( TclAdjustStackDepth(1, envPtr); /* BREAK destination */ if (TclFixupForwardJumpToHere(envPtr, &breakFixup, 127)) { - Tcl_Panic("TclCompileSubstCmd: bad break jump distance %d", - (int) (CurrentOffset(envPtr) - breakFixup.codeOffset)); + Tcl_Panic("TclCompileSubstCmd: bad break jump distance %" TCL_Z_MODIFIER "d", + CurrentOffset(envPtr) - breakFixup.codeOffset); } OP( POP); OP( POP); @@ -1688,8 +1696,8 @@ TclSubstCompile( TclAdjustStackDepth(2, envPtr); /* CONTINUE destination */ if (TclFixupForwardJumpToHere(envPtr, &continueFixup, 127)) { - Tcl_Panic("TclCompileSubstCmd: bad continue jump distance %d", - (int) (CurrentOffset(envPtr) - continueFixup.codeOffset)); + Tcl_Panic("TclCompileSubstCmd: bad continue jump distance %" TCL_Z_MODIFIER "d", + CurrentOffset(envPtr) - continueFixup.codeOffset); } OP( POP); OP( POP); @@ -1698,12 +1706,12 @@ TclSubstCompile( TclAdjustStackDepth(2, envPtr); /* RETURN + other destination */ if (TclFixupForwardJumpToHere(envPtr, &returnFixup, 127)) { - Tcl_Panic("TclCompileSubstCmd: bad return jump distance %d", - (int) (CurrentOffset(envPtr) - returnFixup.codeOffset)); + Tcl_Panic("TclCompileSubstCmd: bad return jump distance %" TCL_Z_MODIFIER "d", + CurrentOffset(envPtr) - returnFixup.codeOffset); } if (TclFixupForwardJumpToHere(envPtr, &otherFixup, 127)) { - Tcl_Panic("TclCompileSubstCmd: bad other jump distance %d", - (int) (CurrentOffset(envPtr) - otherFixup.codeOffset)); + Tcl_Panic("TclCompileSubstCmd: bad other jump distance %" TCL_Z_MODIFIER "d", + CurrentOffset(envPtr) - otherFixup.codeOffset); } /* @@ -1715,8 +1723,8 @@ TclSubstCompile( /* OK destination */ if (TclFixupForwardJumpToHere(envPtr, &okFixup, 127)) { - Tcl_Panic("TclCompileSubstCmd: bad ok jump distance %d", - (int) (CurrentOffset(envPtr) - okFixup.codeOffset)); + Tcl_Panic("TclCompileSubstCmd: bad ok jump distance %" TCL_Z_MODIFIER "d", + CurrentOffset(envPtr) - okFixup.codeOffset); } if (count > 1) { OP1(STR_CONCAT1, count); @@ -1725,8 +1733,8 @@ TclSubstCompile( /* CONTINUE jump to here */ if (TclFixupForwardJumpToHere(envPtr, &endFixup, 127)) { - Tcl_Panic("TclCompileSubstCmd: bad end jump distance %d", - (int) (CurrentOffset(envPtr) - endFixup.codeOffset)); + Tcl_Panic("TclCompileSubstCmd: bad end jump distance %" TCL_Z_MODIFIER "d", + CurrentOffset(envPtr) - endFixup.codeOffset); } bline = envPtr->line; } @@ -1846,7 +1854,7 @@ TclCompileSwitchCmd( */ for (; numWords>=3 ; tokenPtr=TokenAfter(tokenPtr),numWords--) { - unsigned size = tokenPtr[1].size; + size_t size = tokenPtr[1].size; const char *chrs = tokenPtr[1].start; /* @@ -1937,8 +1945,8 @@ TclCompileSwitchCmd( if (numWords == 1) { const char *bytes; - int maxLen, numBytes; - int bline; /* TIP #280: line of the pattern/action list, + size_t maxLen, numBytes; + size_t 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. */ @@ -1954,10 +1962,10 @@ TclCompileSwitchCmd( if (maxLen < 2) { return TCL_ERROR; } - bodyTokenArray = (Tcl_Token *)ckalloc(sizeof(Tcl_Token) * maxLen); - bodyToken = (Tcl_Token **)ckalloc(sizeof(Tcl_Token *) * maxLen); - bodyLines = (int *)ckalloc(sizeof(int) * maxLen); - bodyContLines = (int **)ckalloc(sizeof(int*) * maxLen); + bodyTokenArray = (Tcl_Token *)Tcl_Alloc(sizeof(Tcl_Token) * maxLen); + bodyToken = (Tcl_Token **)Tcl_Alloc(sizeof(Tcl_Token *) * maxLen); + bodyLines = (int *)Tcl_Alloc(sizeof(int) * maxLen); + bodyContLines = (int **)Tcl_Alloc(sizeof(int*) * maxLen); bline = mapPtr->loc[eclIndex].line[valueIndex+1]; numWords = 0; @@ -1995,10 +2003,10 @@ TclCompileSwitchCmd( } if (numWords % 2) { abort: - ckfree(bodyToken); - ckfree(bodyTokenArray); - ckfree(bodyLines); - ckfree(bodyContLines); + Tcl_Free(bodyToken); + Tcl_Free(bodyTokenArray); + Tcl_Free(bodyLines); + Tcl_Free(bodyContLines); return TCL_ERROR; } } else if (numWords % 2 || numWords == 0) { @@ -2016,9 +2024,9 @@ TclCompileSwitchCmd( * Multi-word definition of patterns & actions. */ - bodyToken = (Tcl_Token **)ckalloc(sizeof(Tcl_Token *) * numWords); - bodyLines = (int *)ckalloc(sizeof(int) * numWords); - bodyContLines = (int **)ckalloc(sizeof(int*) * numWords); + bodyToken = (Tcl_Token **)Tcl_Alloc(sizeof(Tcl_Token *) * numWords); + bodyLines = (int *)Tcl_Alloc(sizeof(int) * numWords); + bodyContLines = (int **)Tcl_Alloc(sizeof(int*) * numWords); bodyTokenArray = NULL; for (i=0 ; i<numWords ; i++) { /* @@ -2077,11 +2085,11 @@ TclCompileSwitchCmd( */ freeTemporaries: - ckfree(bodyToken); - ckfree(bodyLines); - ckfree(bodyContLines); + Tcl_Free(bodyToken); + Tcl_Free(bodyLines); + Tcl_Free(bodyContLines); if (bodyTokenArray != NULL) { - ckfree(bodyTokenArray); + Tcl_Free(bodyTokenArray); } return result; } @@ -2380,7 +2388,7 @@ IssueSwitchJumpTable( * Start by allocating the jump table itself, plus some workspace. */ - jtPtr = (JumptableInfo *)ckalloc(sizeof(JumptableInfo)); + jtPtr = (JumptableInfo *)Tcl_Alloc(sizeof(JumptableInfo)); Tcl_InitHashTable(&jtPtr->hashTable, TCL_STRING_KEYS); infoIndex = TclCreateAuxData(jtPtr, &tclJumptableInfoType, envPtr); finalFixups = (int *)TclStackAlloc(interp, sizeof(int) * (numBodyTokens/2)); @@ -2552,7 +2560,7 @@ DupJumptableInfo( void *clientData) { JumptableInfo *jtPtr = (JumptableInfo *)clientData; - JumptableInfo *newJtPtr = (JumptableInfo *)ckalloc(sizeof(JumptableInfo)); + JumptableInfo *newJtPtr = (JumptableInfo *)Tcl_Alloc(sizeof(JumptableInfo)); Tcl_HashEntry *hPtr, *newHPtr; Tcl_HashSearch search; int isNew; @@ -2574,7 +2582,7 @@ FreeJumptableInfo( JumptableInfo *jtPtr = (JumptableInfo *)clientData; Tcl_DeleteHashTable(&jtPtr->hashTable); - ckfree(jtPtr); + Tcl_Free(jtPtr); } static void @@ -2582,13 +2590,13 @@ PrintJumptableInfo( void *clientData, Tcl_Obj *appendObj, TCL_UNUSED(ByteCode *), - unsigned int pcOffset) + size_t pcOffset) { JumptableInfo *jtPtr = (JumptableInfo *)clientData; Tcl_HashEntry *hPtr; Tcl_HashSearch search; const char *keyPtr; - int offset, i = 0; + size_t offset, i = 0; hPtr = Tcl_FirstHashEntry(&jtPtr->hashTable, &search); for (; hPtr ; hPtr = Tcl_NextHashEntry(&search)) { @@ -2601,7 +2609,7 @@ PrintJumptableInfo( Tcl_AppendToObj(appendObj, "\n\t\t", -1); } } - Tcl_AppendPrintfToObj(appendObj, "\"%s\"->pc %d", + Tcl_AppendPrintfToObj(appendObj, "\"%s\"->pc %" TCL_Z_MODIFIER "u", keyPtr, pcOffset + offset); } } @@ -2611,7 +2619,7 @@ DisassembleJumptableInfo( void *clientData, Tcl_Obj *dictObj, TCL_UNUSED(ByteCode *), - TCL_UNUSED(unsigned int)) + TCL_UNUSED(size_t)) { JumptableInfo *jtPtr = (JumptableInfo *)clientData; Tcl_Obj *mapping; @@ -2669,11 +2677,11 @@ TclCompileTailcallCmd( /* make room for the nsObjPtr */ /* TODO: Doesn't this have to be a known value? */ CompileWord(envPtr, tokenPtr, interp, 0); - for (i=1 ; i<parsePtr->numWords ; i++) { + for (i=1 ; i<(int)parsePtr->numWords ; i++) { tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, i); } - TclEmitInstInt1( INST_TAILCALL, parsePtr->numWords, envPtr); + TclEmitInstInt1( INST_TAILCALL, (int)parsePtr->numWords, envPtr); return TCL_OK; } @@ -2707,7 +2715,8 @@ TclCompileThrowCmd( int numWords = parsePtr->numWords; Tcl_Token *codeToken, *msgToken; Tcl_Obj *objPtr; - int codeKnown, codeIsList, codeIsValid, len; + int codeKnown, codeIsList, codeIsValid; + size_t len; if (numWords != 3) { return TCL_ERROR; @@ -2848,7 +2857,7 @@ TclCompileTryCmd( for (i=0 ; i<numHandlers ; i++) { Tcl_Obj *tmpObj, **objv; - int objc; + size_t objc; if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { goto failedToCompile; @@ -2913,8 +2922,8 @@ TclCompileTryCmd( goto failedToCompile; } if (objc > 0) { - int len; - const char *varname = TclGetStringFromObj(objv[0], &len); + size_t len; + const char *varname = Tcl_GetStringFromObj(objv[0], &len); resultVarIndices[i] = LocalScalar(varname, len, envPtr); if (resultVarIndices[i] < 0) { @@ -2925,8 +2934,8 @@ TclCompileTryCmd( resultVarIndices[i] = -1; } if (objc == 2) { - int len; - const char *varname = TclGetStringFromObj(objv[1], &len); + size_t len; + const char *varname = Tcl_GetStringFromObj(objv[1], &len); optionVarIndices[i] = LocalScalar(varname, len, envPtr); if (optionVarIndices[i] < 0) { @@ -3046,7 +3055,8 @@ IssueTryClausesInstructions( { DefineLineInformation; /* TIP #280 */ int range, resultVar, optionsVar; - int i, j, len, forwardsNeedFixing = 0, trapZero = 0, afterBody = 0; + int i, j, forwardsNeedFixing = 0, trapZero = 0, afterBody = 0; + size_t slen, len; int *addrsToFix, *forwardsToFix, notCodeJumpSource, notECJumpSource; int *noError; char buf[TCL_INTEGER_SPACE]; @@ -3132,8 +3142,8 @@ IssueTryClausesInstructions( OP4( DICT_GET, 1); TclAdjustStackDepth(-1, envPtr); OP44( LIST_RANGE_IMM, 0, len-1); - p = TclGetStringFromObj(matchClauses[i], &len); - PushLiteral(envPtr, p, len); + p = Tcl_GetStringFromObj(matchClauses[i], &slen); + PushLiteral(envPtr, p, slen); OP( STR_EQ); JUMP4( JUMP_FALSE, notECJumpSource); } else { @@ -3256,10 +3266,11 @@ IssueTryClausesFinallyInstructions( Tcl_Token *finallyToken) /* Not NULL */ { DefineLineInformation; /* TIP #280 */ - int range, resultVar, optionsVar, i, j, len, forwardsNeedFixing = 0; + int range, resultVar, optionsVar, i, j, forwardsNeedFixing = 0; int trapZero = 0, afterBody = 0, finalOK, finalError, noFinalError; int *addrsToFix, *forwardsToFix, notCodeJumpSource, notECJumpSource; char buf[TCL_INTEGER_SPACE]; + size_t slen, len; resultVar = AnonymousLocal(envPtr); optionsVar = AnonymousLocal(envPtr); @@ -3343,8 +3354,8 @@ IssueTryClausesFinallyInstructions( OP4( DICT_GET, 1); TclAdjustStackDepth(-1, envPtr); OP44( LIST_RANGE_IMM, 0, len-1); - p = TclGetStringFromObj(matchClauses[i], &len); - PushLiteral(envPtr, p, len); + p = Tcl_GetStringFromObj(matchClauses[i], &slen); + PushLiteral(envPtr, p, slen); OP( STR_EQ); JUMP4( JUMP_FALSE, notECJumpSource); } else { @@ -3630,7 +3641,7 @@ TclCompileUnsetCmd( * push/rotate. [Bug 3970f54c4e] */ - for (i=1,varTokenPtr=parsePtr->tokenPtr ; i<parsePtr->numWords ; i++) { + for (i=1,varTokenPtr=parsePtr->tokenPtr ; i<(int)parsePtr->numWords ; i++) { Tcl_Obj *leadingWord; TclNewObj(leadingWord); @@ -3669,9 +3680,9 @@ TclCompileUnsetCmd( } if (varCount == 0) { const char *bytes; - int len; + size_t len; - bytes = TclGetStringFromObj(leadingWord, &len); + bytes = Tcl_GetStringFromObj(leadingWord, &len); if (i == 1 && len == 11 && !strncmp("-nocomplain", bytes, 11)) { flags = 0; haveFlags++; @@ -3694,7 +3705,7 @@ TclCompileUnsetCmd( for (i=0; i<haveFlags;i++) { varTokenPtr = TokenAfter(varTokenPtr); } - for (i=1+haveFlags ; i<parsePtr->numWords ; i++) { + for (i=1+haveFlags ; i<(int)parsePtr->numWords ; i++) { /* * Decide if we can use a frame slot for the var/array name or if we * need to emit code to compute and push the name at runtime. We use a @@ -3979,12 +3990,12 @@ TclCompileYieldToCmd( Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr); int i; - if (parsePtr->numWords < 2) { + if ((int)parsePtr->numWords < 2) { return TCL_ERROR; } OP( NS_CURRENT); - for (i = 1 ; i < parsePtr->numWords ; i++) { + for (i = 1 ; i < (int)parsePtr->numWords ; i++) { CompileWord(envPtr, tokenPtr, interp, i); tokenPtr = TokenAfter(tokenPtr); } @@ -4062,7 +4073,7 @@ CompileAssociativeBinaryOpCmd( { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr = parsePtr->tokenPtr; - int words; + size_t words; /* TODO: Consider support for compiling expanded args. */ for (words=1 ; words<parsePtr->numWords ; words++) { @@ -4149,7 +4160,7 @@ CompileComparisonOpCmd( Tcl_Token *tokenPtr; /* TODO: Consider support for compiling expanded args. */ - if (parsePtr->numWords < 3) { + if ((int)parsePtr->numWords < 3) { PUSH("1"); } else if (parsePtr->numWords == 3) { tokenPtr = TokenAfter(parsePtr->tokenPtr); @@ -4165,7 +4176,7 @@ CompileComparisonOpCmd( return TCL_ERROR; } else { int tmpIndex = AnonymousLocal(envPtr); - int words; + size_t words; tokenPtr = TokenAfter(parsePtr->tokenPtr); CompileWord(envPtr, tokenPtr, interp, 1); @@ -4301,7 +4312,7 @@ TclCompilePowOpCmd( { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr = parsePtr->tokenPtr; - int words; + size_t words; /* * This one has its own implementation because the ** operator is the only @@ -4502,7 +4513,7 @@ TclCompileMinusOpCmd( { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr = parsePtr->tokenPtr; - int words; + size_t words; /* TODO: Consider support for compiling expanded args. */ if (parsePtr->numWords == 1) { @@ -4547,7 +4558,7 @@ TclCompileDivOpCmd( { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr = parsePtr->tokenPtr; - int words; + size_t words; /* TODO: Consider support for compiling expanded args. */ if (parsePtr->numWords == 1) { diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c index ded32aa..7ad2fb0 100644 --- a/generic/tclCompExpr.c +++ b/generic/tclCompExpr.c @@ -22,7 +22,7 @@ * The tree is composed of OpNodes. */ -typedef struct OpNode { +typedef struct { int left; /* "Pointer" to the left operand. */ int right; /* "Pointer" to the right operand. */ union { @@ -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, int numBytes, +static void ConvertTreeToTokens(const char *start, size_t 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, - int numBytes, OpNode **opTreePtr, + size_t numBytes, OpNode **opTreePtr, Tcl_Obj *litList, Tcl_Obj *funcList, Tcl_Parse *parsePtr, int parseOnly); -static int ParseLexeme(const char *start, int numBytes, +static size_t ParseLexeme(const char *start, size_t numBytes, unsigned char *lexemePtr, Tcl_Obj **literalPtr); /* @@ -546,7 +546,7 @@ static int ParseLexeme(const char *start, int numBytes, * Side effects: * Memory will be allocated. If TCL_OK is returned, the caller must clean * up the returned data structures. The (OpNode *) value written to - * opTreePtr should be passed to ckfree() and the parsePtr argument + * opTreePtr should be passed to Tcl_Free() and the parsePtr argument * should be passed to Tcl_FreeParse(). The elements appended to the * litList and funcList will automatically be freed whenever the refcount * on those lists indicates they can be freed. @@ -558,7 +558,7 @@ static int ParseExpr( Tcl_Interp *interp, /* Used for error reporting. */ const char *start, /* Start of source string to parse. */ - int numBytes, /* Number of bytes in string. */ + size_t 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. */ @@ -581,7 +581,7 @@ ParseExpr( * no need for array growth and * reallocation. */ unsigned int nodesUsed = 0; /* Number of OpNodes filled. */ - int scanned = 0; /* Capture number of byte scanned by parsing + size_t 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 int limit = 25; /* Portions of the error message are + const unsigned 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 @@ -633,7 +633,7 @@ ParseExpr( TclParseInit(interp, start, numBytes, parsePtr); - nodes = (OpNode *)attemptckalloc(nodesAvailable * sizeof(OpNode)); + nodes = (OpNode *)Tcl_AttemptAlloc(nodesAvailable * sizeof(OpNode)); if (nodes == NULL) { TclNewLiteralStringObj(msg, "not enough memory to parse expression"); errCode = "NOMEM"; @@ -677,7 +677,7 @@ ParseExpr( do { if (size <= UINT_MAX/sizeof(OpNode)) { - newPtr = (OpNode *) attemptckrealloc(nodes, + newPtr = (OpNode *) Tcl_AttemptRealloc(nodes, size * sizeof(OpNode)); } } while ((newPtr == NULL) @@ -717,12 +717,12 @@ ParseExpr( continue; case INVALID: msg = Tcl_ObjPrintf("invalid character \"%.*s\"", - scanned, start); + (int)scanned, start); errCode = "BADCHAR"; goto error; case INCOMPLETE: msg = Tcl_ObjPrintf("incomplete operator \"%.*s\"", - scanned, start); + (int)scanned, start); errCode = "PARTOP"; goto error; case BAREWORD: @@ -777,16 +777,16 @@ ParseExpr( Tcl_DecrRefCount(literal); msg = Tcl_ObjPrintf("invalid bareword \"%.*s%s\"", - (scanned < limit) ? scanned : limit - 3, start, + (scanned < limit) ? (int)scanned : (int)limit - 3, start, (scanned < limit) ? "" : "..."); post = Tcl_ObjPrintf( "should be \"$%.*s%s\" or \"{%.*s%s}\"", - (scanned < limit) ? scanned : limit - 3, + (scanned < limit) ? (int)scanned : (int)limit - 3, start, (scanned < limit) ? "" : "...", - (scanned < limit) ? scanned : limit - 3, + (scanned < limit) ? (int)scanned : (int)limit - 3, start, (scanned < limit) ? "" : "..."); Tcl_AppendPrintfToObj(post, " or \"%.*s%s(...)\" or ...", - (scanned < limit) ? scanned : limit - 3, + (scanned < limit) ? (int)scanned : (int)limit - 3, start, (scanned < limit) ? "" : "..."); errCode = "BAREWORD"; if (start[0] == '0') { @@ -1418,7 +1418,7 @@ ParseExpr( */ if (nodes != NULL) { - ckfree(nodes); + Tcl_Free(nodes); } if (interp == NULL) { @@ -1447,13 +1447,13 @@ ParseExpr( Tcl_AppendPrintfToObj(msg, "\nin expression \"%s%.*s%.*s%s%s%.*s%s\"", ((start - limit) < parsePtr->string) ? "" : "...", ((start - limit) < parsePtr->string) - ? (int) (start - parsePtr->string) : limit - 3, + ? (int) (start - parsePtr->string) : (int)limit - 3, ((start - limit) < parsePtr->string) ? parsePtr->string : start - limit + 3, - (scanned < limit) ? scanned : limit - 3, start, + (scanned < limit) ? (int)scanned : (int)limit - 3, start, (scanned < limit) ? "" : "...", insertMark ? mark : "", (start + scanned + limit > parsePtr->end) - ? (int) (parsePtr->end - start) - scanned : limit-3, + ? (int) (parsePtr->end - start) - (int)scanned : (int)limit-3, start + scanned, (start + scanned + limit > parsePtr->end) ? "" : "..."); @@ -1475,7 +1475,7 @@ ParseExpr( numBytes = parsePtr->end - parsePtr->string; Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (parsing expression \"%.*s%s\")", - (numBytes < limit) ? numBytes : limit - 3, + (numBytes < limit) ? (int)numBytes : (int)limit - 3, parsePtr->string, (numBytes < limit) ? "" : "...")); if (errCode) { Tcl_SetErrorCode(interp, "TCL", "PARSE", "EXPR", errCode, @@ -1512,7 +1512,7 @@ ParseExpr( static void ConvertTreeToTokens( const char *start, - int numBytes, + size_t numBytes, OpNode *nodes, Tcl_Token *tokenPtr, Tcl_Parse *parsePtr) @@ -1601,7 +1601,7 @@ ConvertTreeToTokens( TclGrowParseTokenArray(parsePtr, toCopy); subExprTokenPtr = parsePtr->tokenPtr + parsePtr->numTokens; memcpy(subExprTokenPtr, tokenPtr, - (size_t) toCopy * sizeof(Tcl_Token)); + toCopy * sizeof(Tcl_Token)); subExprTokenPtr->type = TCL_TOKEN_SUB_EXPR; parsePtr->numTokens += toCopy; } else { @@ -1618,7 +1618,7 @@ ConvertTreeToTokens( subExprTokenPtr->numComponents++; subExprTokenPtr++; memcpy(subExprTokenPtr, tokenPtr, - (size_t) toCopy * sizeof(Tcl_Token)); + toCopy * sizeof(Tcl_Token)); parsePtr->numTokens += toCopy + 1; } @@ -1730,7 +1730,7 @@ ConvertTreeToTokens( scanned = ParseLexeme(start, numBytes, &lexeme, NULL); - switch(nodePtr->lexeme) { + switch (nodePtr->lexeme) { case OPEN_PAREN: case COMMA: case COLON: @@ -1806,7 +1806,7 @@ ConvertTreeToTokens( */ subExprTokenPtr->numComponents = - (parsePtr->numTokens - subExprTokenIdx) - 1; + ((int)parsePtr->numTokens - subExprTokenIdx) - 1; /* * Finally, as we return up the tree to our parent, pop the @@ -1860,7 +1860,7 @@ int Tcl_ParseExpr( Tcl_Interp *interp, /* Used for error reporting. */ const char *start, /* Start of source string to parse. */ - int numBytes, /* Number of bytes in string. If < 0, the + size_t 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 < 0) { + if (numBytes == TCL_INDEX_NONE) { numBytes = (start ? strlen(start) : 0); } @@ -1896,7 +1896,7 @@ Tcl_ParseExpr( Tcl_FreeParse(exprParsePtr); TclStackFree(interp, exprParsePtr); - ckfree(opTree); + Tcl_Free(opTree); return code; } @@ -1917,17 +1917,16 @@ Tcl_ParseExpr( *---------------------------------------------------------------------- */ -static int +static size_t ParseLexeme( const char *start, /* Start of lexeme to parse. */ - int numBytes, /* Number of bytes in string. */ + size_t 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 storage, if non-NULL. */ { const char *end; - int scanned, size; int ch; Tcl_Obj *literal = NULL; unsigned char byte; @@ -1942,15 +1941,18 @@ ParseLexeme( return 1; } switch (byte) { - case '#': + case '#': { /* * Scan forward over the comment contents. */ + size_t size; + for (size = 0; byte != '\n' && byte != 0 && size < numBytes; size++) { byte = UCHAR(start[size]); } *lexemePtr = COMMENT; return size - (byte == '\n'); + } case '*': if ((numBytes > 1) && (start[1] == '*')) { @@ -2145,6 +2147,7 @@ ParseLexeme( */ if (!TclIsBareword(*start) || *start == '_') { + size_t scanned; if (Tcl_UtfCharComplete(start, numBytes)) { scanned = TclUtfToUCS4(start, &ch); } else { @@ -2194,7 +2197,7 @@ void TclCompileExpr( Tcl_Interp *interp, /* Used for error reporting. */ const char *script, /* The source script to compile. */ - int numBytes, /* Number of bytes in script. */ + size_t numBytes, /* Number of bytes in script. */ CompileEnv *envPtr, /* Holds resulting instructions. */ int optimize) /* 0 for one-off expressions. */ { @@ -2215,7 +2218,7 @@ TclCompileExpr( * Valid parse; compile the tree. */ - int objc; + size_t objc; Tcl_Obj *const *litObjv; Tcl_Obj **funcObjv; @@ -2235,7 +2238,7 @@ TclCompileExpr( TclStackFree(interp, parsePtr); Tcl_DecrRefCount(funcList); Tcl_DecrRefCount(litList); - ckfree(opTree); + Tcl_Free(opTree); } /* @@ -2345,11 +2348,11 @@ CompileExprTree( case FUNCTION: { Tcl_DString cmdName; const char *p; - int length; + size_t length; Tcl_DStringInit(&cmdName); TclDStringAppendLiteral(&cmdName, "tcl::mathfunc::"); - p = TclGetStringFromObj(*funcObjv, &length); + p = Tcl_GetStringFromObj(*funcObjv, &length); funcObjv++; Tcl_DStringAppend(&cmdName, p, length); TclEmitPush(TclRegisterLiteral(envPtr, @@ -2504,8 +2507,8 @@ CompileExprTree( Tcl_Obj *literal = *litObjv; if (optimize) { - int length; - const char *bytes = TclGetStringFromObj(literal, &length); + size_t length; + const char *bytes = Tcl_GetStringFromObj(literal, &length); int idx = TclRegisterLiteral(envPtr, bytes, length, 0); Tcl_Obj *objPtr = TclFetchLiteral(envPtr, idx); @@ -2563,7 +2566,7 @@ CompileExprTree( if (TclHasStringRep(objPtr)) { Tcl_Obj *tableValue; - int numBytes; + size_t numBytes; const char *bytes = Tcl_GetStringFromObj(objPtr, &numBytes); @@ -2616,7 +2619,7 @@ CompileExprTree( int TclSingleOpCmd( - ClientData clientData, + void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) @@ -2669,7 +2672,7 @@ TclSingleOpCmd( int TclSortingOpCmd( - ClientData clientData, + void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) @@ -2749,7 +2752,7 @@ TclSortingOpCmd( int TclVariadicOpCmd( - ClientData clientData, + void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) @@ -2868,7 +2871,7 @@ TclVariadicOpCmd( int TclNoIdentOpCmd( - ClientData clientData, + void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) diff --git a/generic/tclCompile.c b/generic/tclCompile.c index c10145c..9708255 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -129,10 +129,6 @@ InstructionDesc const tclInstructionTable[] = { {"jumpFalse4", 5, -1, 1, {OPERAND_OFFSET4}}, /* Jump relative to (pc + op4) if stktop expr object is false */ - {"lor", 1, -1, 0, {OPERAND_NONE}}, - /* Logical or: push (stknext || stktop) */ - {"land", 1, -1, 0, {OPERAND_NONE}}, - /* Logical and: push (stknext && stktop) */ {"bitor", 1, -1, 0, {OPERAND_NONE}}, /* Bitwise or: push (stknext | stktop) */ {"bitxor", 1, -1, 0, {OPERAND_NONE}}, @@ -173,10 +169,6 @@ InstructionDesc const tclInstructionTable[] = { /* Bitwise not: push ~stktop */ {"not", 1, 0, 0, {OPERAND_NONE}}, /* Logical not: push !stktop */ - {"callBuiltinFunc1", 2, 1, 1, {OPERAND_UINT1}}, - /* Call builtin math function with index op1; any args are on stk */ - {"callFunc1", 2, INT_MIN, 1, {OPERAND_UINT1}}, - /* Call non-builtin func objv[0]; <objc,objv>=<op1,top op1> */ {"tryCvtToNumeric", 1, 0, 0, {OPERAND_NONE}}, /* Try converting stktop to first int then double if possible. */ @@ -186,13 +178,6 @@ InstructionDesc const tclInstructionTable[] = { /* Skip to next iteration of closest enclosing loop; if none, return * TCL_CONTINUE code. */ - {"foreach_start4", 5, 0, 1, {OPERAND_AUX4}}, - /* Initialize execution of a foreach loop. Operand is aux data index - * of the ForeachInfo structure for the foreach command. */ - {"foreach_step4", 5, +1, 1, {OPERAND_AUX4}}, - /* "Step" or begin next iteration of foreach loop. Push 0 if to - * terminate loop, else push 1. */ - {"beginCatch4", 5, 0, 1, {OPERAND_UINT4}}, /* Record start of catch with the operand's exception index. Push the * current stack depth onto a special catch stack. */ @@ -340,9 +325,6 @@ InstructionDesc const tclInstructionTable[] = { {"dictNext", 5, +3, 1, {OPERAND_LVT4}}, /* Get the next iteration from the iterator in op4's local scalar. * Stack: ... => ... value key doneBool */ - {"dictDone", 5, 0, 1, {OPERAND_LVT4}}, - /* Terminate the iterator in op4's local scalar. Use unsetScalar - * instead (with 0 for flags). */ {"dictUpdateStart", 9, 0, 2, {OPERAND_LVT4, OPERAND_AUX4}}, /* Create the variables (described in the aux data referred to by the * second immediate argument) to mirror the state of the dictionary in @@ -698,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, - int cmdNumber, int numSrcBytes, int numCodeBytes); + size_t cmdNumber, size_t numSrcBytes, size_t numCodeBytes); static void EnterCmdStartData(CompileEnv *envPtr, - int cmdNumber, int srcOffset, int codeOffset); + size_t cmdNumber, size_t srcOffset, size_t codeOffset); static void FreeByteCodeInternalRep(Tcl_Obj *objPtr); static void FreeSubstCodeInternalRep(Tcl_Obj *objPtr); static int GetCmdLocEncodingSize(CompileEnv *envPtr); @@ -717,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, int srcOffset, +static void EnterCmdWordData(ExtCmdLoc *eclPtr, size_t srcOffset, Tcl_Token *tokenPtr, const char *cmd, - int numWords, int line, int *clNext, int **lines, + size_t numWords, size_t line, int *clNext, int **lines, CompileEnv *envPtr); static void ReleaseCmdWordData(ExtCmdLoc *eclPtr); @@ -733,7 +715,8 @@ const Tcl_ObjType tclByteCodeType = { FreeByteCodeInternalRep, /* freeIntRepProc */ DupByteCodeInternalRep, /* dupIntRepProc */ NULL, /* updateStringProc */ - SetByteCodeFromAny /* setFromAnyProc */ + SetByteCodeFromAny, /* setFromAnyProc */ + TCL_OBJTYPE_V0 }; /* @@ -747,6 +730,7 @@ static const Tcl_ObjType substCodeType = { DupByteCodeInternalRep, /* dupIntRepProc - shared with bytecode */ NULL, /* updateStringProc */ NULL, /* setFromAnyProc */ + TCL_OBJTYPE_V0 }; #define SubstFlags(objPtr) (objPtr)->internalRep.twoPtrValue.ptr2 @@ -792,7 +776,7 @@ TclSetByteCodeFromAny( Interp *iPtr = (Interp *) interp; CompileEnv compEnv; /* Compilation environment structure allocated * in frame. */ - int length; + size_t length; int result = TCL_OK; const char *stringPtr; Proc *procPtr = iPtr->compiledProcPtr; @@ -808,7 +792,7 @@ TclSetByteCodeFromAny( } #endif - stringPtr = TclGetStringFromObj(objPtr, &length); + stringPtr = Tcl_GetStringFromObj(objPtr, &length); /* * TIP #280: Pick up the CmdFrame in which the BC compiler was invoked, and @@ -873,8 +857,8 @@ TclSetByteCodeFromAny( * instruction generator boundaries. */ - if (iPtr->extra.optimizer) { - (iPtr->extra.optimizer)(&compEnv); + if (iPtr->optimizer) { + (iPtr->optimizer)(&compEnv); } /* @@ -1160,7 +1144,7 @@ CleanupByteCode( } TclHandleRelease(codePtr->interpHandle); - ckfree(codePtr); + Tcl_Free(codePtr); } /* @@ -1344,8 +1328,8 @@ CompileSubstObj( } if (codePtr == NULL) { CompileEnv compEnv; - int numBytes; - const char *bytes = TclGetStringFromObj(objPtr, &numBytes); + size_t numBytes; + const char *bytes = Tcl_GetStringFromObj(objPtr, &numBytes); /* TODO: Check for more TIP 280 */ TclInitCompileEnv(interp, &compEnv, bytes, numBytes, NULL, 0); @@ -1407,20 +1391,20 @@ static void ReleaseCmdWordData( ExtCmdLoc *eclPtr) { - int i; + size_t i; if (eclPtr->type == TCL_LOCATION_SOURCE) { Tcl_DecrRefCount(eclPtr->path); } for (i=0 ; i<eclPtr->nuloc ; i++) { - ckfree(eclPtr->loc[i].line); + Tcl_Free(eclPtr->loc[i].line); } if (eclPtr->loc != NULL) { - ckfree(eclPtr->loc); + Tcl_Free(eclPtr->loc); } - ckfree(eclPtr); + Tcl_Free(eclPtr); } /* @@ -1447,14 +1431,14 @@ TclInitCompileEnv( CompileEnv *envPtr,/* Points to the CompileEnv structure to * initialize. */ const char *stringPtr, /* The source string to be compiled. */ - int numBytes, /* Number of bytes in source string. */ + size_t numBytes, /* Number of bytes in source string. */ const CmdFrame *invoker, /* Location context invoking the bcc */ int word) /* Index of the word in that context getting * compiled */ { Interp *iPtr = (Interp *) interp; - assert(tclInstructionTable[LAST_INST_OPCODE+1].name == NULL); + assert(tclInstructionTable[LAST_INST_OPCODE].name == NULL); envPtr->iPtr = iPtr; envPtr->source = stringPtr; @@ -1499,7 +1483,7 @@ TclInitCompileEnv( * non-compiling evaluator */ - envPtr->extCmdMapPtr = (ExtCmdLoc *)ckalloc(sizeof(ExtCmdLoc)); + envPtr->extCmdMapPtr = (ExtCmdLoc *)Tcl_Alloc(sizeof(ExtCmdLoc)); envPtr->extCmdMapPtr->loc = NULL; envPtr->extCmdMapPtr->nloc = 0; envPtr->extCmdMapPtr->nuloc = 0; @@ -1569,7 +1553,7 @@ TclInitCompileEnv( pc = 1; } - if ((ctxPtr->nline <= word) || (ctxPtr->line[word] < 0)) { + if ((ctxPtr->nline <= (size_t)word) || (ctxPtr->line[word] < 0)) { /* * Word is not a literal, relative counting. */ @@ -1654,7 +1638,7 @@ TclFreeCompileEnv( CompileEnv *envPtr)/* Points to the CompileEnv structure. */ { if (envPtr->localLitTable.buckets != envPtr->localLitTable.staticBuckets){ - ckfree(envPtr->localLitTable.buckets); + Tcl_Free(envPtr->localLitTable.buckets); envPtr->localLitTable.buckets = envPtr->localLitTable.staticBuckets; } if (envPtr->iPtr) { @@ -1663,7 +1647,7 @@ TclFreeCompileEnv( * have transferred to it. */ - int i; + size_t i; LiteralEntry *entryPtr = envPtr->literalArrayPtr; AuxData *auxDataPtr = envPtr->auxDataArrayPtr; @@ -1684,20 +1668,20 @@ TclFreeCompileEnv( } } if (envPtr->mallocedCodeArray) { - ckfree(envPtr->codeStart); + Tcl_Free(envPtr->codeStart); } if (envPtr->mallocedLiteralArray) { - ckfree(envPtr->literalArrayPtr); + Tcl_Free(envPtr->literalArrayPtr); } if (envPtr->mallocedExceptArray) { - ckfree(envPtr->exceptArrayPtr); - ckfree(envPtr->exceptAuxArrayPtr); + Tcl_Free(envPtr->exceptArrayPtr); + Tcl_Free(envPtr->exceptAuxArrayPtr); } if (envPtr->mallocedCmdMap) { - ckfree(envPtr->cmdMapPtr); + Tcl_Free(envPtr->cmdMapPtr); } if (envPtr->mallocedAuxDataArray) { - ckfree(envPtr->auxDataArrayPtr); + Tcl_Free(envPtr->auxDataArrayPtr); } if (envPtr->extCmdMapPtr) { ReleaseCmdWordData(envPtr->extCmdMapPtr); @@ -1764,7 +1748,7 @@ TclWordKnownAtCompileTime( case TCL_TOKEN_BS: if (tempPtr != NULL) { char utfBuf[4] = ""; - int length = TclParseBackslash(tokenPtr->start, + size_t length = TclParseBackslash(tokenPtr->start, tokenPtr->size, NULL, utfBuf); Tcl_AppendToObj(tempPtr, utfBuf, length); @@ -1807,7 +1791,7 @@ TclWordKnownAtCompileTime( static int ExpandRequested( Tcl_Token *tokenPtr, - int numWords) + size_t numWords) { /* Determine whether any words of the command require expansion */ while (numWords--) { @@ -1828,15 +1812,15 @@ CompileCmdLiteral( const char *bytes; Command *cmdPtr; int cmdLitIdx, extraLiteralFlags = LITERAL_CMD_NAME; - int numBytes; + size_t length; cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdObj); if ((cmdPtr != NULL) && (cmdPtr->flags & CMD_VIA_RESOLVER)) { extraLiteralFlags |= LITERAL_UNSHARED; } - bytes = TclGetStringFromObj(cmdObj, &numBytes); - cmdLitIdx = TclRegisterLiteral(envPtr, bytes, numBytes, extraLiteralFlags); + bytes = Tcl_GetStringFromObj(cmdObj, &length); + cmdLitIdx = TclRegisterLiteral(envPtr, bytes, length, extraLiteralFlags); if (cmdPtr && TclRoutineHasName(cmdPtr)) { TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, cmdLitIdx), cmdPtr); @@ -1849,11 +1833,11 @@ TclCompileInvocation( Tcl_Interp *interp, Tcl_Token *tokenPtr, Tcl_Obj *cmdObj, - int numWords, + size_t numWords, CompileEnv *envPtr) { DefineLineInformation; - int wordIdx = 0; + size_t wordIdx = 0; int depth = TclGetStackDepth(envPtr); if (cmdObj) { @@ -2018,7 +2002,7 @@ CompileCmdCompileProc( while (mapPtr->nuloc - 1 > eclIndex) { mapPtr->nuloc--; - ckfree(mapPtr->loc[mapPtr->nuloc].line); + Tcl_Free(mapPtr->loc[mapPtr->nuloc].line); mapPtr->loc[mapPtr->nuloc].line = NULL; } @@ -2051,7 +2035,7 @@ CompileCommandTokens( int startCodeOffset = envPtr->codeNext - envPtr->codeStart; int depth = TclGetStackDepth(envPtr); - assert (parsePtr->numWords > 0); + assert ((int)parsePtr->numWords > 0); /* Pre-Compile */ @@ -2096,7 +2080,7 @@ CompileCommandTokens( } } if (cmdPtr && !(cmdPtr->flags & CMD_COMPILES_EXPANDED)) { - expand = ExpandRequested(parsePtr->tokenPtr, parsePtr->numWords); + expand = ExpandRequested(parsePtr->tokenPtr, (int)parsePtr->numWords); if (expand) { /* We need to expand, but compileProc cannot. */ cmdPtr = NULL; @@ -2111,15 +2095,15 @@ CompileCommandTokens( if (code == TCL_ERROR) { if (expand < 0) { - expand = ExpandRequested(parsePtr->tokenPtr, parsePtr->numWords); + expand = ExpandRequested(parsePtr->tokenPtr, (int)parsePtr->numWords); } if (expand) { CompileExpanded(interp, parsePtr->tokenPtr, - cmdKnown ? cmdObj : NULL, parsePtr->numWords, envPtr); + cmdKnown ? cmdObj : NULL, (int)parsePtr->numWords, envPtr); } else { TclCompileInvocation(interp, parsePtr->tokenPtr, - cmdKnown ? cmdObj : NULL, parsePtr->numWords, envPtr); + cmdKnown ? cmdObj : NULL, (int)parsePtr->numWords, envPtr); } } @@ -2137,8 +2121,8 @@ CompileCommandTokens( envPtr->line = cmdLine; envPtr->clNext = clNext; - ckfree(eclPtr->loc[wlineat].line); - ckfree(eclPtr->loc[wlineat].next); + Tcl_Free(eclPtr->loc[wlineat].line); + Tcl_Free(eclPtr->loc[wlineat].next); eclPtr->loc[wlineat].line = wlines; eclPtr->loc[wlineat].next = NULL; @@ -2152,7 +2136,7 @@ TclCompileScript( * serves as context for finding and compiling * commands. May not be NULL. */ const char *script, /* The source script to compile. */ - int numBytes, /* Number of bytes in script. If < 0, the + size_t numBytes, /* Number of bytes in script. If -1, the * script consists of all bytes up to the * first null character. */ CompileEnv *envPtr) /* Holds resulting instructions. */ @@ -2185,13 +2169,13 @@ TclCompileScript( /* Each iteration compiles one command from the script. */ - if (numBytes > 0) { + if (numBytes + 1 > 1) { /* * Don't use system stack (size of Tcl_Parse is ca. 400 bytes), so * many nested compilations (body enclosed in body) can cause abnormal * program termination with a stack overflow exception, bug [fec0c17d39]. */ - Tcl_Parse *parsePtr = (Tcl_Parse *)ckalloc(sizeof(Tcl_Parse)); + Tcl_Parse *parsePtr = (Tcl_Parse *)Tcl_Alloc(sizeof(Tcl_Parse)); do { const char *next; @@ -2204,7 +2188,7 @@ TclCompileScript( Tcl_LogCommandInfo(interp, script, parsePtr->commandStart, parsePtr->term + 1 - parsePtr->commandStart); TclCompileSyntaxError(interp, envPtr); - ckfree(parsePtr); + Tcl_Free(parsePtr); return; } @@ -2254,7 +2238,7 @@ TclCompileScript( * Tcl_FreeParse() to do. * * The advantage of this shortcut is that CompileCommandTokens() - * can be written with an assumption that parsePtr->numWords > 0, with + * can be written with an assumption that (int)parsePtr->numWords > 0, with * the implication the CCT() always generates bytecode. */ continue; @@ -2280,7 +2264,7 @@ TclCompileScript( Tcl_FreeParse(parsePtr); } while (numBytes > 0); - ckfree(parsePtr); + Tcl_Free(parsePtr); } if (lastCmdIdx == -1) { @@ -2339,7 +2323,8 @@ TclCompileVarSubst( CompileEnv *envPtr) { const char *p, *name = tokenPtr[1].start; - int i, localVar, nameBytes = tokenPtr[1].size; + size_t i, nameBytes = tokenPtr[1].size; + size_t localVar; int localVarName = 1; /* @@ -2371,7 +2356,7 @@ TclCompileVarSubst( if (localVarName != -1) { localVar = TclFindCompiledLocal(name, nameBytes, localVarName, envPtr); } - if (localVar < 0) { + if (localVar == TCL_INDEX_NONE) { PushLiteral(envPtr, name, nameBytes); } @@ -2383,7 +2368,7 @@ TclCompileVarSubst( tokenPtr[1].start + tokenPtr[1].size); if (tokenPtr->numComponents == 1) { - if (localVar < 0) { + if (localVar == TCL_INDEX_NONE) { TclEmitOpcode(INST_LOAD_STK, envPtr); } else if (localVar <= 255) { TclEmitInstInt1(INST_LOAD_SCALAR1, localVar, envPtr); @@ -2392,7 +2377,7 @@ TclCompileVarSubst( } } else { TclCompileTokens(interp, tokenPtr+2, tokenPtr->numComponents-1, envPtr); - if (localVar < 0) { + if (localVar == TCL_INDEX_NONE) { TclEmitOpcode(INST_LOAD_ARRAY_STK, envPtr); } else if (localVar <= 255) { TclEmitInstInt1(INST_LOAD_ARRAY1, localVar, envPtr); @@ -2407,7 +2392,7 @@ TclCompileTokens( Tcl_Interp *interp, /* Used for error and status reporting. */ Tcl_Token *tokenPtr, /* Pointer to first in an array of tokens to * compile. */ - int count, /* Number of tokens to consider at tokenPtr. + size_t count1, /* Number of tokens to consider at tokenPtr. * Must be at least 1. */ CompileEnv *envPtr) /* Holds the resulting instructions. */ { @@ -2415,12 +2400,13 @@ TclCompileTokens( * TCL_TOKEN_TEXT, TCL_TOKEN_BS tokens. */ char buffer[4] = ""; int i, numObjsToConcat, adjust; - int length; + size_t length; unsigned char *entryCodeNext = envPtr->codeNext; #define NUM_STATIC_POS 20 int isLiteral, maxNumCL, numCL; int *clPosition = NULL; int depth = TclGetStackDepth(envPtr); + int count = count1; /* * if this is actually a literal, handle continuation lines by @@ -2448,7 +2434,7 @@ TclCompileTokens( if (isLiteral) { maxNumCL = NUM_STATIC_POS; - clPosition = (int *)ckalloc(maxNumCL * sizeof(int)); + clPosition = (int *)Tcl_Alloc(maxNumCL * sizeof(int)); } adjust = 0; @@ -2488,7 +2474,7 @@ TclCompileTokens( if (numCL >= maxNumCL) { maxNumCL *= 2; - clPosition = (int *)ckrealloc(clPosition, + clPosition = (int *)Tcl_Realloc(clPosition, maxNumCL * sizeof(int)); } clPosition[numCL] = clPos; @@ -2546,7 +2532,7 @@ TclCompileTokens( default: Tcl_Panic("Unexpected token type in TclCompileTokens: %d; %.*s", - tokenPtr->type, tokenPtr->size, tokenPtr->start); + tokenPtr->type, (int)tokenPtr->size, tokenPtr->start); } } @@ -2593,7 +2579,7 @@ TclCompileTokens( */ if (maxNumCL) { - ckfree(clPosition); + Tcl_Free(clPosition); } TclCheckStackDepth(depth+1, envPtr); } @@ -2624,10 +2610,12 @@ TclCompileCmdWord( Tcl_Interp *interp, /* Used for error and status reporting. */ Tcl_Token *tokenPtr, /* Pointer to first in an array of tokens for * a command word to compile inline. */ - int count, /* Number of tokens to consider at tokenPtr. + size_t count1, /* Number of tokens to consider at tokenPtr. * Must be at least 1. */ CompileEnv *envPtr) /* Holds the resulting instructions. */ { + int count = count1; + if ((count == 1) && (tokenPtr->type == TCL_TOKEN_TEXT)) { /* * The common case that there is a single text token. Compile it @@ -2673,13 +2661,14 @@ TclCompileExprWords( Tcl_Token *tokenPtr, /* Points to first in an array of word tokens * tokens for the expression to compile * inline. */ - int numWords, /* Number of word tokens starting at tokenPtr. + size_t numWords1, /* Number of word tokens starting at tokenPtr. * Must be at least 1. Each word token * contains one or more subtokens. */ CompileEnv *envPtr) /* Holds the resulting instructions. */ { Tcl_Token *wordPtr; int i, concatItems; + int numWords = numWords1; /* * If the expression is a single word that doesn't require substitutions, @@ -2745,7 +2734,7 @@ TclCompileNoOp( int i; tokenPtr = parsePtr->tokenPtr; - for (i = 1; i < parsePtr->numWords; i++) { + for (i = 1; i < (int)parsePtr->numWords; i++) { tokenPtr = tokenPtr + tokenPtr->numComponents + 1; if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { @@ -2787,7 +2776,7 @@ PreventCycle( Tcl_Obj *objPtr, CompileEnv *envPtr) { - int i; + size_t i; for (i = 0; i < envPtr->literalArrayNext; i++) { if (objPtr == TclFetchLiteral(envPtr, i)) { @@ -2802,8 +2791,8 @@ PreventCycle( * can be sure we do not have any lingering cycles hiding in * the internalrep. */ - int numBytes; - const char *bytes = TclGetStringFromObj(objPtr, &numBytes); + size_t numBytes; + const char *bytes = Tcl_GetStringFromObj(objPtr, &numBytes); Tcl_Obj *copyPtr = Tcl_NewStringObj(bytes, numBytes); Tcl_IncrRefCount(copyPtr); @@ -2864,7 +2853,7 @@ TclInitByteCode( namespacePtr = envPtr->iPtr->globalNsPtr; } - p = (unsigned char *)ckalloc(structureSize); + p = (unsigned char *)Tcl_Alloc(structureSize); codePtr = (ByteCode *) p; codePtr->interpHandle = TclHandlePreserve(iPtr->handle); codePtr->compileEpoch = iPtr->compileEpoch; @@ -3004,19 +2993,19 @@ TclInitByteCodeObj( *---------------------------------------------------------------------- */ -int +size_t 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. */ - int nameBytes, /* Number of bytes in the name. */ + size_t 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; - int localVar = TCL_INDEX_NONE; - int i; + size_t localVar = TCL_INDEX_NONE; + size_t i; Proc *procPtr; /* @@ -3035,7 +3024,7 @@ TclFindCompiledLocal( LocalCache *cachePtr = envPtr->iPtr->varFramePtr->localCachePtr; const char *localName; Tcl_Obj **varNamePtr; - int len; + size_t len; if (!cachePtr || !name) { return TCL_INDEX_NONE; @@ -3044,7 +3033,7 @@ TclFindCompiledLocal( varNamePtr = &cachePtr->varName0; for (i=0; i < cachePtr->numVars; varNamePtr++, i++) { if (*varNamePtr) { - localName = TclGetStringFromObj(*varNamePtr, &len); + localName = Tcl_GetStringFromObj(*varNamePtr, &len); if ((len == nameBytes) && !strncmp(name, localName, len)) { return i; } @@ -3054,7 +3043,7 @@ TclFindCompiledLocal( } if (name != NULL) { - int localCt = procPtr->numCompiledLocals; + size_t localCt = procPtr->numCompiledLocals; localPtr = procPtr->firstLocalPtr; for (i = 0; i < localCt; i++) { @@ -3062,7 +3051,7 @@ TclFindCompiledLocal( char *localName = localPtr->name; if ((nameBytes == localPtr->nameLength) && - (strncmp(name, localName, nameBytes) == 0)) { + (strncmp(name,localName,nameBytes) == 0)) { return i; } } @@ -3076,7 +3065,7 @@ TclFindCompiledLocal( if (create || (name == NULL)) { localVar = procPtr->numCompiledLocals; - localPtr = (CompiledLocal *)ckalloc(offsetof(CompiledLocal, name) + 1U + nameBytes); + localPtr = (CompiledLocal *)Tcl_Alloc(offsetof(CompiledLocal, name) + 1U + nameBytes); if (procPtr->firstLocalPtr == NULL) { procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr; } else { @@ -3139,14 +3128,14 @@ TclExpandCodeArray( size_t newBytes = 2 * (envPtr->codeEnd - envPtr->codeStart); if (envPtr->mallocedCodeArray) { - envPtr->codeStart = (unsigned char *)ckrealloc(envPtr->codeStart, newBytes); + envPtr->codeStart = (unsigned char *)Tcl_Realloc(envPtr->codeStart, newBytes); } else { /* * envPtr->exceptArrayPtr isn't a Tcl_Alloc'd pointer, so * perform the equivalent of Tcl_Realloc directly. */ - unsigned char *newPtr = (unsigned char *)ckalloc(newBytes); + unsigned char *newPtr = (unsigned char *)Tcl_Alloc(newBytes); memcpy(newPtr, envPtr->codeStart, currBytes); envPtr->codeStart = newPtr; @@ -3182,15 +3171,15 @@ EnterCmdStartData( CompileEnv *envPtr, /* Points to the compilation environment * structure in which to enter command * location information. */ - int cmdIndex, /* Index of the command whose start data is + size_t cmdIndex, /* Index of the command whose start data is * being set. */ - int srcOffset, /* Offset of first char of the command. */ - int codeOffset) /* Offset of first byte of command code. */ + size_t srcOffset, /* Offset of first char of the command. */ + size_t codeOffset) /* Offset of first byte of command code. */ { CmdLocation *cmdLocPtr; - if ((cmdIndex < 0) || (cmdIndex >= envPtr->numCommands)) { - Tcl_Panic("EnterCmdStartData: bad command index %d", cmdIndex); + if (cmdIndex >= envPtr->numCommands) { + Tcl_Panic("EnterCmdStartData: bad command index %" TCL_Z_MODIFIER "u", cmdIndex); } if (cmdIndex >= envPtr->cmdMapEnd) { @@ -3206,14 +3195,14 @@ EnterCmdStartData( size_t newBytes = newElems * sizeof(CmdLocation); if (envPtr->mallocedCmdMap) { - envPtr->cmdMapPtr = (CmdLocation *)ckrealloc(envPtr->cmdMapPtr, newBytes); + envPtr->cmdMapPtr = (CmdLocation *)Tcl_Realloc(envPtr->cmdMapPtr, newBytes); } else { /* - * envPtr->cmdMapPtr isn't a ckalloc'd pointer, so we must code a - * ckrealloc equivalent for ourselves. + * envPtr->cmdMapPtr isn't a Tcl_Alloc'd pointer, so we must code a + * Tcl_Realloc equivalent for ourselves. */ - CmdLocation *newPtr = (CmdLocation *)ckalloc(newBytes); + CmdLocation *newPtr = (CmdLocation *)Tcl_Alloc(newBytes); memcpy(newPtr, envPtr->cmdMapPtr, currBytes); envPtr->cmdMapPtr = newPtr; @@ -3261,19 +3250,19 @@ EnterCmdExtentData( CompileEnv *envPtr, /* Points to the compilation environment * structure in which to enter command * location information. */ - int cmdIndex, /* Index of the command whose source and code + size_t cmdIndex, /* Index of the command whose source and code * length data is being set. */ - int numSrcBytes, /* Number of command source chars. */ - int numCodeBytes) /* Offset of last byte of command code. */ + size_t numSrcBytes, /* Number of command source chars. */ + size_t numCodeBytes) /* Offset of last byte of command code. */ { CmdLocation *cmdLocPtr; - if ((cmdIndex < 0) || (cmdIndex >= envPtr->numCommands)) { - Tcl_Panic("EnterCmdExtentData: bad command index %d", cmdIndex); + if (cmdIndex >= envPtr->numCommands) { + Tcl_Panic("EnterCmdExtentData: bad command index %" TCL_Z_MODIFIER "u", cmdIndex); } if (cmdIndex > envPtr->cmdMapEnd) { - Tcl_Panic("EnterCmdExtentData: missing start data for command %d", + Tcl_Panic("EnterCmdExtentData: missing start data for command %" TCL_Z_MODIFIER "u", cmdIndex); } @@ -3307,18 +3296,18 @@ EnterCmdWordData( ExtCmdLoc *eclPtr, /* Points to the map environment structure in * which to enter command location * information. */ - int srcOffset, /* Offset of first char of the command. */ + size_t srcOffset, /* Offset of first char of the command. */ Tcl_Token *tokenPtr, const char *cmd, - int numWords, - int line, + size_t numWords, + size_t line, int *clNext, int **wlines, CompileEnv *envPtr) { ECL *ePtr; const char *last; - int wordIdx, wordLine; + size_t wordIdx, wordLine; int *wwlines, *wordNext; if (eclPtr->nuloc >= eclPtr->nloc) { @@ -3332,16 +3321,16 @@ EnterCmdWordData( size_t newElems = (currElems ? 2*currElems : 1); size_t newBytes = newElems * sizeof(ECL); - eclPtr->loc = (ECL *)ckrealloc(eclPtr->loc, newBytes); + eclPtr->loc = (ECL *)Tcl_Realloc(eclPtr->loc, newBytes); eclPtr->nloc = newElems; } ePtr = &eclPtr->loc[eclPtr->nuloc]; ePtr->srcOffset = srcOffset; - ePtr->line = (int *)ckalloc(numWords * sizeof(int)); - ePtr->next = (int **)ckalloc(numWords * sizeof(int *)); + ePtr->line = (int *)Tcl_Alloc(numWords * sizeof(int)); + ePtr->next = (int **)Tcl_Alloc(numWords * sizeof(int *)); ePtr->nline = numWords; - wwlines = (int *)ckalloc(numWords * sizeof(int)); + wwlines = (int *)Tcl_Alloc(numWords * sizeof(int)); last = cmd; wordLine = line; @@ -3354,7 +3343,7 @@ EnterCmdWordData( /* See Ticket 4b61afd660 */ wwlines[wordIdx] = ((wordIdx == 0) || TclWordKnownAtCompileTime(tokenPtr, NULL)) - ? wordLine : TCL_INDEX_NONE; + ? (int)wordLine : -1; ePtr->line[wordIdx] = wordLine; ePtr->next[wordIdx] = wordNext; last = tokenPtr->start; @@ -3384,7 +3373,7 @@ EnterCmdWordData( *---------------------------------------------------------------------- */ -int +size_t TclCreateExceptRange( ExceptionRangeType type, /* The kind of ExceptionRange desired. */ CompileEnv *envPtr)/* Points to CompileEnv for which to create a @@ -3392,7 +3381,7 @@ TclCreateExceptRange( { ExceptionRange *rangePtr; ExceptionAux *auxPtr; - int index = envPtr->exceptArrayNext; + size_t index = envPtr->exceptArrayNext; if (index >= envPtr->exceptArrayEnd) { /* @@ -3410,17 +3399,17 @@ TclCreateExceptRange( if (envPtr->mallocedExceptArray) { envPtr->exceptArrayPtr = - (ExceptionRange *)ckrealloc(envPtr->exceptArrayPtr, newBytes); + (ExceptionRange *)Tcl_Realloc(envPtr->exceptArrayPtr, newBytes); envPtr->exceptAuxArrayPtr = - (ExceptionAux *)ckrealloc(envPtr->exceptAuxArrayPtr, newBytes2); + (ExceptionAux *)Tcl_Realloc(envPtr->exceptAuxArrayPtr, newBytes2); } else { /* - * envPtr->exceptArrayPtr isn't a ckalloc'd pointer, so we must - * code a ckrealloc equivalent for ourselves. + * envPtr->exceptArrayPtr isn't a Tcl_Alloc'd pointer, so we must + * code a Tcl_Realloc equivalent for ourselves. */ - ExceptionRange *newPtr = (ExceptionRange *)ckalloc(newBytes); - ExceptionAux *newPtr2 = (ExceptionAux *)ckalloc(newBytes2); + ExceptionRange *newPtr = (ExceptionRange *)Tcl_Alloc(newBytes); + ExceptionAux *newPtr2 = (ExceptionAux *)Tcl_Alloc(newBytes2); memcpy(newPtr, envPtr->exceptArrayPtr, currBytes); memcpy(newPtr2, envPtr->exceptAuxArrayPtr, currBytes2); @@ -3480,9 +3469,9 @@ TclGetInnermostExceptionRange( while (i > 0) { rangePtr--; i--; - if (CurrentOffset(envPtr) >= rangePtr->codeOffset && + if (CurrentOffset(envPtr) >= (int)rangePtr->codeOffset && (rangePtr->numCodeBytes == TCL_INDEX_NONE || CurrentOffset(envPtr) < - rangePtr->codeOffset+rangePtr->numCodeBytes) && + (int)rangePtr->codeOffset+(int)rangePtr->numCodeBytes) && (returnCode != TCL_CONTINUE || envPtr->exceptAuxArrayPtr[i].supportsContinue)) { @@ -3523,11 +3512,11 @@ TclAddLoopBreakFixup( auxPtr->allocBreakTargets *= 2; auxPtr->allocBreakTargets += 2; if (auxPtr->breakTargets) { - auxPtr->breakTargets = (unsigned int *)ckrealloc(auxPtr->breakTargets, - sizeof(int) * auxPtr->allocBreakTargets); + auxPtr->breakTargets = (size_t *)Tcl_Realloc(auxPtr->breakTargets, + sizeof(size_t) * auxPtr->allocBreakTargets); } else { auxPtr->breakTargets = - (unsigned int *)ckalloc(sizeof(int) * auxPtr->allocBreakTargets); + (size_t *)Tcl_Alloc(sizeof(size_t) * auxPtr->allocBreakTargets); } } auxPtr->breakTargets[auxPtr->numBreakTargets - 1] = CurrentOffset(envPtr); @@ -3549,11 +3538,11 @@ TclAddLoopContinueFixup( auxPtr->allocContinueTargets *= 2; auxPtr->allocContinueTargets += 2; if (auxPtr->continueTargets) { - auxPtr->continueTargets = (unsigned int *)ckrealloc(auxPtr->continueTargets, - sizeof(int) * auxPtr->allocContinueTargets); + auxPtr->continueTargets = (size_t *)Tcl_Realloc(auxPtr->continueTargets, + sizeof(size_t) * auxPtr->allocContinueTargets); } else { auxPtr->continueTargets = - (unsigned int *)ckalloc(sizeof(int) * auxPtr->allocContinueTargets); + (size_t *)Tcl_Alloc(sizeof(size_t) * auxPtr->allocContinueTargets); } } auxPtr->continueTargets[auxPtr->numContinueTargets - 1] = @@ -3585,7 +3574,7 @@ TclCleanupStackForBreakContinue( while (toPop --> 0) { TclEmitOpcode(INST_EXPAND_DROP, envPtr); } - TclAdjustStackDepth(auxPtr->expandTargetDepth - envPtr->currStackDepth, + TclAdjustStackDepth((int)(auxPtr->expandTargetDepth - envPtr->currStackDepth), envPtr); envPtr->currStackDepth = auxPtr->expandTargetDepth; } @@ -3621,7 +3610,7 @@ StartExpanding( * where this expansion started. */ - for (i=0 ; i<envPtr->exceptArrayNext ; i++) { + for (i=0 ; i<(int)envPtr->exceptArrayNext ; i++) { ExceptionRange *rangePtr = &envPtr->exceptArrayPtr[i]; ExceptionAux *auxPtr = &envPtr->exceptAuxArrayPtr[i]; @@ -3629,7 +3618,7 @@ StartExpanding( * Ignore loops unless they're still being built. */ - if (rangePtr->codeOffset > CurrentOffset(envPtr)) { + if ((int)rangePtr->codeOffset > CurrentOffset(envPtr)) { continue; } if (rangePtr->numCodeBytes != TCL_INDEX_NONE) { @@ -3685,12 +3674,12 @@ TclFinalizeLoopExceptionRange( * there is no need to fuss around with updating code offsets. */ - for (i=0 ; i<auxPtr->numBreakTargets ; i++) { + for (i=0 ; i<(int)auxPtr->numBreakTargets ; i++) { site = envPtr->codeStart + auxPtr->breakTargets[i]; offset = rangePtr->breakOffset - auxPtr->breakTargets[i]; TclUpdateInstInt4AtPc(INST_JUMP4, offset, site); } - for (i=0 ; i<auxPtr->numContinueTargets ; i++) { + for (i=0 ; i<(int)auxPtr->numContinueTargets ; i++) { site = envPtr->codeStart + auxPtr->continueTargets[i]; if (rangePtr->continueOffset == TCL_INDEX_NONE) { int j; @@ -3715,12 +3704,12 @@ TclFinalizeLoopExceptionRange( */ if (auxPtr->breakTargets) { - ckfree(auxPtr->breakTargets); + Tcl_Free(auxPtr->breakTargets); auxPtr->breakTargets = NULL; auxPtr->numBreakTargets = 0; } if (auxPtr->continueTargets) { - ckfree(auxPtr->continueTargets); + Tcl_Free(auxPtr->continueTargets); auxPtr->continueTargets = NULL; auxPtr->numContinueTargets = 0; } @@ -3745,7 +3734,7 @@ TclFinalizeLoopExceptionRange( *---------------------------------------------------------------------- */ -int +size_t TclCreateAuxData( void *clientData, /* The compilation auxiliary data to store in * the new aux data record. */ @@ -3754,7 +3743,7 @@ TclCreateAuxData( CompileEnv *envPtr)/* Points to the CompileEnv for which a new * aux data structure is to be allocated. */ { - int index; /* Index for the new AuxData structure. */ + size_t index; /* Index for the new AuxData structure. */ AuxData *auxDataPtr; /* Points to the new AuxData structure */ @@ -3772,14 +3761,14 @@ TclCreateAuxData( if (envPtr->mallocedAuxDataArray) { envPtr->auxDataArrayPtr = - (AuxData *)ckrealloc(envPtr->auxDataArrayPtr, newBytes); + (AuxData *)Tcl_Realloc(envPtr->auxDataArrayPtr, newBytes); } else { /* - * envPtr->auxDataArrayPtr isn't a ckalloc'd pointer, so we must - * code a ckrealloc equivalent for ourselves. + * envPtr->auxDataArrayPtr isn't a Tcl_Alloc'd pointer, so we must + * code a Tcl_Realloc equivalent for ourselves. */ - AuxData *newPtr = (AuxData *)ckalloc(newBytes); + AuxData *newPtr = (AuxData *)Tcl_Alloc(newBytes); memcpy(newPtr, envPtr->auxDataArrayPtr, currBytes); envPtr->auxDataArrayPtr = newPtr; @@ -3860,14 +3849,14 @@ TclExpandJumpFixupArray( size_t newBytes = newElems * sizeof(JumpFixup); if (fixupArrayPtr->mallocedArray) { - fixupArrayPtr->fixup = (JumpFixup *)ckrealloc(fixupArrayPtr->fixup, newBytes); + fixupArrayPtr->fixup = (JumpFixup *)Tcl_Realloc(fixupArrayPtr->fixup, newBytes); } else { /* - * fixupArrayPtr->fixup isn't a ckalloc'd pointer, so we must code a - * ckrealloc equivalent for ourselves. + * fixupArrayPtr->fixup isn't a Tcl_Alloc'd pointer, so we must code a + * Tcl_Realloc equivalent for ourselves. */ - JumpFixup *newPtr = (JumpFixup *)ckalloc(newBytes); + JumpFixup *newPtr = (JumpFixup *)Tcl_Alloc(newBytes); memcpy(newPtr, fixupArrayPtr->fixup, currBytes); fixupArrayPtr->fixup = newPtr; @@ -3899,7 +3888,7 @@ TclFreeJumpFixupArray( * free. */ { if (fixupArrayPtr->mallocedArray) { - ckfree(fixupArrayPtr->fixup); + Tcl_Free(fixupArrayPtr->fixup); } } @@ -4083,16 +4072,16 @@ TclFixupForwardJump( } } - for (k = 0 ; k < envPtr->exceptArrayNext ; k++) { + for (k = 0 ; k < (int)envPtr->exceptArrayNext ; k++) { ExceptionAux *auxPtr = &envPtr->exceptAuxArrayPtr[k]; int i; - for (i=0 ; i<auxPtr->numBreakTargets ; i++) { + for (i=0 ; i<(int)auxPtr->numBreakTargets ; i++) { if (jumpFixupPtr->codeOffset < auxPtr->breakTargets[i]) { auxPtr->breakTargets[i] += 3; } } - for (i=0 ; i<auxPtr->numContinueTargets ; i++) { + for (i=0 ; i<(int)auxPtr->numContinueTargets ; i++) { if (jumpFixupPtr->codeOffset < auxPtr->continueTargets[i]) { auxPtr->continueTargets[i] += 3; } @@ -4244,8 +4233,8 @@ TclEmitInvoke( */ if (auxBreakPtr != NULL || auxContinuePtr != NULL) { - int savedStackDepth = envPtr->currStackDepth; - int savedExpandCount = envPtr->expandCount; + size_t savedStackDepth = envPtr->currStackDepth; + size_t savedExpandCount = envPtr->expandCount; JumpFixup nonTrapFixup; if (auxBreakPtr != NULL) { @@ -4427,10 +4416,10 @@ EncodeCmdLocMap( * is to be stored. */ { CmdLocation *mapPtr = envPtr->cmdMapPtr; - int numCmds = envPtr->numCommands; + size_t i, codeDelta, codeLen, srcLen, prevOffset; + size_t numCmds = envPtr->numCommands; unsigned char *p = startPtr; - int codeDelta, codeLen, srcDelta, srcLen, prevOffset; - int i; + int srcDelta; /* * Encode the code offset for each command as a sequence of deltas. @@ -4440,7 +4429,7 @@ EncodeCmdLocMap( prevOffset = 0; for (i = 0; i < numCmds; i++) { codeDelta = mapPtr[i].codeOffset - prevOffset; - if (codeDelta < 0) { + if (codeDelta == TCL_INDEX_NONE) { Tcl_Panic("EncodeCmdLocMap: bad code offset"); } else if (codeDelta <= 127) { TclStoreInt1AtPtr(codeDelta, p); @@ -4461,7 +4450,7 @@ EncodeCmdLocMap( codePtr->codeLengthStart = p; for (i = 0; i < numCmds; i++) { codeLen = mapPtr[i].numCodeBytes; - if (codeLen < 0) { + if (codeLen == TCL_INDEX_NONE) { Tcl_Panic("EncodeCmdLocMap: bad code length"); } else if (codeLen <= 127) { TclStoreInt1AtPtr(codeLen, p); @@ -4501,7 +4490,7 @@ EncodeCmdLocMap( codePtr->srcLengthStart = p; for (i = 0; i < numCmds; i++) { srcLen = mapPtr[i].numSrcBytes; - if (srcLen < 0) { + if (srcLen == TCL_INDEX_NONE) { Tcl_Panic("EncodeCmdLocMap: bad source length"); } else if (srcLen <= 127) { TclStoreInt1AtPtr(srcLen, p); @@ -4553,12 +4542,12 @@ RecordByteCodeStats( statsPtr = &(iPtr->stats); statsPtr->numCompilations++; - statsPtr->totalSrcBytes += (double) codePtr->numSrcBytes; + statsPtr->totalSrcBytes += (double)codePtr->numSrcBytes; statsPtr->totalByteCodeBytes += (double) codePtr->structureSize; - statsPtr->currentSrcBytes += (double) codePtr->numSrcBytes; + statsPtr->currentSrcBytes += (double) (int)codePtr->numSrcBytes; statsPtr->currentByteCodeBytes += (double) codePtr->structureSize; - statsPtr->srcCount[TclLog2(codePtr->numSrcBytes)]++; + statsPtr->srcCount[TclLog2((int)codePtr->numSrcBytes)]++; statsPtr->byteCodeCount[TclLog2((int) codePtr->structureSize)]++; statsPtr->currentInstBytes += (double) codePtr->numCodeBytes; diff --git a/generic/tclCompile.h b/generic/tclCompile.h index a5942de..035edac 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -316,6 +316,10 @@ typedef struct CompileEnv { * array byte. */ int mallocedCodeArray; /* Set 1 if code array was expanded and * codeStart points into the heap.*/ +#if TCL_MAJOR_VERSION > 8 + int mallocedExceptArray; /* 1 if ExceptionRange array was expanded and + * exceptArrayPtr points in heap, else 0. */ +#endif LiteralEntry *literalArrayPtr; /* Points to start of LiteralEntry array. */ Tcl_Size literalArrayNext; /* Index of next free object array entry. */ @@ -331,8 +335,9 @@ typedef struct CompileEnv { * current range's array entry. */ Tcl_Size exceptArrayEnd; /* Index after the last ExceptionRange array * entry. */ - int mallocedExceptArray; /* 1 if ExceptionRange array was expanded and - * exceptArrayPtr points in heap, else 0. */ +#if TCL_MAJOR_VERSION < 9 + int mallocedExceptArray; +#endif ExceptionAux *exceptAuxArrayPtr; /* Array of information used to restore the * state when processing BREAK/CONTINUE @@ -345,14 +350,19 @@ typedef struct CompileEnv { Tcl_Size cmdMapEnd; /* Index after last CmdLocation entry. */ int mallocedCmdMap; /* 1 if command map array was expanded and * cmdMapPtr points in the heap, else 0. */ +#if TCL_MAJOR_VERSION > 8 + int mallocedAuxDataArray; /* 1 if aux data array was expanded and + * auxDataArrayPtr points in heap else 0. */ +#endif AuxData *auxDataArrayPtr; /* Points to auxiliary data array start. */ Tcl_Size auxDataArrayNext; /* Next free compile aux data array index. * auxDataArrayNext is the number of aux data * items and (auxDataArrayNext-1) is index of * current aux data array entry. */ Tcl_Size auxDataArrayEnd; /* Index after last aux data array entry. */ - int mallocedAuxDataArray; /* 1 if aux data array was expanded and - * auxDataArrayPtr points in heap else 0. */ +#if TCL_MAJOR_VERSION < 9 + int mallocedAuxDataArray; +#endif unsigned char staticCodeSpace[COMPILEENV_INIT_CODE_BYTES]; /* Initial storage for code. */ LiteralEntry staticLiteralSpace[COMPILEENV_INIT_NUM_OBJECTS]; @@ -540,318 +550,296 @@ typedef struct ByteCode { * tclExecute.c. */ -/* Opcodes 0 to 9 */ -#define INST_DONE 0 -#define INST_PUSH1 1 -#define INST_PUSH4 2 -#define INST_POP 3 -#define INST_DUP 4 -#define INST_STR_CONCAT1 5 -#define INST_INVOKE_STK1 6 -#define INST_INVOKE_STK4 7 -#define INST_EVAL_STK 8 -#define INST_EXPR_STK 9 - -/* Opcodes 10 to 23 */ -#define INST_LOAD_SCALAR1 10 -#define INST_LOAD_SCALAR4 11 -#define INST_LOAD_SCALAR_STK 12 -#define INST_LOAD_ARRAY1 13 -#define INST_LOAD_ARRAY4 14 -#define INST_LOAD_ARRAY_STK 15 -#define INST_LOAD_STK 16 -#define INST_STORE_SCALAR1 17 -#define INST_STORE_SCALAR4 18 -#define INST_STORE_SCALAR_STK 19 -#define INST_STORE_ARRAY1 20 -#define INST_STORE_ARRAY4 21 -#define INST_STORE_ARRAY_STK 22 -#define INST_STORE_STK 23 - -/* Opcodes 24 to 33 */ -#define INST_INCR_SCALAR1 24 -#define INST_INCR_SCALAR_STK 25 -#define INST_INCR_ARRAY1 26 -#define INST_INCR_ARRAY_STK 27 -#define INST_INCR_STK 28 -#define INST_INCR_SCALAR1_IMM 29 -#define INST_INCR_SCALAR_STK_IMM 30 -#define INST_INCR_ARRAY1_IMM 31 -#define INST_INCR_ARRAY_STK_IMM 32 -#define INST_INCR_STK_IMM 33 - -/* Opcodes 34 to 39 */ -#define INST_JUMP1 34 -#define INST_JUMP4 35 -#define INST_JUMP_TRUE1 36 -#define INST_JUMP_TRUE4 37 -#define INST_JUMP_FALSE1 38 -#define INST_JUMP_FALSE4 39 - -/* Opcodes 40 to 64 */ -#define INST_LOR 40 -#define INST_LAND 41 -#define INST_BITOR 42 -#define INST_BITXOR 43 -#define INST_BITAND 44 -#define INST_EQ 45 -#define INST_NEQ 46 -#define INST_LT 47 -#define INST_GT 48 -#define INST_LE 49 -#define INST_GE 50 -#define INST_LSHIFT 51 -#define INST_RSHIFT 52 -#define INST_ADD 53 -#define INST_SUB 54 -#define INST_MULT 55 -#define INST_DIV 56 -#define INST_MOD 57 -#define INST_UPLUS 58 -#define INST_UMINUS 59 -#define INST_BITNOT 60 -#define INST_LNOT 61 -#define INST_CALL_BUILTIN_FUNC1 62 -#define INST_CALL_FUNC1 63 -#define INST_TRY_CVT_TO_NUMERIC 64 - -/* Opcodes 65 to 66 */ -#define INST_BREAK 65 -#define INST_CONTINUE 66 - -/* Opcodes 67 to 68 */ -#define INST_FOREACH_START4 67 /* DEPRECATED */ -#define INST_FOREACH_STEP4 68 /* DEPRECATED */ - -/* Opcodes 69 to 72 */ -#define INST_BEGIN_CATCH4 69 -#define INST_END_CATCH 70 -#define INST_PUSH_RESULT 71 -#define INST_PUSH_RETURN_CODE 72 - -/* Opcodes 73 to 78 */ -#define INST_STR_EQ 73 -#define INST_STR_NEQ 74 -#define INST_STR_CMP 75 -#define INST_STR_LEN 76 -#define INST_STR_INDEX 77 -#define INST_STR_MATCH 78 - -/* Opcodes 78 to 81 */ -#define INST_LIST 79 -#define INST_LIST_INDEX 80 -#define INST_LIST_LENGTH 81 - -/* Opcodes 82 to 87 */ -#define INST_APPEND_SCALAR1 82 -#define INST_APPEND_SCALAR4 83 -#define INST_APPEND_ARRAY1 84 -#define INST_APPEND_ARRAY4 85 -#define INST_APPEND_ARRAY_STK 86 -#define INST_APPEND_STK 87 - -/* Opcodes 88 to 93 */ -#define INST_LAPPEND_SCALAR1 88 -#define INST_LAPPEND_SCALAR4 89 -#define INST_LAPPEND_ARRAY1 90 -#define INST_LAPPEND_ARRAY4 91 -#define INST_LAPPEND_ARRAY_STK 92 -#define INST_LAPPEND_STK 93 - -/* TIP #22 - LINDEX operator with flat arg list */ - -#define INST_LIST_INDEX_MULTI 94 - -/* - * TIP #33 - 'lset' command. Code gen also required a Forth-like - * OVER operation. - */ - -#define INST_OVER 95 -#define INST_LSET_LIST 96 -#define INST_LSET_FLAT 97 - -/* TIP#90 - 'return' command. */ - -#define INST_RETURN_IMM 98 - -/* TIP#123 - exponentiation operator. */ - -#define INST_EXPON 99 - -/* TIP #157 - {*}... (word expansion) language syntax support. */ - -#define INST_EXPAND_START 100 -#define INST_EXPAND_STKTOP 101 -#define INST_INVOKE_EXPANDED 102 - -/* - * TIP #57 - 'lassign' command. Code generation requires immediate - * LINDEX and LRANGE operators. - */ - -#define INST_LIST_INDEX_IMM 103 -#define INST_LIST_RANGE_IMM 104 - -#define INST_START_CMD 105 - -#define INST_LIST_IN 106 -#define INST_LIST_NOT_IN 107 - -#define INST_PUSH_RETURN_OPTIONS 108 -#define INST_RETURN_STK 109 - -/* - * Dictionary (TIP#111) related commands. - */ - -#define INST_DICT_GET 110 -#define INST_DICT_SET 111 -#define INST_DICT_UNSET 112 -#define INST_DICT_INCR_IMM 113 -#define INST_DICT_APPEND 114 -#define INST_DICT_LAPPEND 115 -#define INST_DICT_FIRST 116 -#define INST_DICT_NEXT 117 -#define INST_DICT_DONE 118 -#define INST_DICT_UPDATE_START 119 -#define INST_DICT_UPDATE_END 120 - -/* - * Instruction to support jumps defined by tables (instead of the classic - * [switch] technique of chained comparisons). - */ - -#define INST_JUMP_TABLE 121 - -/* - * Instructions to support compilation of global, variable, upvar and - * [namespace upvar]. - */ - -#define INST_UPVAR 122 -#define INST_NSUPVAR 123 -#define INST_VARIABLE 124 - -/* Instruction to support compiling syntax error to bytecode */ - -#define INST_SYNTAX 125 - -/* Instruction to reverse N items on top of stack */ - -#define INST_REVERSE 126 - -/* regexp instruction */ - -#define INST_REGEXP 127 - -/* For [info exists] compilation */ -#define INST_EXIST_SCALAR 128 -#define INST_EXIST_ARRAY 129 -#define INST_EXIST_ARRAY_STK 130 -#define INST_EXIST_STK 131 - -/* For [subst] compilation */ -#define INST_NOP 132 -#define INST_RETURN_CODE_BRANCH 133 - -/* For [unset] compilation */ -#define INST_UNSET_SCALAR 134 -#define INST_UNSET_ARRAY 135 -#define INST_UNSET_ARRAY_STK 136 -#define INST_UNSET_STK 137 - -/* For [dict with], [dict exists], [dict create] and [dict merge] */ -#define INST_DICT_EXPAND 138 -#define INST_DICT_RECOMBINE_STK 139 -#define INST_DICT_RECOMBINE_IMM 140 -#define INST_DICT_EXISTS 141 -#define INST_DICT_VERIFY 142 - -/* For [string map] and [regsub] compilation */ -#define INST_STR_MAP 143 -#define INST_STR_FIND 144 -#define INST_STR_FIND_LAST 145 -#define INST_STR_RANGE_IMM 146 -#define INST_STR_RANGE 147 - -/* For operations to do with coroutines and other NRE-manipulators */ -#define INST_YIELD 148 -#define INST_COROUTINE_NAME 149 -#define INST_TAILCALL 150 - -/* For compilation of basic information operations */ -#define INST_NS_CURRENT 151 -#define INST_INFO_LEVEL_NUM 152 -#define INST_INFO_LEVEL_ARGS 153 -#define INST_RESOLVE_COMMAND 154 - -/* For compilation relating to TclOO */ -#define INST_TCLOO_SELF 155 -#define INST_TCLOO_CLASS 156 -#define INST_TCLOO_NS 157 -#define INST_TCLOO_IS_OBJECT 158 - -/* For compilation of [array] subcommands */ -#define INST_ARRAY_EXISTS_STK 159 -#define INST_ARRAY_EXISTS_IMM 160 -#define INST_ARRAY_MAKE_STK 161 -#define INST_ARRAY_MAKE_IMM 162 - -#define INST_INVOKE_REPLACE 163 - -#define INST_LIST_CONCAT 164 - -#define INST_EXPAND_DROP 165 - -/* New foreach implementation */ -#define INST_FOREACH_START 166 -#define INST_FOREACH_STEP 167 -#define INST_FOREACH_END 168 -#define INST_LMAP_COLLECT 169 - -/* For compilation of [string trim] and related */ -#define INST_STR_TRIM 170 -#define INST_STR_TRIM_LEFT 171 -#define INST_STR_TRIM_RIGHT 172 - -#define INST_CONCAT_STK 173 - -#define INST_STR_UPPER 174 -#define INST_STR_LOWER 175 -#define INST_STR_TITLE 176 -#define INST_STR_REPLACE 177 - -#define INST_ORIGIN_COMMAND 178 - -#define INST_TCLOO_NEXT 179 -#define INST_TCLOO_NEXT_CLASS 180 - -#define INST_YIELD_TO_INVOKE 181 - -#define INST_NUM_TYPE 182 -#define INST_TRY_CVT_TO_BOOLEAN 183 -#define INST_STR_CLASS 184 - -#define INST_LAPPEND_LIST 185 -#define INST_LAPPEND_LIST_ARRAY 186 -#define INST_LAPPEND_LIST_ARRAY_STK 187 -#define INST_LAPPEND_LIST_STK 188 - -#define INST_CLOCK_READ 189 - -#define INST_DICT_GET_DEF 190 - -/* TIP 461 */ -#define INST_STR_LT 191 -#define INST_STR_GT 192 -#define INST_STR_LE 193 -#define INST_STR_GE 194 - -#define INST_LREPLACE4 195 - -/* The last opcode */ -#define LAST_INST_OPCODE 195 +enum TclInstruction { + /* Opcodes 0 to 9 */ + INST_DONE = 0, + INST_PUSH1, + INST_PUSH4, + INST_POP, + INST_DUP, + INST_STR_CONCAT1, + INST_INVOKE_STK1, + INST_INVOKE_STK4, + INST_EVAL_STK, + INST_EXPR_STK, + + /* Opcodes 10 to 23 */ + INST_LOAD_SCALAR1, + INST_LOAD_SCALAR4, + INST_LOAD_SCALAR_STK, + INST_LOAD_ARRAY1, + INST_LOAD_ARRAY4, + INST_LOAD_ARRAY_STK, + INST_LOAD_STK, + INST_STORE_SCALAR1, + INST_STORE_SCALAR4, + INST_STORE_SCALAR_STK, + INST_STORE_ARRAY1, + INST_STORE_ARRAY4, + INST_STORE_ARRAY_STK, + INST_STORE_STK, + + /* Opcodes 24 to 33 */ + INST_INCR_SCALAR1, + INST_INCR_SCALAR_STK, + INST_INCR_ARRAY1, + INST_INCR_ARRAY_STK, + INST_INCR_STK, + INST_INCR_SCALAR1_IMM, + INST_INCR_SCALAR_STK_IMM, + INST_INCR_ARRAY1_IMM, + INST_INCR_ARRAY_STK_IMM, + INST_INCR_STK_IMM, + + /* Opcodes 34 to 39 */ + INST_JUMP1, + INST_JUMP4, + INST_JUMP_TRUE1, + INST_JUMP_TRUE4, + INST_JUMP_FALSE1, + INST_JUMP_FALSE4, + + /* Opcodes 42 to 64 */ + INST_BITOR, + INST_BITXOR, + INST_BITAND, + INST_EQ, + INST_NEQ, + INST_LT, + INST_GT, + INST_LE, + INST_GE, + INST_LSHIFT, + INST_RSHIFT, + INST_ADD, + INST_SUB, + INST_MULT, + INST_DIV, + INST_MOD, + INST_UPLUS, + INST_UMINUS, + INST_BITNOT, + INST_LNOT, + INST_TRY_CVT_TO_NUMERIC, + + /* Opcodes 65 to 66 */ + INST_BREAK, + INST_CONTINUE, + + /* Opcodes 69 to 72 */ + INST_BEGIN_CATCH4, + INST_END_CATCH, + INST_PUSH_RESULT, + INST_PUSH_RETURN_CODE, + + /* Opcodes 73 to 78 */ + INST_STR_EQ, + INST_STR_NEQ, + INST_STR_CMP, + INST_STR_LEN, + INST_STR_INDEX, + INST_STR_MATCH, + + /* Opcodes 79 to 81 */ + INST_LIST, + INST_LIST_INDEX, + INST_LIST_LENGTH, + + /* Opcodes 82 to 87 */ + INST_APPEND_SCALAR1, + INST_APPEND_SCALAR4, + INST_APPEND_ARRAY1, + INST_APPEND_ARRAY4, + INST_APPEND_ARRAY_STK, + INST_APPEND_STK, + + /* Opcodes 88 to 93 */ + INST_LAPPEND_SCALAR1, + INST_LAPPEND_SCALAR4, + INST_LAPPEND_ARRAY1, + INST_LAPPEND_ARRAY4, + INST_LAPPEND_ARRAY_STK, + INST_LAPPEND_STK, + + /* TIP #22 - LINDEX operator with flat arg list */ + INST_LIST_INDEX_MULTI, + + /* + * TIP #33 - 'lset' command. Code gen also required a Forth-like + * OVER operation. + */ + INST_OVER, + INST_LSET_LIST, + INST_LSET_FLAT, + + /* TIP#90 - 'return' command. */ + INST_RETURN_IMM, + + /* TIP#123 - exponentiation operator. */ + INST_EXPON, + + /* TIP #157 - {*}... (word expansion) language syntax support. */ + INST_EXPAND_START, + INST_EXPAND_STKTOP, + INST_INVOKE_EXPANDED, + + /* + * TIP #57 - 'lassign' command. Code generation requires immediate + * LINDEX and LRANGE operators. + */ + INST_LIST_INDEX_IMM, + INST_LIST_RANGE_IMM, + INST_START_CMD, + INST_LIST_IN, + INST_LIST_NOT_IN, + INST_PUSH_RETURN_OPTIONS, + INST_RETURN_STK, + + /* + * Dictionary (TIP#111) related commands. + */ + INST_DICT_GET, + INST_DICT_SET, + INST_DICT_UNSET, + INST_DICT_INCR_IMM, + INST_DICT_APPEND, + INST_DICT_LAPPEND, + INST_DICT_FIRST, + INST_DICT_NEXT, + INST_DICT_UPDATE_START, + INST_DICT_UPDATE_END, + + /* + * Instruction to support jumps defined by tables (instead of the classic + * [switch] technique of chained comparisons). + */ + INST_JUMP_TABLE, + + /* + * Instructions to support compilation of global, variable, upvar and + * [namespace upvar]. + */ + INST_UPVAR, + INST_NSUPVAR, + INST_VARIABLE, + + /* Instruction to support compiling syntax error to bytecode */ + INST_SYNTAX, + + /* Instruction to reverse N items on top of stack */ + INST_REVERSE, + + /* regexp instruction */ + INST_REGEXP, + + /* For [info exists] compilation */ + INST_EXIST_SCALAR, + INST_EXIST_ARRAY, + INST_EXIST_ARRAY_STK, + INST_EXIST_STK, + + /* For [subst] compilation */ + INST_NOP, + INST_RETURN_CODE_BRANCH, + + /* For [unset] compilation */ + INST_UNSET_SCALAR, + INST_UNSET_ARRAY, + INST_UNSET_ARRAY_STK, + INST_UNSET_STK, + + /* For [dict with], [dict exists], [dict create] and [dict merge] */ + INST_DICT_EXPAND, + INST_DICT_RECOMBINE_STK, + INST_DICT_RECOMBINE_IMM, + INST_DICT_EXISTS, + INST_DICT_VERIFY, + + /* For [string map] and [regsub] compilation */ + INST_STR_MAP, + INST_STR_FIND, + INST_STR_FIND_LAST, + INST_STR_RANGE_IMM, + INST_STR_RANGE, + + /* For operations to do with coroutines and other NRE-manipulators */ + INST_YIELD, + INST_COROUTINE_NAME, + INST_TAILCALL, + + /* For compilation of basic information operations */ + INST_NS_CURRENT, + INST_INFO_LEVEL_NUM, + INST_INFO_LEVEL_ARGS, + INST_RESOLVE_COMMAND, + + /* For compilation relating to TclOO */ + INST_TCLOO_SELF, + INST_TCLOO_CLASS, + INST_TCLOO_NS, + INST_TCLOO_IS_OBJECT, + + /* For compilation of [array] subcommands */ + INST_ARRAY_EXISTS_STK, + INST_ARRAY_EXISTS_IMM, + INST_ARRAY_MAKE_STK, + INST_ARRAY_MAKE_IMM, + + INST_INVOKE_REPLACE, + + INST_LIST_CONCAT, + + INST_EXPAND_DROP, + + /* New foreach implementation */ + INST_FOREACH_START, + INST_FOREACH_STEP, + INST_FOREACH_END, + INST_LMAP_COLLECT, + + /* For compilation of [string trim] and related */ + INST_STR_TRIM, + INST_STR_TRIM_LEFT, + INST_STR_TRIM_RIGHT, + + INST_CONCAT_STK, + + INST_STR_UPPER, + INST_STR_LOWER, + INST_STR_TITLE, + INST_STR_REPLACE, + + INST_ORIGIN_COMMAND, + + INST_TCLOO_NEXT, + INST_TCLOO_NEXT_CLASS, + + INST_YIELD_TO_INVOKE, + + INST_NUM_TYPE, + INST_TRY_CVT_TO_BOOLEAN, + INST_STR_CLASS, + + INST_LAPPEND_LIST, + INST_LAPPEND_LIST_ARRAY, + INST_LAPPEND_LIST_ARRAY_STK, + INST_LAPPEND_LIST_STK, + + INST_CLOCK_READ, + + INST_DICT_GET_DEF, + + /* TIP 461 */ + INST_STR_LT, + INST_STR_GT, + INST_STR_LE, + INST_STR_GE, + + INST_LREPLACE4, + + /* The last opcode */ + LAST_INST_OPCODE +}; /* * Table describing the Tcl bytecode instructions: their name (for displaying @@ -1076,6 +1064,7 @@ typedef struct { *---------------------------------------------------------------- */ +#if TCL_MAJOR_VERSION > 8 MODULE_SCOPE Tcl_ObjCmdProc TclNRInterpCoroutine; /* @@ -1095,38 +1084,38 @@ MODULE_SCOPE ByteCode * TclCompileObj(Tcl_Interp *interp, Tcl_Obj *objPtr, */ MODULE_SCOPE int TclAttemptCompileProc(Tcl_Interp *interp, - Tcl_Parse *parsePtr, int depth, Command *cmdPtr, + Tcl_Parse *parsePtr, size_t depth, Command *cmdPtr, CompileEnv *envPtr); MODULE_SCOPE void TclCleanupStackForBreakContinue(CompileEnv *envPtr, ExceptionAux *auxPtr); MODULE_SCOPE void TclCompileCmdWord(Tcl_Interp *interp, - Tcl_Token *tokenPtr, int count, + Tcl_Token *tokenPtr, size_t count, CompileEnv *envPtr); MODULE_SCOPE void TclCompileExpr(Tcl_Interp *interp, const char *script, - int numBytes, CompileEnv *envPtr, int optimize); + size_t numBytes, CompileEnv *envPtr, int optimize); MODULE_SCOPE void TclCompileExprWords(Tcl_Interp *interp, - Tcl_Token *tokenPtr, int numWords, + Tcl_Token *tokenPtr, size_t numWords, CompileEnv *envPtr); MODULE_SCOPE void TclCompileInvocation(Tcl_Interp *interp, - Tcl_Token *tokenPtr, Tcl_Obj *cmdObj, int numWords, + Tcl_Token *tokenPtr, Tcl_Obj *cmdObj, size_t numWords, CompileEnv *envPtr); MODULE_SCOPE void TclCompileScript(Tcl_Interp *interp, - const char *script, int numBytes, + const char *script, size_t numBytes, CompileEnv *envPtr); MODULE_SCOPE void TclCompileSyntaxError(Tcl_Interp *interp, CompileEnv *envPtr); MODULE_SCOPE void TclCompileTokens(Tcl_Interp *interp, - Tcl_Token *tokenPtr, int count, + Tcl_Token *tokenPtr, size_t count, CompileEnv *envPtr); MODULE_SCOPE void TclCompileVarSubst(Tcl_Interp *interp, Tcl_Token *tokenPtr, CompileEnv *envPtr); -MODULE_SCOPE int TclCreateAuxData(void *clientData, +MODULE_SCOPE size_t TclCreateAuxData(void *clientData, const AuxDataType *typePtr, CompileEnv *envPtr); -MODULE_SCOPE int TclCreateExceptRange(ExceptionRangeType type, +MODULE_SCOPE size_t TclCreateExceptRange(ExceptionRangeType type, CompileEnv *envPtr); -MODULE_SCOPE ExecEnv * TclCreateExecEnv(Tcl_Interp *interp, int size); +MODULE_SCOPE ExecEnv * TclCreateExecEnv(Tcl_Interp *interp, size_t size); MODULE_SCOPE Tcl_Obj * TclCreateLiteral(Interp *iPtr, const char *bytes, - int length, TCL_HASH_TYPE hash, int *newPtr, + size_t length, TCL_HASH_TYPE hash, int *newPtr, Namespace *nsPtr, int flags, LiteralEntry **globalPtrPtr); MODULE_SCOPE void TclDeleteExecEnv(ExecEnv *eePtr); @@ -1141,7 +1130,7 @@ 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 int TclFindCompiledLocal(const char *name, int nameChars, +MODULE_SCOPE size_t TclFindCompiledLocal(const char *name, size_t nameChars, int create, CompileEnv *envPtr); MODULE_SCOPE int TclFixupForwardJump(CompileEnv *envPtr, JumpFixup *jumpFixupPtr, int jumpDist, @@ -1149,13 +1138,13 @@ MODULE_SCOPE int TclFixupForwardJump(CompileEnv *envPtr, MODULE_SCOPE void TclFreeCompileEnv(CompileEnv *envPtr); MODULE_SCOPE void TclFreeJumpFixupArray(JumpFixupArray *fixupArrayPtr); MODULE_SCOPE int TclGetIndexFromToken(Tcl_Token *tokenPtr, - int before, int after, int *indexPtr); + size_t before, size_t after, int *indexPtr); MODULE_SCOPE ByteCode * TclInitByteCode(CompileEnv *envPtr); MODULE_SCOPE ByteCode * TclInitByteCodeObj(Tcl_Obj *objPtr, const Tcl_ObjType *typePtr, CompileEnv *envPtr); MODULE_SCOPE void TclInitCompileEnv(Tcl_Interp *interp, CompileEnv *envPtr, const char *string, - int numBytes, const CmdFrame *invoker, int word); + size_t numBytes, const CmdFrame *invoker, int word); MODULE_SCOPE void TclInitJumpFixupArray(JumpFixupArray *fixupArrayPtr); MODULE_SCOPE void TclInitLiteralTable(LiteralTable *tablePtr); MODULE_SCOPE ExceptionRange *TclGetInnermostExceptionRange(CompileEnv *envPtr, @@ -1170,9 +1159,9 @@ MODULE_SCOPE void TclFinalizeLoopExceptionRange(CompileEnv *envPtr, MODULE_SCOPE char * TclLiteralStats(LiteralTable *tablePtr); MODULE_SCOPE int TclLog2(int value); #endif -MODULE_SCOPE int TclLocalScalar(const char *bytes, int numBytes, +MODULE_SCOPE size_t TclLocalScalar(const char *bytes, size_t numBytes, CompileEnv *envPtr); -MODULE_SCOPE int TclLocalScalarFromToken(Tcl_Token *tokenPtr, +MODULE_SCOPE size_t TclLocalScalarFromToken(Tcl_Token *tokenPtr, CompileEnv *envPtr); MODULE_SCOPE void TclOptimizeBytecode(void *envPtr); #ifdef TCL_COMPILE_DEBUG @@ -1182,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, int maxChars); + Tcl_Obj *objPtr, size_t maxChars); MODULE_SCOPE void TclPrintSource(FILE *outFile, - const char *string, int maxChars); + const char *string, size_t maxChars); MODULE_SCOPE void TclPushVarName(Tcl_Interp *interp, Tcl_Token *varTokenPtr, CompileEnv *envPtr, int flags, int *localIndexPtr, @@ -1206,14 +1195,16 @@ MODULE_SCOPE int TclWordKnownAtCompileTime(Tcl_Token *tokenPtr, Tcl_Obj *valuePtr); MODULE_SCOPE void TclLogCommandInfo(Tcl_Interp *interp, const char *script, const char *command, - int length, const unsigned char *pc, + size_t 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, int objc, + Tcl_Interp *interp, size_t objc, Tcl_Obj *const objv[], int isLambda); +#endif /* TCL_MAJOR_VERSION > 8 */ + /* *---------------------------------------------------------------- @@ -1246,7 +1237,7 @@ MODULE_SCOPE int TclPushProcCallFrame(void *clientData, #define TclAdjustStackDepth(delta, envPtr) \ do { \ if ((delta) < 0) { \ - if ((envPtr)->maxStackDepth < (envPtr)->currStackDepth) { \ + if ((int)(envPtr)->maxStackDepth < (int)(envPtr)->currStackDepth) { \ (envPtr)->maxStackDepth = (envPtr)->currStackDepth; \ } \ } \ @@ -1459,7 +1450,7 @@ MODULE_SCOPE int TclPushProcCallFrame(void *clientData, #define TclFixupForwardJumpToHere(envPtr, fixupPtr, threshold) \ TclFixupForwardJump((envPtr), (fixupPtr), \ - (envPtr)->codeNext-(envPtr)->codeStart-(fixupPtr)->codeOffset, \ + (envPtr)->codeNext-(envPtr)->codeStart-(int)(fixupPtr)->codeOffset, \ (threshold)) /* @@ -1509,12 +1500,12 @@ MODULE_SCOPE int TclPushProcCallFrame(void *clientData, * Macros used to compute the minimum and maximum of two values. The ANSI C * "prototypes" for these macros are: * - * int TclMin(int i, int j); - * int TclMax(int i, int j); + * size_t TclMin(size_t i, size_t j); + * size_t TclMax(size_t i, size_t j); */ -#define TclMin(i, j) ((((int) i) < ((int) j))? (i) : (j)) -#define TclMax(i, j) ((((int) i) > ((int) j))? (i) : (j)) +#define TclMin(i, j) ((((size_t) i) + 1 < ((size_t) j) + 1 )? (i) : (j)) +#define TclMax(i, j) ((((size_t) i) + 1 > ((size_t) j) + 1 )? (i) : (j)) /* * Convenience macros for use when compiling bodies of commands. The ANSI C @@ -1544,7 +1535,7 @@ MODULE_SCOPE int TclPushProcCallFrame(void *clientData, * these macros are: * * static void PushLiteral(CompileEnv *envPtr, - * const char *string, int length); + * const char *string, Tcl_Size length); * static void PushStringLiteral(CompileEnv *envPtr, * const char *string); */ @@ -1594,7 +1585,7 @@ MODULE_SCOPE int TclPushProcCallFrame(void *clientData, #define ExceptionRangeEnds(envPtr, index) \ (((envPtr)->exceptDepth--), \ ((envPtr)->exceptArrayPtr[(index)].numCodeBytes = \ - CurrentOffset(envPtr) - (envPtr)->exceptArrayPtr[(index)].codeOffset)) + CurrentOffset(envPtr) - (int)(envPtr)->exceptArrayPtr[(index)].codeOffset)) #define ExceptionRangeTarget(envPtr, index, targetType) \ ((envPtr)->exceptArrayPtr[(index)].targetType = CurrentOffset(envPtr)) diff --git a/generic/tclConfig.c b/generic/tclConfig.c index 5bffbcb..1ece31c 100644 --- a/generic/tclConfig.c +++ b/generic/tclConfig.c @@ -31,7 +31,7 @@ * the (Tcl_Interp *) in which it is stored, and the encoding. */ -typedef struct QCCD { +typedef struct { Tcl_Obj *pkg; Tcl_Interp *interp; char *encoding; @@ -76,11 +76,11 @@ Tcl_RegisterConfig( Tcl_Obj *pDB, *pkgDict; Tcl_DString cmdName; const Tcl_Config *cfg; - QCCD *cdPtr = (QCCD *)ckalloc(sizeof(QCCD)); + QCCD *cdPtr = (QCCD *)Tcl_Alloc(sizeof(QCCD)); cdPtr->interp = interp; if (valEncoding) { - cdPtr->encoding = (char *)ckalloc(strlen(valEncoding)+1); + cdPtr->encoding = (char *)Tcl_Alloc(strlen(valEncoding)+1); strcpy(cdPtr->encoding, valEncoding); } else { cdPtr->encoding = NULL; @@ -191,7 +191,7 @@ Tcl_RegisterConfig( static int QueryConfigObjCmd( - ClientData clientData, + void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) @@ -199,13 +199,13 @@ QueryConfigObjCmd( QCCD *cdPtr = (QCCD *)clientData; Tcl_Obj *pkgName = cdPtr->pkg; Tcl_Obj *pDB, *pkgDict, *val, *listPtr; - int n, index; + size_t m, n = 0; static const char *const subcmdStrings[] = { "get", "list", NULL }; enum subcmds { CFG_GET, CFG_LIST - }; + } index; Tcl_DString conv; Tcl_Encoding venc = NULL; const char *value; @@ -233,7 +233,7 @@ QueryConfigObjCmd( return TCL_ERROR; } - switch ((enum subcmds) index) { + switch (index) { case CFG_GET: if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "key"); @@ -258,7 +258,10 @@ QueryConfigObjCmd( * Value is stored as-is in a byte array, see Bug [9b2e636361], * so we have to decode it first. */ - value = (const char *) Tcl_GetByteArrayFromObj(val, &n); + value = (const char *) Tcl_GetBytesFromObj(interp, val, &n); + if (value == NULL) { + return TCL_ERROR; + } value = Tcl_ExternalToUtfDString(venc, value, n, &conv); Tcl_SetObjResult(interp, Tcl_NewStringObj(value, Tcl_DStringLength(&conv))); @@ -271,8 +274,8 @@ QueryConfigObjCmd( return TCL_ERROR; } - Tcl_DictObjSize(interp, pkgDict, &n); - listPtr = Tcl_NewListObj(n, NULL); + Tcl_DictObjSize(interp, pkgDict, &m); + listPtr = Tcl_NewListObj(m, NULL); if (!listPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( @@ -281,7 +284,7 @@ QueryConfigObjCmd( return TCL_ERROR; } - if (n) { + if (m) { Tcl_DictSearch s; Tcl_Obj *key; int done; @@ -321,7 +324,7 @@ QueryConfigObjCmd( static void QueryConfigDelete( - ClientData clientData) + void *clientData) { QCCD *cdPtr = (QCCD *)clientData; Tcl_Obj *pkgName = cdPtr->pkg; @@ -330,9 +333,9 @@ QueryConfigDelete( Tcl_DictObjRemove(NULL, pDB, pkgName); Tcl_DecrRefCount(pkgName); if (cdPtr->encoding) { - ckfree(cdPtr->encoding); + Tcl_Free(cdPtr->encoding); } - ckfree(cdPtr); + Tcl_Free(cdPtr); } /* @@ -388,7 +391,7 @@ GetConfigDict( static void ConfigDictDeleteProc( - ClientData clientData, /* Pointer to Tcl_Obj. */ + void *clientData, /* Pointer to Tcl_Obj. */ TCL_UNUSED(Tcl_Interp *)) { Tcl_DecrRefCount((Tcl_Obj *)clientData); diff --git a/generic/tclDTrace.d b/generic/tclDTrace.d index f5493b1..9d1adc0 100644 --- a/generic/tclDTrace.d +++ b/generic/tclDTrace.d @@ -181,9 +181,9 @@ typedef struct Tcl_ObjType { } Tcl_ObjType; struct Tcl_Obj { - int refCount; + size_t refCount; char *bytes; - int length; + size_t length; const Tcl_ObjType *typePtr; union { long longValue; diff --git a/generic/tclDate.c b/generic/tclDate.c index edf069a..fa6e60d 100644 --- a/generic/tclDate.c +++ b/generic/tclDate.c @@ -146,8 +146,8 @@ typedef struct DateInfo { int dateDigitCount; } DateInfo; -#define YYMALLOC ckalloc -#define YYFREE(x) (ckfree((void*) (x))) +#define YYMALLOC Tcl_Alloc +#define YYFREE(x) (Tcl_Free((void*) (x))) #define yyDSTmode (info->dateDSTmode) #define yyDayOrdinal (info->dateDayOrdinal) @@ -2760,7 +2760,7 @@ TclClockOldscanObjCmd( return TCL_ERROR; } - yyInput = Tcl_GetString( objv[1] ); + yyInput = TclGetString(objv[1]); dateInfo.dateStart = yyInput; yyHaveDate = 0; @@ -2847,16 +2847,16 @@ TclClockOldscanObjCmd( TclNewObj(resultElement); if (yyHaveDate) { Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj((int) yyYear)); + Tcl_NewIntObj(yyYear)); Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj((int) yyMonth)); + Tcl_NewIntObj(yyMonth)); Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj((int) yyDay)); + Tcl_NewIntObj(yyDay)); } Tcl_ListObjAppendElement(interp, result, resultElement); if (yyHaveTime) { - Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj((int) + Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj( ToSeconds(yyHour, yyMinutes, yySeconds, (MERIDIAN)yyMeridian))); } else { Tcl_ListObjAppendElement(interp, result, Tcl_NewObj()); @@ -2865,7 +2865,7 @@ TclClockOldscanObjCmd( TclNewObj(resultElement); if (yyHaveZone) { Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj((int) -yyTimezone)); + Tcl_NewIntObj(-yyTimezone)); Tcl_ListObjAppendElement(interp, resultElement, Tcl_NewIntObj(1 - yyDSTmode)); } @@ -2874,29 +2874,29 @@ TclClockOldscanObjCmd( TclNewObj(resultElement); if (yyHaveRel) { Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj((int) yyRelMonth)); + Tcl_NewIntObj(yyRelMonth)); Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj((int) yyRelDay)); + Tcl_NewIntObj(yyRelDay)); Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj((int) yyRelSeconds)); + Tcl_NewIntObj(yyRelSeconds)); } Tcl_ListObjAppendElement(interp, result, resultElement); TclNewObj(resultElement); if (yyHaveDay && !yyHaveDate) { Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj((int) yyDayOrdinal)); + Tcl_NewIntObj(yyDayOrdinal)); Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj((int) yyDayNumber)); + Tcl_NewIntObj(yyDayNumber)); } Tcl_ListObjAppendElement(interp, result, resultElement); TclNewObj(resultElement); if (yyHaveOrdinalMonth) { Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj((int) yyMonthOrdinal)); + Tcl_NewIntObj(yyMonthOrdinal)); Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj((int) yyMonth)); + Tcl_NewIntObj(yyMonth)); } Tcl_ListObjAppendElement(interp, result, resultElement); diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 75fc17e..d5eaf6d 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -14,10 +14,6 @@ #include <stddef.h> /* for size_t */ -#ifdef TCL_NO_DEPRECATED -# define Tcl_SavedResult void -#endif /* TCL_NO_DEPRECATED */ - #undef TCL_STORAGE_CLASS #ifdef BUILD_tcl # define TCL_STORAGE_CLASS DLLEXPORT @@ -65,37 +61,24 @@ EXTERN const char * Tcl_PkgRequireEx(Tcl_Interp *interp, /* 2 */ EXTERN TCL_NORETURN void Tcl_Panic(const char *format, ...) TCL_FORMAT_PRINTF(1, 2); /* 3 */ -EXTERN char * Tcl_Alloc(TCL_HASH_TYPE size); +EXTERN void * Tcl_Alloc(TCL_HASH_TYPE size); /* 4 */ -EXTERN void Tcl_Free(char *ptr); +EXTERN void Tcl_Free(void *ptr); /* 5 */ -EXTERN char * Tcl_Realloc(char *ptr, TCL_HASH_TYPE size); +EXTERN void * Tcl_Realloc(void *ptr, TCL_HASH_TYPE size); /* 6 */ -EXTERN char * Tcl_DbCkalloc(TCL_HASH_TYPE size, const char *file, +EXTERN void * Tcl_DbCkalloc(TCL_HASH_TYPE size, const char *file, int line); /* 7 */ -EXTERN void Tcl_DbCkfree(char *ptr, const char *file, int line); +EXTERN void Tcl_DbCkfree(void *ptr, const char *file, int line); /* 8 */ -EXTERN char * Tcl_DbCkrealloc(char *ptr, TCL_HASH_TYPE size, +EXTERN void * Tcl_DbCkrealloc(void *ptr, TCL_HASH_TYPE size, const char *file, int line); -#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */ -/* 9 */ -EXTERN void Tcl_CreateFileHandler(int fd, int mask, - Tcl_FileProc *proc, void *clientData); -#endif /* UNIX */ -#ifdef MAC_OSX_TCL /* MACOSX */ /* 9 */ EXTERN void Tcl_CreateFileHandler(int fd, int mask, Tcl_FileProc *proc, void *clientData); -#endif /* MACOSX */ -#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */ -/* 10 */ -EXTERN void Tcl_DeleteFileHandler(int fd); -#endif /* UNIX */ -#ifdef MAC_OSX_TCL /* MACOSX */ /* 10 */ EXTERN void Tcl_DeleteFileHandler(int fd); -#endif /* MACOSX */ /* 11 */ EXTERN void Tcl_SetTimer(const Tcl_Time *timePtr); /* 12 */ @@ -124,10 +107,7 @@ EXTERN void Tcl_DbIncrRefCount(Tcl_Obj *objPtr, const char *file, /* 21 */ EXTERN int Tcl_DbIsShared(Tcl_Obj *objPtr, const char *file, int line); -/* 22 */ -TCL_DEPRECATED("No longer in use, changed to macro") -Tcl_Obj * Tcl_DbNewBooleanObj(int intValue, const char *file, - int line); +/* Slot 22 is reserved */ /* 23 */ EXTERN Tcl_Obj * Tcl_DbNewByteArrayObj(const unsigned char *bytes, Tcl_Size numBytes, const char *file, @@ -138,10 +118,7 @@ EXTERN Tcl_Obj * Tcl_DbNewDoubleObj(double doubleValue, /* 25 */ EXTERN Tcl_Obj * Tcl_DbNewListObj(Tcl_Size objc, Tcl_Obj *const *objv, const char *file, int line); -/* 26 */ -TCL_DEPRECATED("No longer in use, changed to macro") -Tcl_Obj * Tcl_DbNewLongObj(long longValue, const char *file, - int line); +/* Slot 26 is reserved */ /* 27 */ EXTERN Tcl_Obj * Tcl_DbNewObj(const char *file, int line); /* 28 */ @@ -158,7 +135,7 @@ EXTERN int Tcl_GetBoolean(Tcl_Interp *interp, const char *src, EXTERN int Tcl_GetBooleanFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr); /* 33 */ -EXTERN unsigned char * Tcl_GetByteArrayFromObj(Tcl_Obj *objPtr, +EXTERN unsigned char * TclGetByteArrayFromObj(Tcl_Obj *objPtr, int *numBytesPtr); /* 34 */ EXTERN int Tcl_GetDouble(Tcl_Interp *interp, const char *src, @@ -166,11 +143,7 @@ EXTERN int Tcl_GetDouble(Tcl_Interp *interp, const char *src, /* 35 */ EXTERN int Tcl_GetDoubleFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, double *doublePtr); -/* 36 */ -TCL_DEPRECATED("No longer in use, changed to macro") -int Tcl_GetIndexFromObj(Tcl_Interp *interp, - Tcl_Obj *objPtr, const char *const *tablePtr, - const char *msg, int flags, int *indexPtr); +/* Slot 36 is reserved */ /* 37 */ EXTERN int Tcl_GetInt(Tcl_Interp *interp, const char *src, int *intPtr); @@ -181,9 +154,9 @@ EXTERN int Tcl_GetIntFromObj(Tcl_Interp *interp, EXTERN int Tcl_GetLongFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr); /* 40 */ -EXTERN CONST86 Tcl_ObjType * Tcl_GetObjType(const char *typeName); +EXTERN const Tcl_ObjType * Tcl_GetObjType(const char *typeName); /* 41 */ -EXTERN char * Tcl_GetStringFromObj(Tcl_Obj *objPtr, int *lengthPtr); +EXTERN char * TclGetStringFromObj(Tcl_Obj *objPtr, int *lengthPtr); /* 42 */ EXTERN void Tcl_InvalidateStringRep(Tcl_Obj *objPtr); /* 43 */ @@ -193,7 +166,7 @@ EXTERN int Tcl_ListObjAppendList(Tcl_Interp *interp, EXTERN int Tcl_ListObjAppendElement(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *objPtr); /* 45 */ -EXTERN int Tcl_ListObjGetElements(Tcl_Interp *interp, +EXTERN int TclListObjGetElements(Tcl_Interp *interp, Tcl_Obj *listPtr, int *objcPtr, Tcl_Obj ***objvPtr); /* 46 */ @@ -201,36 +174,28 @@ EXTERN int Tcl_ListObjIndex(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size index, Tcl_Obj **objPtrPtr); /* 47 */ -EXTERN int Tcl_ListObjLength(Tcl_Interp *interp, +EXTERN int TclListObjLength(Tcl_Interp *interp, Tcl_Obj *listPtr, int *lengthPtr); /* 48 */ EXTERN int Tcl_ListObjReplace(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size first, Tcl_Size count, Tcl_Size objc, Tcl_Obj *const objv[]); -/* 49 */ -TCL_DEPRECATED("No longer in use, changed to macro") -Tcl_Obj * Tcl_NewBooleanObj(int intValue); +/* Slot 49 is reserved */ /* 50 */ EXTERN Tcl_Obj * Tcl_NewByteArrayObj(const unsigned char *bytes, Tcl_Size numBytes); /* 51 */ EXTERN Tcl_Obj * Tcl_NewDoubleObj(double doubleValue); -/* 52 */ -TCL_DEPRECATED("No longer in use, changed to macro") -Tcl_Obj * Tcl_NewIntObj(int intValue); +/* Slot 52 is reserved */ /* 53 */ EXTERN Tcl_Obj * Tcl_NewListObj(Tcl_Size objc, Tcl_Obj *const objv[]); -/* 54 */ -TCL_DEPRECATED("No longer in use, changed to macro") -Tcl_Obj * Tcl_NewLongObj(long longValue); +/* Slot 54 is reserved */ /* 55 */ EXTERN Tcl_Obj * Tcl_NewObj(void); /* 56 */ EXTERN Tcl_Obj * Tcl_NewStringObj(const char *bytes, Tcl_Size length); -/* 57 */ -TCL_DEPRECATED("No longer in use, changed to macro") -void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int intValue); +/* Slot 57 is reserved */ /* 58 */ EXTERN unsigned char * Tcl_SetByteArrayLength(Tcl_Obj *objPtr, Tcl_Size numBytes); @@ -240,28 +205,18 @@ EXTERN void Tcl_SetByteArrayObj(Tcl_Obj *objPtr, Tcl_Size numBytes); /* 60 */ EXTERN void Tcl_SetDoubleObj(Tcl_Obj *objPtr, double doubleValue); -/* 61 */ -TCL_DEPRECATED("No longer in use, changed to macro") -void Tcl_SetIntObj(Tcl_Obj *objPtr, int intValue); +/* Slot 61 is reserved */ /* 62 */ EXTERN void Tcl_SetListObj(Tcl_Obj *objPtr, Tcl_Size objc, Tcl_Obj *const objv[]); -/* 63 */ -TCL_DEPRECATED("No longer in use, changed to macro") -void Tcl_SetLongObj(Tcl_Obj *objPtr, long longValue); +/* Slot 63 is reserved */ /* 64 */ EXTERN void Tcl_SetObjLength(Tcl_Obj *objPtr, Tcl_Size length); /* 65 */ EXTERN void Tcl_SetStringObj(Tcl_Obj *objPtr, const char *bytes, Tcl_Size length); -/* 66 */ -TCL_DEPRECATED("No longer in use, changed to macro") -void Tcl_AddErrorInfo(Tcl_Interp *interp, - const char *message); -/* 67 */ -TCL_DEPRECATED("No longer in use, changed to macro") -void Tcl_AddObjErrorInfo(Tcl_Interp *interp, - const char *message, int length); +/* Slot 66 is reserved */ +/* Slot 67 is reserved */ /* 68 */ EXTERN void Tcl_AllowExceptions(Tcl_Interp *interp); /* 69 */ @@ -280,12 +235,8 @@ EXTERN int Tcl_AsyncInvoke(Tcl_Interp *interp, int code); EXTERN void Tcl_AsyncMark(Tcl_AsyncHandler async); /* 75 */ EXTERN int Tcl_AsyncReady(void); -/* 76 */ -TCL_DEPRECATED("No longer in use, changed to macro") -void Tcl_BackgroundError(Tcl_Interp *interp); -/* 77 */ -TCL_DEPRECATED("Use Tcl_UtfBackslash") -char Tcl_Backslash(const char *src, int *readPtr); +/* Slot 76 is reserved */ +/* Slot 77 is reserved */ /* 78 */ EXTERN int Tcl_BadChannelOption(Tcl_Interp *interp, const char *optionName, @@ -342,12 +293,7 @@ EXTERN void Tcl_CreateExitHandler(Tcl_ExitProc *proc, void *clientData); /* 94 */ EXTERN Tcl_Interp * Tcl_CreateInterp(void); -/* 95 */ -TCL_DEPRECATED("") -void Tcl_CreateMathFunc(Tcl_Interp *interp, - const char *name, int numArgs, - Tcl_ValueType *argTypes, Tcl_MathProc *proc, - void *clientData); +/* Slot 95 is reserved */ /* 96 */ EXTERN Tcl_Command Tcl_CreateObjCommand(Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc *proc, @@ -435,14 +381,11 @@ EXTERN int Tcl_Eof(Tcl_Channel chan); EXTERN const char * Tcl_ErrnoId(void); /* 128 */ EXTERN const char * Tcl_ErrnoMsg(int err); -/* 129 */ -EXTERN int Tcl_Eval(Tcl_Interp *interp, const char *script); +/* Slot 129 is reserved */ /* 130 */ EXTERN int Tcl_EvalFile(Tcl_Interp *interp, const char *fileName); -/* 131 */ -TCL_DEPRECATED("No longer in use, changed to macro") -int Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr); +/* Slot 131 is reserved */ /* 132 */ EXTERN void Tcl_EventuallyFree(void *clientData, Tcl_FreeProc *freeProc); @@ -477,16 +420,13 @@ EXTERN int Tcl_ExprObj(Tcl_Interp *interp, Tcl_Obj *objPtr, EXTERN int Tcl_ExprString(Tcl_Interp *interp, const char *expr); /* 143 */ EXTERN void Tcl_Finalize(void); -/* 144 */ -EXTERN const char * Tcl_FindExecutable(const char *argv0); +/* Slot 144 is reserved */ /* 145 */ EXTERN Tcl_HashEntry * Tcl_FirstHashEntry(Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr); /* 146 */ EXTERN int Tcl_Flush(Tcl_Channel chan); -/* 147 */ -TCL_DEPRECATED("see TIP #559. Use Tcl_ResetResult") -void Tcl_FreeResult(Tcl_Interp *interp); +/* Slot 147 is reserved */ /* 148 */ EXTERN int Tcl_GetAlias(Tcl_Interp *interp, const char *childCmd, @@ -522,7 +462,7 @@ EXTERN int Tcl_GetChannelOption(Tcl_Interp *interp, Tcl_Channel chan, const char *optionName, Tcl_DString *dsPtr); /* 158 */ -EXTERN CONST86 Tcl_ChannelType * Tcl_GetChannelType(Tcl_Channel chan); +EXTERN const Tcl_ChannelType * Tcl_GetChannelType(Tcl_Channel chan); /* 159 */ EXTERN int Tcl_GetCommandInfo(Tcl_Interp *interp, const char *cmdName, Tcl_CmdInfo *infoPtr); @@ -542,18 +482,10 @@ EXTERN Tcl_Interp * Tcl_GetParent(Tcl_Interp *interp); EXTERN const char * Tcl_GetNameOfExecutable(void); /* 166 */ EXTERN Tcl_Obj * Tcl_GetObjResult(Tcl_Interp *interp); -#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */ -/* 167 */ -EXTERN int Tcl_GetOpenFile(Tcl_Interp *interp, - const char *chanID, int forWriting, - int checkUsage, void **filePtr); -#endif /* UNIX */ -#ifdef MAC_OSX_TCL /* MACOSX */ /* 167 */ EXTERN int Tcl_GetOpenFile(Tcl_Interp *interp, const char *chanID, int forWriting, int checkUsage, void **filePtr); -#endif /* MACOSX */ /* 168 */ EXTERN Tcl_PathType Tcl_GetPathType(const char *path); /* 169 */ @@ -566,22 +498,13 @@ EXTERN int Tcl_GetServiceMode(void); EXTERN Tcl_Interp * Tcl_GetChild(Tcl_Interp *interp, const char *name); /* 173 */ EXTERN Tcl_Channel Tcl_GetStdChannel(int type); -/* 174 */ -EXTERN const char * Tcl_GetStringResult(Tcl_Interp *interp); -/* 175 */ -TCL_DEPRECATED("No longer in use, changed to macro") -const char * Tcl_GetVar(Tcl_Interp *interp, const char *varName, - int flags); +/* Slot 174 is reserved */ +/* Slot 175 is reserved */ /* 176 */ EXTERN const char * Tcl_GetVar2(Tcl_Interp *interp, const char *part1, const char *part2, int flags); -/* 177 */ -EXTERN int Tcl_GlobalEval(Tcl_Interp *interp, - const char *command); -/* 178 */ -TCL_DEPRECATED("No longer in use, changed to macro") -int Tcl_GlobalEvalObj(Tcl_Interp *interp, - Tcl_Obj *objPtr); +/* Slot 177 is reserved */ +/* Slot 178 is reserved */ /* 179 */ EXTERN int Tcl_HideCommand(Tcl_Interp *interp, const char *cmdName, @@ -608,9 +531,7 @@ EXTERN int Tcl_LinkVar(Tcl_Interp *interp, const char *varName, /* Slot 188 is reserved */ /* 189 */ EXTERN Tcl_Channel Tcl_MakeFileChannel(void *handle, int mode); -/* 190 */ -TCL_DEPRECATED("") -int Tcl_MakeSafe(Tcl_Interp *interp); +/* Slot 190 is reserved */ /* 191 */ EXTERN Tcl_Channel Tcl_MakeTcpClientChannel(void *tcpSocket); /* 192 */ @@ -690,9 +611,7 @@ EXTERN Tcl_Size Tcl_ScanElement(const char *src, int *flagPtr); /* 219 */ EXTERN Tcl_Size Tcl_ScanCountedElement(const char *src, Tcl_Size length, int *flagPtr); -/* 220 */ -TCL_DEPRECATED("") -int Tcl_SeekOld(Tcl_Channel chan, int offset, int mode); +/* Slot 220 is reserved */ /* 221 */ EXTERN int Tcl_ServiceAll(void); /* 222 */ @@ -718,15 +637,11 @@ EXTERN void Tcl_SetErrno(int err); EXTERN void Tcl_SetErrorCode(Tcl_Interp *interp, ...); /* 229 */ EXTERN void Tcl_SetMaxBlockTime(const Tcl_Time *timePtr); -/* 230 */ -EXTERN const char * Tcl_SetPanicProc( - TCL_NORETURN1 Tcl_PanicProc *panicProc); +/* Slot 230 is reserved */ /* 231 */ EXTERN Tcl_Size Tcl_SetRecursionLimit(Tcl_Interp *interp, Tcl_Size depth); -/* 232 */ -EXTERN void Tcl_SetResult(Tcl_Interp *interp, char *result, - Tcl_FreeProc *freeProc); +/* Slot 232 is reserved */ /* 233 */ EXTERN int Tcl_SetServiceMode(int mode); /* 234 */ @@ -737,10 +652,7 @@ EXTERN void Tcl_SetObjResult(Tcl_Interp *interp, Tcl_Obj *resultObjPtr); /* 236 */ EXTERN void Tcl_SetStdChannel(Tcl_Channel channel, int type); -/* 237 */ -TCL_DEPRECATED("No longer in use, changed to macro") -const char * Tcl_SetVar(Tcl_Interp *interp, const char *varName, - const char *newValue, int flags); +/* Slot 237 is reserved */ /* 238 */ EXTERN const char * Tcl_SetVar2(Tcl_Interp *interp, const char *part1, const char *part2, const char *newValue, @@ -752,28 +664,15 @@ EXTERN const char * Tcl_SignalMsg(int sig); /* 241 */ EXTERN void Tcl_SourceRCFile(Tcl_Interp *interp); /* 242 */ -EXTERN int Tcl_SplitList(Tcl_Interp *interp, - const char *listStr, int *argcPtr, - const char ***argvPtr); +EXTERN int TclSplitList(Tcl_Interp *interp, const char *listStr, + int *argcPtr, const char ***argvPtr); /* 243 */ -EXTERN void Tcl_SplitPath(const char *path, int *argcPtr, +EXTERN void TclSplitPath(const char *path, int *argcPtr, const char ***argvPtr); -/* 244 */ -EXTERN void Tcl_StaticLibrary(Tcl_Interp *interp, - const char *prefix, - Tcl_LibraryInitProc *initProc, - Tcl_LibraryInitProc *safeInitProc); -/* 245 */ -TCL_DEPRECATED("No longer in use, changed to macro") -int Tcl_StringMatch(const char *str, const char *pattern); -/* 246 */ -TCL_DEPRECATED("") -int Tcl_TellOld(Tcl_Channel chan); -/* 247 */ -TCL_DEPRECATED("No longer in use, changed to macro") -int Tcl_TraceVar(Tcl_Interp *interp, const char *varName, - int flags, Tcl_VarTraceProc *proc, - void *clientData); +/* Slot 244 is reserved */ +/* Slot 245 is reserved */ +/* Slot 246 is reserved */ +/* Slot 247 is reserved */ /* 248 */ EXTERN int Tcl_TraceVar2(Tcl_Interp *interp, const char *part1, const char *part2, int flags, @@ -790,18 +689,11 @@ EXTERN void Tcl_UnlinkVar(Tcl_Interp *interp, /* 252 */ EXTERN int Tcl_UnregisterChannel(Tcl_Interp *interp, Tcl_Channel chan); -/* 253 */ -TCL_DEPRECATED("No longer in use, changed to macro") -int Tcl_UnsetVar(Tcl_Interp *interp, const char *varName, - int flags); +/* Slot 253 is reserved */ /* 254 */ EXTERN int Tcl_UnsetVar2(Tcl_Interp *interp, const char *part1, const char *part2, int flags); -/* 255 */ -TCL_DEPRECATED("No longer in use, changed to macro") -void Tcl_UntraceVar(Tcl_Interp *interp, - const char *varName, int flags, - Tcl_VarTraceProc *proc, void *clientData); +/* Slot 255 is reserved */ /* 256 */ EXTERN void Tcl_UntraceVar2(Tcl_Interp *interp, const char *part1, const char *part2, @@ -810,23 +702,14 @@ EXTERN void Tcl_UntraceVar2(Tcl_Interp *interp, /* 257 */ EXTERN void Tcl_UpdateLinkedVar(Tcl_Interp *interp, const char *varName); -/* 258 */ -TCL_DEPRECATED("No longer in use, changed to macro") -int Tcl_UpVar(Tcl_Interp *interp, const char *frameName, - const char *varName, const char *localName, - int flags); +/* Slot 258 is reserved */ /* 259 */ EXTERN int Tcl_UpVar2(Tcl_Interp *interp, const char *frameName, const char *part1, const char *part2, const char *localName, int flags); /* 260 */ EXTERN int Tcl_VarEval(Tcl_Interp *interp, ...); -/* 261 */ -TCL_DEPRECATED("No longer in use, changed to macro") -void * Tcl_VarTraceInfo(Tcl_Interp *interp, - const char *varName, int flags, - Tcl_VarTraceProc *procPtr, - void *prevClientData); +/* Slot 261 is reserved */ /* 262 */ EXTERN void * Tcl_VarTraceInfo2(Tcl_Interp *interp, const char *part1, const char *part2, @@ -842,47 +725,25 @@ EXTERN void Tcl_WrongNumArgs(Tcl_Interp *interp, Tcl_Size objc, EXTERN int Tcl_DumpActiveMemory(const char *fileName); /* 266 */ EXTERN void Tcl_ValidateAllMemory(const char *file, int line); -/* 267 */ -TCL_DEPRECATED("see TIP #422") -void Tcl_AppendResultVA(Tcl_Interp *interp, - va_list argList); -/* 268 */ -TCL_DEPRECATED("see TIP #422") -void Tcl_AppendStringsToObjVA(Tcl_Obj *objPtr, - va_list argList); +/* Slot 267 is reserved */ +/* Slot 268 is reserved */ /* 269 */ EXTERN char * Tcl_HashStats(Tcl_HashTable *tablePtr); /* 270 */ EXTERN const char * Tcl_ParseVar(Tcl_Interp *interp, const char *start, const char **termPtr); -/* 271 */ -TCL_DEPRECATED("No longer in use, changed to macro") -const char * Tcl_PkgPresent(Tcl_Interp *interp, const char *name, - const char *version, int exact); +/* Slot 271 is reserved */ /* 272 */ EXTERN const char * Tcl_PkgPresentEx(Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); -/* 273 */ -TCL_DEPRECATED("No longer in use, changed to macro") -int Tcl_PkgProvide(Tcl_Interp *interp, const char *name, - const char *version); -/* 274 */ -TCL_DEPRECATED("No longer in use, changed to macro") -const char * Tcl_PkgRequire(Tcl_Interp *interp, const char *name, - const char *version, int exact); -/* 275 */ -TCL_DEPRECATED("see TIP #422") -void Tcl_SetErrorCodeVA(Tcl_Interp *interp, - va_list argList); -/* 276 */ -TCL_DEPRECATED("see TIP #422") -int Tcl_VarEvalVA(Tcl_Interp *interp, va_list argList); +/* Slot 273 is reserved */ +/* Slot 274 is reserved */ +/* Slot 275 is reserved */ +/* Slot 276 is reserved */ /* 277 */ EXTERN Tcl_Pid Tcl_WaitPid(Tcl_Pid pid, int *statPtr, int options); -/* 278 */ -TCL_DEPRECATED("see TIP #422") -TCL_NORETURN void Tcl_PanicVA(const char *format, va_list argList); +/* Slot 278 is reserved */ /* 279 */ EXTERN void Tcl_GetVersion(int *major, int *minor, int *patchLevel, int *type); @@ -912,9 +773,7 @@ EXTERN void Tcl_CreateThreadExitHandler(Tcl_ExitProc *proc, /* 289 */ EXTERN void Tcl_DeleteThreadExitHandler(Tcl_ExitProc *proc, void *clientData); -/* 290 */ -TCL_DEPRECATED("Use Tcl_DiscardInterpState") -void Tcl_DiscardResult(Tcl_SavedResult *statePtr); +/* Slot 290 is reserved */ /* 291 */ EXTERN int Tcl_EvalEx(Tcl_Interp *interp, const char *script, Tcl_Size numBytes, int flags); @@ -974,18 +833,12 @@ EXTERN void Tcl_ConditionNotify(Tcl_Condition *condPtr); EXTERN void Tcl_ConditionWait(Tcl_Condition *condPtr, Tcl_Mutex *mutexPtr, const Tcl_Time *timePtr); /* 312 */ -EXTERN Tcl_Size Tcl_NumUtfChars(const char *src, Tcl_Size length); +EXTERN Tcl_Size TclNumUtfChars(const char *src, Tcl_Size length); /* 313 */ EXTERN Tcl_Size Tcl_ReadChars(Tcl_Channel channel, Tcl_Obj *objPtr, Tcl_Size charsToRead, int appendFlag); -/* 314 */ -TCL_DEPRECATED("Use Tcl_RestoreInterpState") -void Tcl_RestoreResult(Tcl_Interp *interp, - Tcl_SavedResult *statePtr); -/* 315 */ -TCL_DEPRECATED("Use Tcl_SaveInterpState") -void Tcl_SaveResult(Tcl_Interp *interp, - Tcl_SavedResult *statePtr); +/* Slot 314 is reserved */ +/* Slot 315 is reserved */ /* 316 */ EXTERN int Tcl_SetSystemEncoding(Tcl_Interp *interp, const char *name); @@ -1007,9 +860,9 @@ EXTERN int Tcl_UniCharToTitle(int ch); /* 323 */ EXTERN int Tcl_UniCharToUpper(int ch); /* 324 */ -EXTERN int Tcl_UniCharToUtf(int ch, char *buf); +EXTERN Tcl_Size Tcl_UniCharToUtf(int ch, char *buf); /* 325 */ -EXTERN const char * Tcl_UtfAtIndex(const char *src, Tcl_Size index); +EXTERN const char * TclUtfAtIndex(const char *src, Tcl_Size index); /* 326 */ EXTERN int TclUtfCharComplete(const char *src, Tcl_Size length); /* 327 */ @@ -1035,14 +888,14 @@ EXTERN char * Tcl_UtfToExternalDString(Tcl_Encoding encoding, const char *src, Tcl_Size srcLen, Tcl_DString *dsPtr); /* 334 */ -EXTERN int Tcl_UtfToLower(char *src); +EXTERN Tcl_Size Tcl_UtfToLower(char *src); /* 335 */ -EXTERN int Tcl_UtfToTitle(char *src); +EXTERN Tcl_Size Tcl_UtfToTitle(char *src); /* 336 */ -EXTERN int Tcl_UtfToChar16(const char *src, +EXTERN Tcl_Size Tcl_UtfToChar16(const char *src, unsigned short *chPtr); /* 337 */ -EXTERN int Tcl_UtfToUpper(char *src); +EXTERN Tcl_Size Tcl_UtfToUpper(char *src); /* 338 */ EXTERN Tcl_Size Tcl_WriteChars(Tcl_Channel chan, const char *src, Tcl_Size srcLen); @@ -1050,12 +903,8 @@ EXTERN Tcl_Size Tcl_WriteChars(Tcl_Channel chan, const char *src, EXTERN Tcl_Size Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr); /* 340 */ EXTERN char * Tcl_GetString(Tcl_Obj *objPtr); -/* 341 */ -TCL_DEPRECATED("Use Tcl_GetEncodingSearchPath") -const char * Tcl_GetDefaultEncodingDir(void); -/* 342 */ -TCL_DEPRECATED("Use Tcl_SetEncodingSearchPath") -void Tcl_SetDefaultEncodingDir(const char *path); +/* Slot 341 is reserved */ +/* Slot 342 is reserved */ /* 343 */ EXTERN void Tcl_AlertNotifier(void *clientData); /* 344 */ @@ -1076,11 +925,7 @@ EXTERN int Tcl_UniCharIsUpper(int ch); EXTERN int Tcl_UniCharIsWordChar(int ch); /* 352 */ EXTERN Tcl_Size Tcl_Char16Len(const unsigned short *uniStr); -/* 353 */ -TCL_DEPRECATED("Use Tcl_UtfNcmp") -int Tcl_UniCharNcmp(const unsigned short *ucs, - const unsigned short *uct, - unsigned long numChars); +/* Slot 353 is reserved */ /* 354 */ EXTERN char * Tcl_Char16ToUtfDString(const unsigned short *uniStr, Tcl_Size uniLength, Tcl_DString *dsPtr); @@ -1090,10 +935,7 @@ EXTERN unsigned short * Tcl_UtfToChar16DString(const char *src, /* 356 */ EXTERN Tcl_RegExp Tcl_GetRegExpFromObj(Tcl_Interp *interp, Tcl_Obj *patObj, int flags); -/* 357 */ -TCL_DEPRECATED("Use Tcl_EvalTokensStandard") -Tcl_Obj * Tcl_EvalTokens(Tcl_Interp *interp, - Tcl_Token *tokenPtr, int count); +/* Slot 357 is reserved */ /* 358 */ EXTERN void Tcl_FreeParse(Tcl_Parse *parsePtr); /* 359 */ @@ -1130,11 +972,10 @@ EXTERN int Tcl_Access(const char *path, int mode); /* 368 */ EXTERN int Tcl_Stat(const char *path, struct stat *bufPtr); /* 369 */ -EXTERN int Tcl_UtfNcmp(const char *s1, const char *s2, - unsigned long n); +EXTERN int Tcl_UtfNcmp(const char *s1, const char *s2, size_t n); /* 370 */ EXTERN int Tcl_UtfNcasecmp(const char *s1, const char *s2, - unsigned long n); + size_t n); /* 371 */ EXTERN int Tcl_StringCaseMatch(const char *str, const char *pattern, int nocase); @@ -1155,26 +996,23 @@ EXTERN int Tcl_RegExpExecObj(Tcl_Interp *interp, EXTERN void Tcl_RegExpGetInfo(Tcl_RegExp regexp, Tcl_RegExpInfo *infoPtr); /* 378 */ -EXTERN Tcl_Obj * Tcl_NewUnicodeObj(const unsigned short *unicode, +EXTERN Tcl_Obj * Tcl_NewUnicodeObj(const Tcl_UniChar *unicode, Tcl_Size numChars); /* 379 */ EXTERN void Tcl_SetUnicodeObj(Tcl_Obj *objPtr, - const unsigned short *unicode, + const Tcl_UniChar *unicode, Tcl_Size numChars); /* 380 */ -EXTERN Tcl_Size Tcl_GetCharLength(Tcl_Obj *objPtr); +EXTERN Tcl_Size TclGetCharLength(Tcl_Obj *objPtr); /* 381 */ -EXTERN int Tcl_GetUniChar(Tcl_Obj *objPtr, Tcl_Size index); -/* 382 */ -TCL_DEPRECATED("No longer in use, changed to macro") -unsigned short * Tcl_GetUnicode(Tcl_Obj *objPtr); +EXTERN int TclGetUniChar(Tcl_Obj *objPtr, Tcl_Size index); +/* Slot 382 is reserved */ /* 383 */ -EXTERN Tcl_Obj * Tcl_GetRange(Tcl_Obj *objPtr, Tcl_Size first, +EXTERN Tcl_Obj * TclGetRange(Tcl_Obj *objPtr, Tcl_Size first, Tcl_Size last); /* 384 */ EXTERN void Tcl_AppendUnicodeToObj(Tcl_Obj *objPtr, - const unsigned short *unicode, - Tcl_Size length); + const Tcl_UniChar *unicode, Tcl_Size length); /* 385 */ EXTERN int Tcl_RegExpMatchObj(Tcl_Interp *interp, Tcl_Obj *textObj, Tcl_Obj *patternObj); @@ -1217,10 +1055,7 @@ EXTERN Tcl_ChannelTypeVersion Tcl_ChannelVersion( /* 400 */ EXTERN Tcl_DriverBlockModeProc * Tcl_ChannelBlockModeProc( const Tcl_ChannelType *chanTypePtr); -/* 401 */ -TCL_DEPRECATED("Use Tcl_ChannelClose2Proc") -Tcl_DriverCloseProc * Tcl_ChannelCloseProc( - const Tcl_ChannelType *chanTypePtr); +/* Slot 401 is reserved */ /* 402 */ EXTERN Tcl_DriverClose2Proc * Tcl_ChannelClose2Proc( const Tcl_ChannelType *chanTypePtr); @@ -1230,10 +1065,7 @@ EXTERN Tcl_DriverInputProc * Tcl_ChannelInputProc( /* 404 */ EXTERN Tcl_DriverOutputProc * Tcl_ChannelOutputProc( const Tcl_ChannelType *chanTypePtr); -/* 405 */ -TCL_DEPRECATED("Use Tcl_ChannelWideSeekProc") -Tcl_DriverSeekProc * Tcl_ChannelSeekProc( - const Tcl_ChannelType *chanTypePtr); +/* Slot 405 is reserved */ /* 406 */ EXTERN Tcl_DriverSetOptionProc * Tcl_ChannelSetOptionProc( const Tcl_ChannelType *chanTypePtr); @@ -1267,21 +1099,10 @@ EXTERN void Tcl_SpliceChannel(Tcl_Channel channel); EXTERN void Tcl_ClearChannelHandlers(Tcl_Channel channel); /* 418 */ EXTERN int Tcl_IsChannelExisting(const char *channelName); -/* 419 */ -TCL_DEPRECATED("Use Tcl_UtfNcasecmp") -int Tcl_UniCharNcasecmp(const unsigned short *ucs, - const unsigned short *uct, - unsigned long numChars); -/* 420 */ -TCL_DEPRECATED("Use Tcl_StringCaseMatch") -int Tcl_UniCharCaseMatch(const unsigned short *uniStr, - const unsigned short *uniPattern, int nocase); -/* 421 */ -EXTERN Tcl_HashEntry * Tcl_FindHashEntry(Tcl_HashTable *tablePtr, - const void *key); -/* 422 */ -EXTERN Tcl_HashEntry * Tcl_CreateHashEntry(Tcl_HashTable *tablePtr, - const void *key, int *newPtr); +/* Slot 419 is reserved */ +/* Slot 420 is reserved */ +/* Slot 421 is reserved */ +/* Slot 422 is reserved */ /* 423 */ EXTERN void Tcl_InitCustomHashTable(Tcl_HashTable *tablePtr, int keyType, const Tcl_HashKeyType *typePtr); @@ -1301,14 +1122,14 @@ EXTERN void Tcl_UntraceCommand(Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *proc, void *clientData); /* 428 */ -EXTERN char * Tcl_AttemptAlloc(TCL_HASH_TYPE size); +EXTERN void * Tcl_AttemptAlloc(TCL_HASH_TYPE size); /* 429 */ -EXTERN char * Tcl_AttemptDbCkalloc(TCL_HASH_TYPE size, +EXTERN void * Tcl_AttemptDbCkalloc(TCL_HASH_TYPE size, const char *file, int line); /* 430 */ -EXTERN char * Tcl_AttemptRealloc(char *ptr, TCL_HASH_TYPE size); +EXTERN void * Tcl_AttemptRealloc(void *ptr, TCL_HASH_TYPE size); /* 431 */ -EXTERN char * Tcl_AttemptDbCkrealloc(char *ptr, TCL_HASH_TYPE size, +EXTERN void * Tcl_AttemptDbCkrealloc(void *ptr, TCL_HASH_TYPE size, const char *file, int line); /* 432 */ EXTERN int Tcl_AttemptSetObjLength(Tcl_Obj *objPtr, @@ -1316,18 +1137,9 @@ EXTERN int Tcl_AttemptSetObjLength(Tcl_Obj *objPtr, /* 433 */ EXTERN Tcl_ThreadId Tcl_GetChannelThread(Tcl_Channel channel); /* 434 */ -EXTERN unsigned short * Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr, - int *lengthPtr); -/* 435 */ -TCL_DEPRECATED("") -int Tcl_GetMathFuncInfo(Tcl_Interp *interp, - const char *name, int *numArgsPtr, - Tcl_ValueType **argTypesPtr, - Tcl_MathProc **procPtr, void **clientDataPtr); -/* 436 */ -TCL_DEPRECATED("") -Tcl_Obj * Tcl_ListMathFuncs(Tcl_Interp *interp, - const char *pattern); +EXTERN Tcl_UniChar * TclGetUnicodeFromObj(Tcl_Obj *objPtr, int *lengthPtr); +/* Slot 435 is reserved */ +/* Slot 436 is reserved */ /* 437 */ EXTERN Tcl_Obj * Tcl_SubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); @@ -1377,7 +1189,7 @@ EXTERN int Tcl_FSFileAttrsGet(Tcl_Interp *interp, int index, EXTERN int Tcl_FSFileAttrsSet(Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj *objPtr); /* 453 */ -EXTERN const char *CONST86 * Tcl_FSFileAttrStrings(Tcl_Obj *pathPtr, +EXTERN const char *const * Tcl_FSFileAttrStrings(Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef); /* 454 */ EXTERN int Tcl_FSStat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf); @@ -1397,7 +1209,7 @@ EXTERN int Tcl_FSConvertToPathType(Tcl_Interp *interp, /* 460 */ EXTERN Tcl_Obj * Tcl_FSJoinPath(Tcl_Obj *listObj, Tcl_Size elements); /* 461 */ -EXTERN Tcl_Obj * Tcl_FSSplitPath(Tcl_Obj *pathPtr, int *lenPtr); +EXTERN Tcl_Obj * TclFSSplitPath(Tcl_Obj *pathPtr, int *lenPtr); /* 462 */ EXTERN int Tcl_FSEqualPaths(Tcl_Obj *firstPtr, Tcl_Obj *secondPtr); @@ -1438,7 +1250,7 @@ EXTERN void * Tcl_FSData(const Tcl_Filesystem *fsPtr); EXTERN const char * Tcl_FSGetTranslatedStringPath(Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 477 */ -EXTERN CONST86 Tcl_Filesystem * Tcl_FSGetFileSystemForPath(Tcl_Obj *pathPtr); +EXTERN const Tcl_Filesystem * Tcl_FSGetFileSystemForPath(Tcl_Obj *pathPtr); /* 478 */ EXTERN Tcl_PathType Tcl_FSGetPathType(Tcl_Obj *pathPtr); /* 479 */ @@ -1493,7 +1305,7 @@ EXTERN int Tcl_DictObjGet(Tcl_Interp *interp, Tcl_Obj *dictPtr, EXTERN int Tcl_DictObjRemove(Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr); /* 497 */ -EXTERN int Tcl_DictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr, +EXTERN int TclDictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr, int *sizePtr); /* 498 */ EXTERN int Tcl_DictObjFirst(Tcl_Interp *interp, @@ -1561,8 +1373,7 @@ EXTERN void Tcl_GetCommandFullName(Tcl_Interp *interp, /* 518 */ EXTERN int Tcl_FSEvalFileEx(Tcl_Interp *interp, Tcl_Obj *fileName, const char *encodingName); -/* 519 */ -EXTERN Tcl_ExitProc * Tcl_SetExitProc(TCL_NORETURN1 Tcl_ExitProc *proc); +/* Slot 519 is reserved */ /* 520 */ EXTERN void Tcl_LimitAddHandler(Tcl_Interp *interp, int type, Tcl_LimitHandlerProc *handlerProc, @@ -1800,7 +1611,7 @@ EXTERN int Tcl_SetEnsembleParameterList(Tcl_Interp *interp, EXTERN int Tcl_GetEnsembleParameterList(Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **paramListPtr); /* 604 */ -EXTERN int Tcl_ParseArgsObjv(Tcl_Interp *interp, +EXTERN int TclParseArgsObjv(Tcl_Interp *interp, const Tcl_ArgvInfo *argTable, int *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv); /* 605 */ @@ -1924,7 +1735,7 @@ EXTERN int Tcl_GetIntForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Size endValue, Tcl_Size *indexPtr); /* 646 */ -EXTERN int Tcl_UtfToUniChar(const char *src, int *chPtr); +EXTERN Tcl_Size Tcl_UtfToUniChar(const char *src, int *chPtr); /* 647 */ EXTERN char * Tcl_UniCharToUtfDString(const int *uniStr, Tcl_Size uniLength, Tcl_DString *dsPtr); @@ -1938,13 +1749,13 @@ EXTERN unsigned char * TclGetBytesFromObj(Tcl_Interp *interp, EXTERN unsigned char * Tcl_GetBytesFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, size_t *numBytesPtr); /* 651 */ -EXTERN char * TclGetStringFromObj(Tcl_Obj *objPtr, +EXTERN char * Tcl_GetStringFromObj(Tcl_Obj *objPtr, size_t *lengthPtr); /* 652 */ -EXTERN unsigned short * TclGetUnicodeFromObj(Tcl_Obj *objPtr, +EXTERN Tcl_UniChar * Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr, size_t *lengthPtr); /* 653 */ -EXTERN unsigned char * TclGetByteArrayFromObj(Tcl_Obj *objPtr, +EXTERN unsigned char * Tcl_GetByteArrayFromObj(Tcl_Obj *objPtr, size_t *numBytesPtr); /* 654 */ EXTERN int Tcl_UtfCharComplete(const char *src, Tcl_Size length); @@ -1966,41 +1777,42 @@ EXTERN Tcl_Size Tcl_UtfToExternalDStringEx(Tcl_Encoding encoding, EXTERN int Tcl_AsyncMarkFromSignal(Tcl_AsyncHandler async, int sigNumber); /* 661 */ -EXTERN int TclListObjGetElements(Tcl_Interp *interp, +EXTERN int Tcl_ListObjGetElements(Tcl_Interp *interp, Tcl_Obj *listPtr, size_t *objcPtr, Tcl_Obj ***objvPtr); /* 662 */ -EXTERN int TclListObjLength(Tcl_Interp *interp, +EXTERN int Tcl_ListObjLength(Tcl_Interp *interp, Tcl_Obj *listPtr, size_t *lengthPtr); /* 663 */ -EXTERN int TclDictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr, +EXTERN int Tcl_DictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr, size_t *sizePtr); /* 664 */ -EXTERN int TclSplitList(Tcl_Interp *interp, const char *listStr, - size_t *argcPtr, const char ***argvPtr); +EXTERN int Tcl_SplitList(Tcl_Interp *interp, + const char *listStr, size_t *argcPtr, + const char ***argvPtr); /* 665 */ -EXTERN void TclSplitPath(const char *path, size_t *argcPtr, +EXTERN void Tcl_SplitPath(const char *path, size_t *argcPtr, const char ***argvPtr); /* 666 */ -EXTERN Tcl_Obj * TclFSSplitPath(Tcl_Obj *pathPtr, size_t *lenPtr); +EXTERN Tcl_Obj * Tcl_FSSplitPath(Tcl_Obj *pathPtr, size_t *lenPtr); /* 667 */ -EXTERN int TclParseArgsObjv(Tcl_Interp *interp, +EXTERN int Tcl_ParseArgsObjv(Tcl_Interp *interp, const Tcl_ArgvInfo *argTable, size_t *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv); /* 668 */ EXTERN Tcl_Size Tcl_UniCharLen(const int *uniStr); /* 669 */ -EXTERN Tcl_Size TclNumUtfChars(const char *src, Tcl_Size length); +EXTERN Tcl_Size Tcl_NumUtfChars(const char *src, Tcl_Size length); /* 670 */ -EXTERN Tcl_Size TclGetCharLength(Tcl_Obj *objPtr); +EXTERN Tcl_Size Tcl_GetCharLength(Tcl_Obj *objPtr); /* 671 */ -EXTERN const char * TclUtfAtIndex(const char *src, Tcl_Size index); +EXTERN const char * Tcl_UtfAtIndex(const char *src, Tcl_Size index); /* 672 */ -EXTERN Tcl_Obj * TclGetRange(Tcl_Obj *objPtr, Tcl_Size first, +EXTERN Tcl_Obj * Tcl_GetRange(Tcl_Obj *objPtr, Tcl_Size first, Tcl_Size last); /* 673 */ -EXTERN int TclGetUniChar(Tcl_Obj *objPtr, Tcl_Size index); +EXTERN int Tcl_GetUniChar(Tcl_Obj *objPtr, Tcl_Size index); /* 674 */ EXTERN int Tcl_GetBool(Tcl_Interp *interp, const char *src, int flags, char *charPtr); @@ -2062,30 +1874,14 @@ typedef struct TclStubs { int (*tcl_PkgProvideEx) (Tcl_Interp *interp, const char *name, const char *version, const void *clientData); /* 0 */ const char * (*tcl_PkgRequireEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 1 */ TCL_NORETURN1 void (*tcl_Panic) (const char *format, ...) TCL_FORMAT_PRINTF(1, 2); /* 2 */ - char * (*tcl_Alloc) (TCL_HASH_TYPE size); /* 3 */ - void (*tcl_Free) (char *ptr); /* 4 */ - char * (*tcl_Realloc) (char *ptr, TCL_HASH_TYPE size); /* 5 */ - char * (*tcl_DbCkalloc) (TCL_HASH_TYPE size, const char *file, int line); /* 6 */ - void (*tcl_DbCkfree) (char *ptr, const char *file, int line); /* 7 */ - char * (*tcl_DbCkrealloc) (char *ptr, TCL_HASH_TYPE size, const char *file, int line); /* 8 */ -#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */ + void * (*tcl_Alloc) (TCL_HASH_TYPE size); /* 3 */ + void (*tcl_Free) (void *ptr); /* 4 */ + void * (*tcl_Realloc) (void *ptr, TCL_HASH_TYPE size); /* 5 */ + void * (*tcl_DbCkalloc) (TCL_HASH_TYPE size, const char *file, int line); /* 6 */ + void (*tcl_DbCkfree) (void *ptr, const char *file, int line); /* 7 */ + void * (*tcl_DbCkrealloc) (void *ptr, TCL_HASH_TYPE size, const char *file, int line); /* 8 */ void (*tcl_CreateFileHandler) (int fd, int mask, Tcl_FileProc *proc, void *clientData); /* 9 */ -#endif /* UNIX */ -#if defined(_WIN32) /* WIN */ - void (*reserved9)(void); -#endif /* WIN */ -#ifdef MAC_OSX_TCL /* MACOSX */ - void (*tcl_CreateFileHandler) (int fd, int mask, Tcl_FileProc *proc, void *clientData); /* 9 */ -#endif /* MACOSX */ -#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */ - void (*tcl_DeleteFileHandler) (int fd); /* 10 */ -#endif /* UNIX */ -#if defined(_WIN32) /* WIN */ - void (*reserved10)(void); -#endif /* WIN */ -#ifdef MAC_OSX_TCL /* MACOSX */ void (*tcl_DeleteFileHandler) (int fd); /* 10 */ -#endif /* MACOSX */ void (*tcl_SetTimer) (const Tcl_Time *timePtr); /* 11 */ void (*tcl_Sleep) (int ms); /* 12 */ int (*tcl_WaitForEvent) (const Tcl_Time *timePtr); /* 13 */ @@ -2097,52 +1893,52 @@ typedef struct TclStubs { void (*tcl_DbDecrRefCount) (Tcl_Obj *objPtr, const char *file, int line); /* 19 */ void (*tcl_DbIncrRefCount) (Tcl_Obj *objPtr, const char *file, int line); /* 20 */ int (*tcl_DbIsShared) (Tcl_Obj *objPtr, const char *file, int line); /* 21 */ - TCL_DEPRECATED_API("No longer in use, changed to macro") Tcl_Obj * (*tcl_DbNewBooleanObj) (int intValue, const char *file, int line); /* 22 */ + void (*reserved22)(void); Tcl_Obj * (*tcl_DbNewByteArrayObj) (const unsigned char *bytes, Tcl_Size numBytes, const char *file, int line); /* 23 */ Tcl_Obj * (*tcl_DbNewDoubleObj) (double doubleValue, const char *file, int line); /* 24 */ Tcl_Obj * (*tcl_DbNewListObj) (Tcl_Size objc, Tcl_Obj *const *objv, const char *file, int line); /* 25 */ - TCL_DEPRECATED_API("No longer in use, changed to macro") Tcl_Obj * (*tcl_DbNewLongObj) (long longValue, const char *file, int line); /* 26 */ + void (*reserved26)(void); Tcl_Obj * (*tcl_DbNewObj) (const char *file, int line); /* 27 */ Tcl_Obj * (*tcl_DbNewStringObj) (const char *bytes, Tcl_Size length, const char *file, int line); /* 28 */ Tcl_Obj * (*tcl_DuplicateObj) (Tcl_Obj *objPtr); /* 29 */ 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 * (*tcl_GetByteArrayFromObj) (Tcl_Obj *objPtr, int *numBytesPtr); /* 33 */ + unsigned char * (*tclGetByteArrayFromObj) (Tcl_Obj *objPtr, int *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 */ - TCL_DEPRECATED_API("No longer in use, changed to macro") int (*tcl_GetIndexFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, const char *const *tablePtr, const char *msg, int flags, int *indexPtr); /* 36 */ + void (*reserved36)(void); int (*tcl_GetInt) (Tcl_Interp *interp, const char *src, int *intPtr); /* 37 */ int (*tcl_GetIntFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr); /* 38 */ int (*tcl_GetLongFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr); /* 39 */ - CONST86 Tcl_ObjType * (*tcl_GetObjType) (const char *typeName); /* 40 */ - char * (*tcl_GetStringFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 41 */ + const Tcl_ObjType * (*tcl_GetObjType) (const char *typeName); /* 40 */ + char * (*tclGetStringFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 41 */ void (*tcl_InvalidateStringRep) (Tcl_Obj *objPtr); /* 42 */ int (*tcl_ListObjAppendList) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *elemListPtr); /* 43 */ int (*tcl_ListObjAppendElement) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *objPtr); /* 44 */ - int (*tcl_ListObjGetElements) (Tcl_Interp *interp, Tcl_Obj *listPtr, int *objcPtr, Tcl_Obj ***objvPtr); /* 45 */ + int (*tclListObjGetElements) (Tcl_Interp *interp, Tcl_Obj *listPtr, int *objcPtr, Tcl_Obj ***objvPtr); /* 45 */ int (*tcl_ListObjIndex) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size index, Tcl_Obj **objPtrPtr); /* 46 */ - int (*tcl_ListObjLength) (Tcl_Interp *interp, Tcl_Obj *listPtr, int *lengthPtr); /* 47 */ + int (*tclListObjLength) (Tcl_Interp *interp, Tcl_Obj *listPtr, int *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 */ - TCL_DEPRECATED_API("No longer in use, changed to macro") Tcl_Obj * (*tcl_NewBooleanObj) (int intValue); /* 49 */ + void (*reserved49)(void); Tcl_Obj * (*tcl_NewByteArrayObj) (const unsigned char *bytes, Tcl_Size numBytes); /* 50 */ Tcl_Obj * (*tcl_NewDoubleObj) (double doubleValue); /* 51 */ - TCL_DEPRECATED_API("No longer in use, changed to macro") Tcl_Obj * (*tcl_NewIntObj) (int intValue); /* 52 */ + void (*reserved52)(void); Tcl_Obj * (*tcl_NewListObj) (Tcl_Size objc, Tcl_Obj *const objv[]); /* 53 */ - TCL_DEPRECATED_API("No longer in use, changed to macro") Tcl_Obj * (*tcl_NewLongObj) (long longValue); /* 54 */ + void (*reserved54)(void); Tcl_Obj * (*tcl_NewObj) (void); /* 55 */ Tcl_Obj * (*tcl_NewStringObj) (const char *bytes, Tcl_Size length); /* 56 */ - TCL_DEPRECATED_API("No longer in use, changed to macro") void (*tcl_SetBooleanObj) (Tcl_Obj *objPtr, int intValue); /* 57 */ + void (*reserved57)(void); unsigned char * (*tcl_SetByteArrayLength) (Tcl_Obj *objPtr, Tcl_Size numBytes); /* 58 */ void (*tcl_SetByteArrayObj) (Tcl_Obj *objPtr, const unsigned char *bytes, Tcl_Size numBytes); /* 59 */ void (*tcl_SetDoubleObj) (Tcl_Obj *objPtr, double doubleValue); /* 60 */ - TCL_DEPRECATED_API("No longer in use, changed to macro") void (*tcl_SetIntObj) (Tcl_Obj *objPtr, int intValue); /* 61 */ + void (*reserved61)(void); void (*tcl_SetListObj) (Tcl_Obj *objPtr, Tcl_Size objc, Tcl_Obj *const objv[]); /* 62 */ - TCL_DEPRECATED_API("No longer in use, changed to macro") void (*tcl_SetLongObj) (Tcl_Obj *objPtr, long longValue); /* 63 */ + void (*reserved63)(void); void (*tcl_SetObjLength) (Tcl_Obj *objPtr, Tcl_Size length); /* 64 */ void (*tcl_SetStringObj) (Tcl_Obj *objPtr, const char *bytes, Tcl_Size length); /* 65 */ - TCL_DEPRECATED_API("No longer in use, changed to macro") void (*tcl_AddErrorInfo) (Tcl_Interp *interp, const char *message); /* 66 */ - TCL_DEPRECATED_API("No longer in use, changed to macro") void (*tcl_AddObjErrorInfo) (Tcl_Interp *interp, const char *message, int length); /* 67 */ + void (*reserved66)(void); + void (*reserved67)(void); void (*tcl_AllowExceptions) (Tcl_Interp *interp); /* 68 */ void (*tcl_AppendElement) (Tcl_Interp *interp, const char *element); /* 69 */ void (*tcl_AppendResult) (Tcl_Interp *interp, ...); /* 70 */ @@ -2151,8 +1947,8 @@ typedef struct TclStubs { int (*tcl_AsyncInvoke) (Tcl_Interp *interp, int code); /* 73 */ void (*tcl_AsyncMark) (Tcl_AsyncHandler async); /* 74 */ int (*tcl_AsyncReady) (void); /* 75 */ - TCL_DEPRECATED_API("No longer in use, changed to macro") void (*tcl_BackgroundError) (Tcl_Interp *interp); /* 76 */ - TCL_DEPRECATED_API("Use Tcl_UtfBackslash") char (*tcl_Backslash) (const char *src, int *readPtr); /* 77 */ + void (*reserved76)(void); + void (*reserved77)(void); int (*tcl_BadChannelOption) (Tcl_Interp *interp, const char *optionName, const char *optionList); /* 78 */ void (*tcl_CallWhenDeleted) (Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, void *clientData); /* 79 */ void (*tcl_CancelIdleCall) (Tcl_IdleProc *idleProc, void *clientData); /* 80 */ @@ -2170,7 +1966,7 @@ typedef struct TclStubs { void (*tcl_CreateEventSource) (Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, void *clientData); /* 92 */ void (*tcl_CreateExitHandler) (Tcl_ExitProc *proc, void *clientData); /* 93 */ Tcl_Interp * (*tcl_CreateInterp) (void); /* 94 */ - TCL_DEPRECATED_API("") void (*tcl_CreateMathFunc) (Tcl_Interp *interp, const char *name, int numArgs, Tcl_ValueType *argTypes, Tcl_MathProc *proc, void *clientData); /* 95 */ + void (*reserved95)(void); Tcl_Command (*tcl_CreateObjCommand) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc *proc, void *clientData, Tcl_CmdDeleteProc *deleteProc); /* 96 */ Tcl_Interp * (*tcl_CreateChild) (Tcl_Interp *interp, const char *name, int isSafe); /* 97 */ Tcl_TimerToken (*tcl_CreateTimerHandler) (int milliseconds, Tcl_TimerProc *proc, void *clientData); /* 98 */ @@ -2204,9 +2000,9 @@ typedef struct TclStubs { int (*tcl_Eof) (Tcl_Channel chan); /* 126 */ const char * (*tcl_ErrnoId) (void); /* 127 */ const char * (*tcl_ErrnoMsg) (int err); /* 128 */ - int (*tcl_Eval) (Tcl_Interp *interp, const char *script); /* 129 */ + void (*reserved129)(void); int (*tcl_EvalFile) (Tcl_Interp *interp, const char *fileName); /* 130 */ - TCL_DEPRECATED_API("No longer in use, changed to macro") int (*tcl_EvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 131 */ + void (*reserved131)(void); void (*tcl_EventuallyFree) (void *clientData, Tcl_FreeProc *freeProc); /* 132 */ TCL_NORETURN1 void (*tcl_Exit) (int status); /* 133 */ int (*tcl_ExposeCommand) (Tcl_Interp *interp, const char *hiddenCmdToken, const char *cmdName); /* 134 */ @@ -2219,10 +2015,10 @@ typedef struct TclStubs { int (*tcl_ExprObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj **resultPtrPtr); /* 141 */ int (*tcl_ExprString) (Tcl_Interp *interp, const char *expr); /* 142 */ void (*tcl_Finalize) (void); /* 143 */ - TCL_DEPRECATED_API("Don't use this function in a stub-enabled extension") const char * (*tcl_FindExecutable) (const char *argv0); /* 144 */ + void (*reserved144)(void); Tcl_HashEntry * (*tcl_FirstHashEntry) (Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr); /* 145 */ int (*tcl_Flush) (Tcl_Channel chan); /* 146 */ - TCL_DEPRECATED_API("see TIP #559. Use Tcl_ResetResult") void (*tcl_FreeResult) (Tcl_Interp *interp); /* 147 */ + void (*reserved147)(void); int (*tcl_GetAlias) (Tcl_Interp *interp, const char *childCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, int *argcPtr, const char ***argvPtr); /* 148 */ int (*tcl_GetAliasObj) (Tcl_Interp *interp, const char *childCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, int *objcPtr, Tcl_Obj ***objv); /* 149 */ void * (*tcl_GetAssocData) (Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc **procPtr); /* 150 */ @@ -2233,7 +2029,7 @@ typedef struct TclStubs { int (*tcl_GetChannelMode) (Tcl_Channel chan); /* 155 */ const char * (*tcl_GetChannelName) (Tcl_Channel chan); /* 156 */ int (*tcl_GetChannelOption) (Tcl_Interp *interp, Tcl_Channel chan, const char *optionName, Tcl_DString *dsPtr); /* 157 */ - CONST86 Tcl_ChannelType * (*tcl_GetChannelType) (Tcl_Channel chan); /* 158 */ + const Tcl_ChannelType * (*tcl_GetChannelType) (Tcl_Channel chan); /* 158 */ int (*tcl_GetCommandInfo) (Tcl_Interp *interp, const char *cmdName, Tcl_CmdInfo *infoPtr); /* 159 */ const char * (*tcl_GetCommandName) (Tcl_Interp *interp, Tcl_Command command); /* 160 */ int (*tcl_GetErrno) (void); /* 161 */ @@ -2242,26 +2038,18 @@ typedef struct TclStubs { Tcl_Interp * (*tcl_GetParent) (Tcl_Interp *interp); /* 164 */ const char * (*tcl_GetNameOfExecutable) (void); /* 165 */ Tcl_Obj * (*tcl_GetObjResult) (Tcl_Interp *interp); /* 166 */ -#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */ - int (*tcl_GetOpenFile) (Tcl_Interp *interp, const char *chanID, int forWriting, int checkUsage, void **filePtr); /* 167 */ -#endif /* UNIX */ -#if defined(_WIN32) /* WIN */ - void (*reserved167)(void); -#endif /* WIN */ -#ifdef MAC_OSX_TCL /* MACOSX */ int (*tcl_GetOpenFile) (Tcl_Interp *interp, const char *chanID, int forWriting, int checkUsage, void **filePtr); /* 167 */ -#endif /* MACOSX */ Tcl_PathType (*tcl_GetPathType) (const char *path); /* 168 */ Tcl_Size (*tcl_Gets) (Tcl_Channel chan, Tcl_DString *dsPtr); /* 169 */ Tcl_Size (*tcl_GetsObj) (Tcl_Channel chan, Tcl_Obj *objPtr); /* 170 */ int (*tcl_GetServiceMode) (void); /* 171 */ Tcl_Interp * (*tcl_GetChild) (Tcl_Interp *interp, const char *name); /* 172 */ Tcl_Channel (*tcl_GetStdChannel) (int type); /* 173 */ - const char * (*tcl_GetStringResult) (Tcl_Interp *interp); /* 174 */ - TCL_DEPRECATED_API("No longer in use, changed to macro") const char * (*tcl_GetVar) (Tcl_Interp *interp, const char *varName, int flags); /* 175 */ + void (*reserved174)(void); + void (*reserved175)(void); const char * (*tcl_GetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 176 */ - int (*tcl_GlobalEval) (Tcl_Interp *interp, const char *command); /* 177 */ - TCL_DEPRECATED_API("No longer in use, changed to macro") int (*tcl_GlobalEvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 178 */ + void (*reserved177)(void); + void (*reserved178)(void); int (*tcl_HideCommand) (Tcl_Interp *interp, const char *cmdName, const char *hiddenCmdToken); /* 179 */ int (*tcl_Init) (Tcl_Interp *interp); /* 180 */ void (*tcl_InitHashTable) (Tcl_HashTable *tablePtr, int keyType); /* 181 */ @@ -2273,7 +2061,7 @@ typedef struct TclStubs { int (*tcl_LinkVar) (Tcl_Interp *interp, const char *varName, void *addr, int type); /* 187 */ void (*reserved188)(void); Tcl_Channel (*tcl_MakeFileChannel) (void *handle, int mode); /* 189 */ - TCL_DEPRECATED_API("") int (*tcl_MakeSafe) (Tcl_Interp *interp); /* 190 */ + void (*reserved190)(void); Tcl_Channel (*tcl_MakeTcpClientChannel) (void *tcpSocket); /* 191 */ char * (*tcl_Merge) (Tcl_Size argc, const char *const *argv); /* 192 */ Tcl_HashEntry * (*tcl_NextHashEntry) (Tcl_HashSearch *searchPtr); /* 193 */ @@ -2303,7 +2091,7 @@ typedef struct TclStubs { void (*tcl_ResetResult) (Tcl_Interp *interp); /* 217 */ Tcl_Size (*tcl_ScanElement) (const char *src, int *flagPtr); /* 218 */ Tcl_Size (*tcl_ScanCountedElement) (const char *src, Tcl_Size length, int *flagPtr); /* 219 */ - TCL_DEPRECATED_API("") int (*tcl_SeekOld) (Tcl_Channel chan, int offset, int mode); /* 220 */ + void (*reserved220)(void); int (*tcl_ServiceAll) (void); /* 221 */ int (*tcl_ServiceEvent) (int flags); /* 222 */ void (*tcl_SetAssocData) (Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc *proc, void *clientData); /* 223 */ @@ -2313,55 +2101,55 @@ typedef struct TclStubs { void (*tcl_SetErrno) (int err); /* 227 */ void (*tcl_SetErrorCode) (Tcl_Interp *interp, ...); /* 228 */ void (*tcl_SetMaxBlockTime) (const Tcl_Time *timePtr); /* 229 */ - TCL_DEPRECATED_API("Don't use this function in a stub-enabled extension") const char * (*tcl_SetPanicProc) (TCL_NORETURN1 Tcl_PanicProc *panicProc); /* 230 */ + void (*reserved230)(void); Tcl_Size (*tcl_SetRecursionLimit) (Tcl_Interp *interp, Tcl_Size depth); /* 231 */ - void (*tcl_SetResult) (Tcl_Interp *interp, char *result, Tcl_FreeProc *freeProc); /* 232 */ + void (*reserved232)(void); int (*tcl_SetServiceMode) (int mode); /* 233 */ void (*tcl_SetObjErrorCode) (Tcl_Interp *interp, Tcl_Obj *errorObjPtr); /* 234 */ void (*tcl_SetObjResult) (Tcl_Interp *interp, Tcl_Obj *resultObjPtr); /* 235 */ void (*tcl_SetStdChannel) (Tcl_Channel channel, int type); /* 236 */ - TCL_DEPRECATED_API("No longer in use, changed to macro") const char * (*tcl_SetVar) (Tcl_Interp *interp, const char *varName, const char *newValue, int flags); /* 237 */ + void (*reserved237)(void); const char * (*tcl_SetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, const char *newValue, int flags); /* 238 */ const char * (*tcl_SignalId) (int sig); /* 239 */ const char * (*tcl_SignalMsg) (int sig); /* 240 */ void (*tcl_SourceRCFile) (Tcl_Interp *interp); /* 241 */ - int (*tcl_SplitList) (Tcl_Interp *interp, const char *listStr, int *argcPtr, const char ***argvPtr); /* 242 */ - void (*tcl_SplitPath) (const char *path, int *argcPtr, const char ***argvPtr); /* 243 */ - TCL_DEPRECATED_API("Don't use this function in a stub-enabled extension") void (*tcl_StaticLibrary) (Tcl_Interp *interp, const char *prefix, Tcl_LibraryInitProc *initProc, Tcl_LibraryInitProc *safeInitProc); /* 244 */ - TCL_DEPRECATED_API("No longer in use, changed to macro") int (*tcl_StringMatch) (const char *str, const char *pattern); /* 245 */ - TCL_DEPRECATED_API("") int (*tcl_TellOld) (Tcl_Channel chan); /* 246 */ - TCL_DEPRECATED_API("No longer in use, changed to macro") int (*tcl_TraceVar) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *proc, void *clientData); /* 247 */ + 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 */ + void (*reserved244)(void); + void (*reserved245)(void); + void (*reserved246)(void); + void (*reserved247)(void); int (*tcl_TraceVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, void *clientData); /* 248 */ char * (*tcl_TranslateFileName) (Tcl_Interp *interp, const char *name, Tcl_DString *bufferPtr); /* 249 */ Tcl_Size (*tcl_Ungets) (Tcl_Channel chan, const char *str, Tcl_Size len, int atHead); /* 250 */ void (*tcl_UnlinkVar) (Tcl_Interp *interp, const char *varName); /* 251 */ int (*tcl_UnregisterChannel) (Tcl_Interp *interp, Tcl_Channel chan); /* 252 */ - TCL_DEPRECATED_API("No longer in use, changed to macro") int (*tcl_UnsetVar) (Tcl_Interp *interp, const char *varName, int flags); /* 253 */ + void (*reserved253)(void); int (*tcl_UnsetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 254 */ - TCL_DEPRECATED_API("No longer in use, changed to macro") void (*tcl_UntraceVar) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *proc, void *clientData); /* 255 */ + void (*reserved255)(void); void (*tcl_UntraceVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, void *clientData); /* 256 */ void (*tcl_UpdateLinkedVar) (Tcl_Interp *interp, const char *varName); /* 257 */ - TCL_DEPRECATED_API("No longer in use, changed to macro") int (*tcl_UpVar) (Tcl_Interp *interp, const char *frameName, const char *varName, const char *localName, int flags); /* 258 */ + void (*reserved258)(void); int (*tcl_UpVar2) (Tcl_Interp *interp, const char *frameName, const char *part1, const char *part2, const char *localName, int flags); /* 259 */ int (*tcl_VarEval) (Tcl_Interp *interp, ...); /* 260 */ - TCL_DEPRECATED_API("No longer in use, changed to macro") void * (*tcl_VarTraceInfo) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *procPtr, void *prevClientData); /* 261 */ + void (*reserved261)(void); void * (*tcl_VarTraceInfo2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *procPtr, void *prevClientData); /* 262 */ Tcl_Size (*tcl_Write) (Tcl_Channel chan, const char *s, Tcl_Size slen); /* 263 */ void (*tcl_WrongNumArgs) (Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const objv[], const char *message); /* 264 */ int (*tcl_DumpActiveMemory) (const char *fileName); /* 265 */ void (*tcl_ValidateAllMemory) (const char *file, int line); /* 266 */ - TCL_DEPRECATED_API("see TIP #422") void (*tcl_AppendResultVA) (Tcl_Interp *interp, va_list argList); /* 267 */ - TCL_DEPRECATED_API("see TIP #422") void (*tcl_AppendStringsToObjVA) (Tcl_Obj *objPtr, va_list argList); /* 268 */ + void (*reserved267)(void); + void (*reserved268)(void); char * (*tcl_HashStats) (Tcl_HashTable *tablePtr); /* 269 */ const char * (*tcl_ParseVar) (Tcl_Interp *interp, const char *start, const char **termPtr); /* 270 */ - TCL_DEPRECATED_API("No longer in use, changed to macro") const char * (*tcl_PkgPresent) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 271 */ + void (*reserved271)(void); const char * (*tcl_PkgPresentEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 272 */ - TCL_DEPRECATED_API("No longer in use, changed to macro") int (*tcl_PkgProvide) (Tcl_Interp *interp, const char *name, const char *version); /* 273 */ - TCL_DEPRECATED_API("No longer in use, changed to macro") const char * (*tcl_PkgRequire) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 274 */ - TCL_DEPRECATED_API("see TIP #422") void (*tcl_SetErrorCodeVA) (Tcl_Interp *interp, va_list argList); /* 275 */ - TCL_DEPRECATED_API("see TIP #422") int (*tcl_VarEvalVA) (Tcl_Interp *interp, va_list argList); /* 276 */ + void (*reserved273)(void); + void (*reserved274)(void); + void (*reserved275)(void); + void (*reserved276)(void); Tcl_Pid (*tcl_WaitPid) (Tcl_Pid pid, int *statPtr, int options); /* 277 */ - TCL_DEPRECATED_API("see TIP #422") TCL_NORETURN1 void (*tcl_PanicVA) (const char *format, va_list argList); /* 278 */ + void (*reserved278)(void); void (*tcl_GetVersion) (int *major, int *minor, int *patchLevel, int *type); /* 279 */ void (*tcl_InitMemory) (Tcl_Interp *interp); /* 280 */ Tcl_Channel (*tcl_StackChannel) (Tcl_Interp *interp, const Tcl_ChannelType *typePtr, void *instanceData, int mask, Tcl_Channel prevChan); /* 281 */ @@ -2373,7 +2161,7 @@ typedef struct TclStubs { Tcl_Encoding (*tcl_CreateEncoding) (const Tcl_EncodingType *typePtr); /* 287 */ void (*tcl_CreateThreadExitHandler) (Tcl_ExitProc *proc, void *clientData); /* 288 */ void (*tcl_DeleteThreadExitHandler) (Tcl_ExitProc *proc, void *clientData); /* 289 */ - TCL_DEPRECATED_API("Use Tcl_DiscardInterpState") void (*tcl_DiscardResult) (Tcl_SavedResult *statePtr); /* 290 */ + void (*reserved290)(void); int (*tcl_EvalEx) (Tcl_Interp *interp, const char *script, Tcl_Size numBytes, int flags); /* 291 */ int (*tcl_EvalObjv) (Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const objv[], int flags); /* 292 */ int (*tcl_EvalObjEx) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 293 */ @@ -2395,10 +2183,10 @@ typedef struct TclStubs { void (*tcl_MutexUnlock) (Tcl_Mutex *mutexPtr); /* 309 */ void (*tcl_ConditionNotify) (Tcl_Condition *condPtr); /* 310 */ void (*tcl_ConditionWait) (Tcl_Condition *condPtr, Tcl_Mutex *mutexPtr, const Tcl_Time *timePtr); /* 311 */ - Tcl_Size (*tcl_NumUtfChars) (const char *src, Tcl_Size length); /* 312 */ + Tcl_Size (*tclNumUtfChars) (const char *src, Tcl_Size length); /* 312 */ Tcl_Size (*tcl_ReadChars) (Tcl_Channel channel, Tcl_Obj *objPtr, Tcl_Size charsToRead, int appendFlag); /* 313 */ - TCL_DEPRECATED_API("Use Tcl_RestoreInterpState") void (*tcl_RestoreResult) (Tcl_Interp *interp, Tcl_SavedResult *statePtr); /* 314 */ - TCL_DEPRECATED_API("Use Tcl_SaveInterpState") void (*tcl_SaveResult) (Tcl_Interp *interp, Tcl_SavedResult *statePtr); /* 315 */ + void (*reserved314)(void); + void (*reserved315)(void); int (*tcl_SetSystemEncoding) (Tcl_Interp *interp, const char *name); /* 316 */ Tcl_Obj * (*tcl_SetVar2Ex) (Tcl_Interp *interp, const char *part1, const char *part2, Tcl_Obj *newValuePtr, int flags); /* 317 */ void (*tcl_ThreadAlert) (Tcl_ThreadId threadId); /* 318 */ @@ -2407,8 +2195,8 @@ typedef struct TclStubs { int (*tcl_UniCharToLower) (int ch); /* 321 */ int (*tcl_UniCharToTitle) (int ch); /* 322 */ int (*tcl_UniCharToUpper) (int ch); /* 323 */ - int (*tcl_UniCharToUtf) (int ch, char *buf); /* 324 */ - const char * (*tcl_UtfAtIndex) (const char *src, Tcl_Size index); /* 325 */ + Tcl_Size (*tcl_UniCharToUtf) (int ch, char *buf); /* 324 */ + const char * (*tclUtfAtIndex) (const char *src, Tcl_Size index); /* 325 */ int (*tclUtfCharComplete) (const char *src, Tcl_Size length); /* 326 */ Tcl_Size (*tcl_UtfBackslash) (const char *src, int *readPtr, char *dst); /* 327 */ const char * (*tcl_UtfFindFirst) (const char *src, int ch); /* 328 */ @@ -2417,15 +2205,15 @@ typedef struct TclStubs { const char * (*tclUtfPrev) (const char *src, const char *start); /* 331 */ int (*tcl_UtfToExternal) (Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, Tcl_Size srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, Tcl_Size dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); /* 332 */ char * (*tcl_UtfToExternalDString) (Tcl_Encoding encoding, const char *src, Tcl_Size srcLen, Tcl_DString *dsPtr); /* 333 */ - int (*tcl_UtfToLower) (char *src); /* 334 */ - int (*tcl_UtfToTitle) (char *src); /* 335 */ - int (*tcl_UtfToChar16) (const char *src, unsigned short *chPtr); /* 336 */ - int (*tcl_UtfToUpper) (char *src); /* 337 */ + Tcl_Size (*tcl_UtfToLower) (char *src); /* 334 */ + Tcl_Size (*tcl_UtfToTitle) (char *src); /* 335 */ + Tcl_Size (*tcl_UtfToChar16) (const char *src, unsigned short *chPtr); /* 336 */ + Tcl_Size (*tcl_UtfToUpper) (char *src); /* 337 */ Tcl_Size (*tcl_WriteChars) (Tcl_Channel chan, const char *src, Tcl_Size srcLen); /* 338 */ Tcl_Size (*tcl_WriteObj) (Tcl_Channel chan, Tcl_Obj *objPtr); /* 339 */ char * (*tcl_GetString) (Tcl_Obj *objPtr); /* 340 */ - TCL_DEPRECATED_API("Use Tcl_GetEncodingSearchPath") const char * (*tcl_GetDefaultEncodingDir) (void); /* 341 */ - TCL_DEPRECATED_API("Use Tcl_SetEncodingSearchPath") void (*tcl_SetDefaultEncodingDir) (const char *path); /* 342 */ + void (*reserved341)(void); + void (*reserved342)(void); void (*tcl_AlertNotifier) (void *clientData); /* 343 */ void (*tcl_ServiceModeHook) (int mode); /* 344 */ int (*tcl_UniCharIsAlnum) (int ch); /* 345 */ @@ -2436,11 +2224,11 @@ typedef struct TclStubs { int (*tcl_UniCharIsUpper) (int ch); /* 350 */ int (*tcl_UniCharIsWordChar) (int ch); /* 351 */ Tcl_Size (*tcl_Char16Len) (const unsigned short *uniStr); /* 352 */ - TCL_DEPRECATED_API("Use Tcl_UtfNcmp") int (*tcl_UniCharNcmp) (const unsigned short *ucs, const unsigned short *uct, unsigned long numChars); /* 353 */ + void (*reserved353)(void); char * (*tcl_Char16ToUtfDString) (const unsigned short *uniStr, Tcl_Size uniLength, Tcl_DString *dsPtr); /* 354 */ unsigned short * (*tcl_UtfToChar16DString) (const char *src, Tcl_Size length, Tcl_DString *dsPtr); /* 355 */ Tcl_RegExp (*tcl_GetRegExpFromObj) (Tcl_Interp *interp, Tcl_Obj *patObj, int flags); /* 356 */ - TCL_DEPRECATED_API("Use Tcl_EvalTokensStandard") Tcl_Obj * (*tcl_EvalTokens) (Tcl_Interp *interp, Tcl_Token *tokenPtr, int count); /* 357 */ + void (*reserved357)(void); void (*tcl_FreeParse) (Tcl_Parse *parsePtr); /* 358 */ void (*tcl_LogCommandInfo) (Tcl_Interp *interp, const char *script, const char *command, Tcl_Size length); /* 359 */ int (*tcl_ParseBraces) (Tcl_Interp *interp, const char *start, Tcl_Size numBytes, Tcl_Parse *parsePtr, int append, const char **termPtr); /* 360 */ @@ -2452,8 +2240,8 @@ typedef struct TclStubs { int (*tcl_Chdir) (const char *dirName); /* 366 */ int (*tcl_Access) (const char *path, int mode); /* 367 */ int (*tcl_Stat) (const char *path, struct stat *bufPtr); /* 368 */ - int (*tcl_UtfNcmp) (const char *s1, const char *s2, unsigned long n); /* 369 */ - int (*tcl_UtfNcasecmp) (const char *s1, const char *s2, unsigned long n); /* 370 */ + int (*tcl_UtfNcmp) (const char *s1, const char *s2, size_t n); /* 369 */ + int (*tcl_UtfNcasecmp) (const char *s1, const char *s2, size_t n); /* 370 */ int (*tcl_StringCaseMatch) (const char *str, const char *pattern, int nocase); /* 371 */ int (*tcl_UniCharIsControl) (int ch); /* 372 */ int (*tcl_UniCharIsGraph) (int ch); /* 373 */ @@ -2461,13 +2249,13 @@ typedef struct TclStubs { int (*tcl_UniCharIsPunct) (int ch); /* 375 */ int (*tcl_RegExpExecObj) (Tcl_Interp *interp, Tcl_RegExp regexp, Tcl_Obj *textObj, Tcl_Size offset, Tcl_Size nmatches, int flags); /* 376 */ void (*tcl_RegExpGetInfo) (Tcl_RegExp regexp, Tcl_RegExpInfo *infoPtr); /* 377 */ - Tcl_Obj * (*tcl_NewUnicodeObj) (const unsigned short *unicode, Tcl_Size numChars); /* 378 */ - void (*tcl_SetUnicodeObj) (Tcl_Obj *objPtr, const unsigned short *unicode, Tcl_Size numChars); /* 379 */ - Tcl_Size (*tcl_GetCharLength) (Tcl_Obj *objPtr); /* 380 */ - int (*tcl_GetUniChar) (Tcl_Obj *objPtr, Tcl_Size index); /* 381 */ - TCL_DEPRECATED_API("No longer in use, changed to macro") unsigned short * (*tcl_GetUnicode) (Tcl_Obj *objPtr); /* 382 */ - Tcl_Obj * (*tcl_GetRange) (Tcl_Obj *objPtr, Tcl_Size first, Tcl_Size last); /* 383 */ - void (*tcl_AppendUnicodeToObj) (Tcl_Obj *objPtr, const unsigned short *unicode, Tcl_Size length); /* 384 */ + Tcl_Obj * (*tcl_NewUnicodeObj) (const Tcl_UniChar *unicode, Tcl_Size numChars); /* 378 */ + void (*tcl_SetUnicodeObj) (Tcl_Obj *objPtr, const Tcl_UniChar *unicode, Tcl_Size numChars); /* 379 */ + Tcl_Size (*tclGetCharLength) (Tcl_Obj *objPtr); /* 380 */ + int (*tclGetUniChar) (Tcl_Obj *objPtr, Tcl_Size index); /* 381 */ + void (*reserved382)(void); + Tcl_Obj * (*tclGetRange) (Tcl_Obj *objPtr, Tcl_Size first, Tcl_Size last); /* 383 */ + void (*tcl_AppendUnicodeToObj) (Tcl_Obj *objPtr, const Tcl_UniChar *unicode, Tcl_Size length); /* 384 */ int (*tcl_RegExpMatchObj) (Tcl_Interp *interp, Tcl_Obj *textObj, Tcl_Obj *patternObj); /* 385 */ void (*tcl_SetNotifier) (const Tcl_NotifierProcs *notifierProcPtr); /* 386 */ Tcl_Mutex * (*tcl_GetAllocMutex) (void); /* 387 */ @@ -2484,11 +2272,11 @@ typedef struct TclStubs { const char * (*tcl_ChannelName) (const Tcl_ChannelType *chanTypePtr); /* 398 */ Tcl_ChannelTypeVersion (*tcl_ChannelVersion) (const Tcl_ChannelType *chanTypePtr); /* 399 */ Tcl_DriverBlockModeProc * (*tcl_ChannelBlockModeProc) (const Tcl_ChannelType *chanTypePtr); /* 400 */ - TCL_DEPRECATED_API("Use Tcl_ChannelClose2Proc") Tcl_DriverCloseProc * (*tcl_ChannelCloseProc) (const Tcl_ChannelType *chanTypePtr); /* 401 */ + void (*reserved401)(void); Tcl_DriverClose2Proc * (*tcl_ChannelClose2Proc) (const Tcl_ChannelType *chanTypePtr); /* 402 */ Tcl_DriverInputProc * (*tcl_ChannelInputProc) (const Tcl_ChannelType *chanTypePtr); /* 403 */ Tcl_DriverOutputProc * (*tcl_ChannelOutputProc) (const Tcl_ChannelType *chanTypePtr); /* 404 */ - TCL_DEPRECATED_API("Use Tcl_ChannelWideSeekProc") Tcl_DriverSeekProc * (*tcl_ChannelSeekProc) (const Tcl_ChannelType *chanTypePtr); /* 405 */ + void (*reserved405)(void); Tcl_DriverSetOptionProc * (*tcl_ChannelSetOptionProc) (const Tcl_ChannelType *chanTypePtr); /* 406 */ Tcl_DriverGetOptionProc * (*tcl_ChannelGetOptionProc) (const Tcl_ChannelType *chanTypePtr); /* 407 */ Tcl_DriverWatchProc * (*tcl_ChannelWatchProc) (const Tcl_ChannelType *chanTypePtr); /* 408 */ @@ -2502,24 +2290,24 @@ typedef struct TclStubs { void (*tcl_SpliceChannel) (Tcl_Channel channel); /* 416 */ void (*tcl_ClearChannelHandlers) (Tcl_Channel channel); /* 417 */ int (*tcl_IsChannelExisting) (const char *channelName); /* 418 */ - TCL_DEPRECATED_API("Use Tcl_UtfNcasecmp") int (*tcl_UniCharNcasecmp) (const unsigned short *ucs, const unsigned short *uct, unsigned long numChars); /* 419 */ - TCL_DEPRECATED_API("Use Tcl_StringCaseMatch") int (*tcl_UniCharCaseMatch) (const unsigned short *uniStr, const unsigned short *uniPattern, int nocase); /* 420 */ - Tcl_HashEntry * (*tcl_FindHashEntry) (Tcl_HashTable *tablePtr, const void *key); /* 421 */ - Tcl_HashEntry * (*tcl_CreateHashEntry) (Tcl_HashTable *tablePtr, const void *key, int *newPtr); /* 422 */ + void (*reserved419)(void); + void (*reserved420)(void); + void (*reserved421)(void); + void (*reserved422)(void); void (*tcl_InitCustomHashTable) (Tcl_HashTable *tablePtr, int keyType, const Tcl_HashKeyType *typePtr); /* 423 */ void (*tcl_InitObjHashTable) (Tcl_HashTable *tablePtr); /* 424 */ void * (*tcl_CommandTraceInfo) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *procPtr, void *prevClientData); /* 425 */ int (*tcl_TraceCommand) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *proc, void *clientData); /* 426 */ void (*tcl_UntraceCommand) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *proc, void *clientData); /* 427 */ - char * (*tcl_AttemptAlloc) (TCL_HASH_TYPE size); /* 428 */ - char * (*tcl_AttemptDbCkalloc) (TCL_HASH_TYPE size, const char *file, int line); /* 429 */ - char * (*tcl_AttemptRealloc) (char *ptr, TCL_HASH_TYPE size); /* 430 */ - char * (*tcl_AttemptDbCkrealloc) (char *ptr, TCL_HASH_TYPE size, const char *file, int line); /* 431 */ + void * (*tcl_AttemptAlloc) (TCL_HASH_TYPE size); /* 428 */ + void * (*tcl_AttemptDbCkalloc) (TCL_HASH_TYPE size, const char *file, int line); /* 429 */ + void * (*tcl_AttemptRealloc) (void *ptr, TCL_HASH_TYPE size); /* 430 */ + 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 */ - unsigned short * (*tcl_GetUnicodeFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 434 */ - TCL_DEPRECATED_API("") int (*tcl_GetMathFuncInfo) (Tcl_Interp *interp, const char *name, int *numArgsPtr, Tcl_ValueType **argTypesPtr, Tcl_MathProc **procPtr, void **clientDataPtr); /* 435 */ - TCL_DEPRECATED_API("") Tcl_Obj * (*tcl_ListMathFuncs) (Tcl_Interp *interp, const char *pattern); /* 436 */ + Tcl_UniChar * (*tclGetUnicodeFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 434 */ + void (*reserved435)(void); + void (*reserved436)(void); Tcl_Obj * (*tcl_SubstObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 437 */ int (*tcl_DetachChannel) (Tcl_Interp *interp, Tcl_Channel channel); /* 438 */ int (*tcl_IsStandardChannel) (Tcl_Channel channel); /* 439 */ @@ -2536,7 +2324,7 @@ typedef struct TclStubs { int (*tcl_FSUtime) (Tcl_Obj *pathPtr, struct utimbuf *tval); /* 450 */ int (*tcl_FSFileAttrsGet) (Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef); /* 451 */ int (*tcl_FSFileAttrsSet) (Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj *objPtr); /* 452 */ - const char *CONST86 * (*tcl_FSFileAttrStrings) (Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef); /* 453 */ + const char *const * (*tcl_FSFileAttrStrings) (Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef); /* 453 */ int (*tcl_FSStat) (Tcl_Obj *pathPtr, Tcl_StatBuf *buf); /* 454 */ int (*tcl_FSAccess) (Tcl_Obj *pathPtr, int mode); /* 455 */ Tcl_Channel (*tcl_FSOpenFileChannel) (Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *modeString, int permissions); /* 456 */ @@ -2544,7 +2332,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 * (*tcl_FSSplitPath) (Tcl_Obj *pathPtr, int *lenPtr); /* 461 */ + Tcl_Obj * (*tclFSSplitPath) (Tcl_Obj *pathPtr, int *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 */ @@ -2560,7 +2348,7 @@ typedef struct TclStubs { int (*tcl_FSUnregister) (const Tcl_Filesystem *fsPtr); /* 474 */ void * (*tcl_FSData) (const Tcl_Filesystem *fsPtr); /* 475 */ const char * (*tcl_FSGetTranslatedStringPath) (Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 476 */ - CONST86 Tcl_Filesystem * (*tcl_FSGetFileSystemForPath) (Tcl_Obj *pathPtr); /* 477 */ + const Tcl_Filesystem * (*tcl_FSGetFileSystemForPath) (Tcl_Obj *pathPtr); /* 477 */ Tcl_PathType (*tcl_FSGetPathType) (Tcl_Obj *pathPtr); /* 478 */ int (*tcl_OutputBuffered) (Tcl_Channel chan); /* 479 */ void (*tcl_FSMountsChanged) (const Tcl_Filesystem *fsPtr); /* 480 */ @@ -2580,7 +2368,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 (*tcl_DictObjSize) (Tcl_Interp *interp, Tcl_Obj *dictPtr, int *sizePtr); /* 497 */ + int (*tclDictObjSize) (Tcl_Interp *interp, Tcl_Obj *dictPtr, int *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 */ @@ -2602,7 +2390,7 @@ typedef struct TclStubs { Tcl_Command (*tcl_GetCommandFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 516 */ void (*tcl_GetCommandFullName) (Tcl_Interp *interp, Tcl_Command command, Tcl_Obj *objPtr); /* 517 */ int (*tcl_FSEvalFileEx) (Tcl_Interp *interp, Tcl_Obj *fileName, const char *encodingName); /* 518 */ - TCL_DEPRECATED_API("Don't use this function in a stub-enabled extension") Tcl_ExitProc * (*tcl_SetExitProc) (TCL_NORETURN1 Tcl_ExitProc *proc); /* 519 */ + void (*reserved519)(void); void (*tcl_LimitAddHandler) (Tcl_Interp *interp, int type, Tcl_LimitHandlerProc *handlerProc, void *clientData, Tcl_LimitHandlerDeleteProc *deleteProc); /* 520 */ void (*tcl_LimitRemoveHandler) (Tcl_Interp *interp, int type, Tcl_LimitHandlerProc *handlerProc, void *clientData); /* 521 */ int (*tcl_LimitReady) (Tcl_Interp *interp); /* 522 */ @@ -2687,7 +2475,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 (*tcl_ParseArgsObjv) (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, int *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 */ @@ -2729,14 +2517,14 @@ typedef struct TclStubs { int (*tcl_IsShared) (Tcl_Obj *objPtr); /* 643 */ int (*tcl_LinkArray) (Tcl_Interp *interp, const char *varName, void *addr, int type, Tcl_Size size); /* 644 */ int (*tcl_GetIntForIndex) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Size endValue, Tcl_Size *indexPtr); /* 645 */ - int (*tcl_UtfToUniChar) (const char *src, int *chPtr); /* 646 */ + 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 * (*tclGetStringFromObj) (Tcl_Obj *objPtr, size_t *lengthPtr); /* 651 */ - unsigned short * (*tclGetUnicodeFromObj) (Tcl_Obj *objPtr, size_t *lengthPtr); /* 652 */ - unsigned char * (*tclGetByteArrayFromObj) (Tcl_Obj *objPtr, size_t *numBytesPtr); /* 653 */ + 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 */ 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 */ @@ -2744,19 +2532,19 @@ typedef struct TclStubs { Tcl_Size (*tcl_ExternalToUtfDStringEx) (Tcl_Encoding encoding, const char *src, Tcl_Size srcLen, int flags, Tcl_DString *dsPtr); /* 658 */ Tcl_Size (*tcl_UtfToExternalDStringEx) (Tcl_Encoding encoding, const char *src, Tcl_Size srcLen, int flags, Tcl_DString *dsPtr); /* 659 */ int (*tcl_AsyncMarkFromSignal) (Tcl_AsyncHandler async, int sigNumber); /* 660 */ - int (*tclListObjGetElements) (Tcl_Interp *interp, Tcl_Obj *listPtr, size_t *objcPtr, Tcl_Obj ***objvPtr); /* 661 */ - int (*tclListObjLength) (Tcl_Interp *interp, Tcl_Obj *listPtr, size_t *lengthPtr); /* 662 */ - int (*tclDictObjSize) (Tcl_Interp *interp, Tcl_Obj *dictPtr, size_t *sizePtr); /* 663 */ - int (*tclSplitList) (Tcl_Interp *interp, const char *listStr, size_t *argcPtr, const char ***argvPtr); /* 664 */ - void (*tclSplitPath) (const char *path, size_t *argcPtr, const char ***argvPtr); /* 665 */ - Tcl_Obj * (*tclFSSplitPath) (Tcl_Obj *pathPtr, size_t *lenPtr); /* 666 */ - int (*tclParseArgsObjv) (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, 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 */ Tcl_Size (*tcl_UniCharLen) (const int *uniStr); /* 668 */ - Tcl_Size (*tclNumUtfChars) (const char *src, Tcl_Size length); /* 669 */ - Tcl_Size (*tclGetCharLength) (Tcl_Obj *objPtr); /* 670 */ - const char * (*tclUtfAtIndex) (const char *src, Tcl_Size index); /* 671 */ - Tcl_Obj * (*tclGetRange) (Tcl_Obj *objPtr, Tcl_Size first, Tcl_Size last); /* 672 */ - int (*tclGetUniChar) (Tcl_Obj *objPtr, Tcl_Size index); /* 673 */ + Tcl_Size (*tcl_NumUtfChars) (const char *src, Tcl_Size length); /* 669 */ + Tcl_Size (*tcl_GetCharLength) (Tcl_Obj *objPtr); /* 670 */ + const char * (*tcl_UtfAtIndex) (const char *src, Tcl_Size index); /* 671 */ + Tcl_Obj * (*tcl_GetRange) (Tcl_Obj *objPtr, Tcl_Size first, Tcl_Size last); /* 672 */ + int (*tcl_GetUniChar) (Tcl_Obj *objPtr, Tcl_Size index); /* 673 */ int (*tcl_GetBool) (Tcl_Interp *interp, const char *src, int flags, char *charPtr); /* 674 */ int (*tcl_GetBoolFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, char *charPtr); /* 675 */ Tcl_Command (*tcl_CreateObjCommand2) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc2 *proc2, void *clientData, Tcl_CmdDeleteProc *deleteProc); /* 676 */ @@ -2803,22 +2591,10 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_DbCkfree) /* 7 */ #define Tcl_DbCkrealloc \ (tclStubsPtr->tcl_DbCkrealloc) /* 8 */ -#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */ -#define Tcl_CreateFileHandler \ - (tclStubsPtr->tcl_CreateFileHandler) /* 9 */ -#endif /* UNIX */ -#ifdef MAC_OSX_TCL /* MACOSX */ #define Tcl_CreateFileHandler \ (tclStubsPtr->tcl_CreateFileHandler) /* 9 */ -#endif /* MACOSX */ -#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */ #define Tcl_DeleteFileHandler \ (tclStubsPtr->tcl_DeleteFileHandler) /* 10 */ -#endif /* UNIX */ -#ifdef MAC_OSX_TCL /* MACOSX */ -#define Tcl_DeleteFileHandler \ - (tclStubsPtr->tcl_DeleteFileHandler) /* 10 */ -#endif /* MACOSX */ #define Tcl_SetTimer \ (tclStubsPtr->tcl_SetTimer) /* 11 */ #define Tcl_Sleep \ @@ -2841,16 +2617,14 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_DbIncrRefCount) /* 20 */ #define Tcl_DbIsShared \ (tclStubsPtr->tcl_DbIsShared) /* 21 */ -#define Tcl_DbNewBooleanObj \ - (tclStubsPtr->tcl_DbNewBooleanObj) /* 22 */ +/* Slot 22 is reserved */ #define Tcl_DbNewByteArrayObj \ (tclStubsPtr->tcl_DbNewByteArrayObj) /* 23 */ #define Tcl_DbNewDoubleObj \ (tclStubsPtr->tcl_DbNewDoubleObj) /* 24 */ #define Tcl_DbNewListObj \ (tclStubsPtr->tcl_DbNewListObj) /* 25 */ -#define Tcl_DbNewLongObj \ - (tclStubsPtr->tcl_DbNewLongObj) /* 26 */ +/* Slot 26 is reserved */ #define Tcl_DbNewObj \ (tclStubsPtr->tcl_DbNewObj) /* 27 */ #define Tcl_DbNewStringObj \ @@ -2863,14 +2637,13 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_GetBoolean) /* 31 */ #define Tcl_GetBooleanFromObj \ (tclStubsPtr->tcl_GetBooleanFromObj) /* 32 */ -#define Tcl_GetByteArrayFromObj \ - (tclStubsPtr->tcl_GetByteArrayFromObj) /* 33 */ +#define TclGetByteArrayFromObj \ + (tclStubsPtr->tclGetByteArrayFromObj) /* 33 */ #define Tcl_GetDouble \ (tclStubsPtr->tcl_GetDouble) /* 34 */ #define Tcl_GetDoubleFromObj \ (tclStubsPtr->tcl_GetDoubleFromObj) /* 35 */ -#define Tcl_GetIndexFromObj \ - (tclStubsPtr->tcl_GetIndexFromObj) /* 36 */ +/* Slot 36 is reserved */ #define Tcl_GetInt \ (tclStubsPtr->tcl_GetInt) /* 37 */ #define Tcl_GetIntFromObj \ @@ -2879,60 +2652,52 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_GetLongFromObj) /* 39 */ #define Tcl_GetObjType \ (tclStubsPtr->tcl_GetObjType) /* 40 */ -#define Tcl_GetStringFromObj \ - (tclStubsPtr->tcl_GetStringFromObj) /* 41 */ +#define TclGetStringFromObj \ + (tclStubsPtr->tclGetStringFromObj) /* 41 */ #define Tcl_InvalidateStringRep \ (tclStubsPtr->tcl_InvalidateStringRep) /* 42 */ #define Tcl_ListObjAppendList \ (tclStubsPtr->tcl_ListObjAppendList) /* 43 */ #define Tcl_ListObjAppendElement \ (tclStubsPtr->tcl_ListObjAppendElement) /* 44 */ -#define Tcl_ListObjGetElements \ - (tclStubsPtr->tcl_ListObjGetElements) /* 45 */ +#define TclListObjGetElements \ + (tclStubsPtr->tclListObjGetElements) /* 45 */ #define Tcl_ListObjIndex \ (tclStubsPtr->tcl_ListObjIndex) /* 46 */ -#define Tcl_ListObjLength \ - (tclStubsPtr->tcl_ListObjLength) /* 47 */ +#define TclListObjLength \ + (tclStubsPtr->tclListObjLength) /* 47 */ #define Tcl_ListObjReplace \ (tclStubsPtr->tcl_ListObjReplace) /* 48 */ -#define Tcl_NewBooleanObj \ - (tclStubsPtr->tcl_NewBooleanObj) /* 49 */ +/* Slot 49 is reserved */ #define Tcl_NewByteArrayObj \ (tclStubsPtr->tcl_NewByteArrayObj) /* 50 */ #define Tcl_NewDoubleObj \ (tclStubsPtr->tcl_NewDoubleObj) /* 51 */ -#define Tcl_NewIntObj \ - (tclStubsPtr->tcl_NewIntObj) /* 52 */ +/* Slot 52 is reserved */ #define Tcl_NewListObj \ (tclStubsPtr->tcl_NewListObj) /* 53 */ -#define Tcl_NewLongObj \ - (tclStubsPtr->tcl_NewLongObj) /* 54 */ +/* Slot 54 is reserved */ #define Tcl_NewObj \ (tclStubsPtr->tcl_NewObj) /* 55 */ #define Tcl_NewStringObj \ (tclStubsPtr->tcl_NewStringObj) /* 56 */ -#define Tcl_SetBooleanObj \ - (tclStubsPtr->tcl_SetBooleanObj) /* 57 */ +/* Slot 57 is reserved */ #define Tcl_SetByteArrayLength \ (tclStubsPtr->tcl_SetByteArrayLength) /* 58 */ #define Tcl_SetByteArrayObj \ (tclStubsPtr->tcl_SetByteArrayObj) /* 59 */ #define Tcl_SetDoubleObj \ (tclStubsPtr->tcl_SetDoubleObj) /* 60 */ -#define Tcl_SetIntObj \ - (tclStubsPtr->tcl_SetIntObj) /* 61 */ +/* Slot 61 is reserved */ #define Tcl_SetListObj \ (tclStubsPtr->tcl_SetListObj) /* 62 */ -#define Tcl_SetLongObj \ - (tclStubsPtr->tcl_SetLongObj) /* 63 */ +/* Slot 63 is reserved */ #define Tcl_SetObjLength \ (tclStubsPtr->tcl_SetObjLength) /* 64 */ #define Tcl_SetStringObj \ (tclStubsPtr->tcl_SetStringObj) /* 65 */ -#define Tcl_AddErrorInfo \ - (tclStubsPtr->tcl_AddErrorInfo) /* 66 */ -#define Tcl_AddObjErrorInfo \ - (tclStubsPtr->tcl_AddObjErrorInfo) /* 67 */ +/* Slot 66 is reserved */ +/* Slot 67 is reserved */ #define Tcl_AllowExceptions \ (tclStubsPtr->tcl_AllowExceptions) /* 68 */ #define Tcl_AppendElement \ @@ -2949,10 +2714,8 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_AsyncMark) /* 74 */ #define Tcl_AsyncReady \ (tclStubsPtr->tcl_AsyncReady) /* 75 */ -#define Tcl_BackgroundError \ - (tclStubsPtr->tcl_BackgroundError) /* 76 */ -#define Tcl_Backslash \ - (tclStubsPtr->tcl_Backslash) /* 77 */ +/* Slot 76 is reserved */ +/* Slot 77 is reserved */ #define Tcl_BadChannelOption \ (tclStubsPtr->tcl_BadChannelOption) /* 78 */ #define Tcl_CallWhenDeleted \ @@ -2987,8 +2750,7 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_CreateExitHandler) /* 93 */ #define Tcl_CreateInterp \ (tclStubsPtr->tcl_CreateInterp) /* 94 */ -#define Tcl_CreateMathFunc \ - (tclStubsPtr->tcl_CreateMathFunc) /* 95 */ +/* Slot 95 is reserved */ #define Tcl_CreateObjCommand \ (tclStubsPtr->tcl_CreateObjCommand) /* 96 */ #define Tcl_CreateChild \ @@ -3055,12 +2817,10 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_ErrnoId) /* 127 */ #define Tcl_ErrnoMsg \ (tclStubsPtr->tcl_ErrnoMsg) /* 128 */ -#define Tcl_Eval \ - (tclStubsPtr->tcl_Eval) /* 129 */ +/* Slot 129 is reserved */ #define Tcl_EvalFile \ (tclStubsPtr->tcl_EvalFile) /* 130 */ -#define Tcl_EvalObj \ - (tclStubsPtr->tcl_EvalObj) /* 131 */ +/* Slot 131 is reserved */ #define Tcl_EventuallyFree \ (tclStubsPtr->tcl_EventuallyFree) /* 132 */ #define Tcl_Exit \ @@ -3085,14 +2845,12 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_ExprString) /* 142 */ #define Tcl_Finalize \ (tclStubsPtr->tcl_Finalize) /* 143 */ -#define Tcl_FindExecutable \ - (tclStubsPtr->tcl_FindExecutable) /* 144 */ +/* Slot 144 is reserved */ #define Tcl_FirstHashEntry \ (tclStubsPtr->tcl_FirstHashEntry) /* 145 */ #define Tcl_Flush \ (tclStubsPtr->tcl_Flush) /* 146 */ -#define Tcl_FreeResult \ - (tclStubsPtr->tcl_FreeResult) /* 147 */ +/* Slot 147 is reserved */ #define Tcl_GetAlias \ (tclStubsPtr->tcl_GetAlias) /* 148 */ #define Tcl_GetAliasObj \ @@ -3131,14 +2889,8 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_GetNameOfExecutable) /* 165 */ #define Tcl_GetObjResult \ (tclStubsPtr->tcl_GetObjResult) /* 166 */ -#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */ #define Tcl_GetOpenFile \ (tclStubsPtr->tcl_GetOpenFile) /* 167 */ -#endif /* UNIX */ -#ifdef MAC_OSX_TCL /* MACOSX */ -#define Tcl_GetOpenFile \ - (tclStubsPtr->tcl_GetOpenFile) /* 167 */ -#endif /* MACOSX */ #define Tcl_GetPathType \ (tclStubsPtr->tcl_GetPathType) /* 168 */ #define Tcl_Gets \ @@ -3151,16 +2903,12 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_GetChild) /* 172 */ #define Tcl_GetStdChannel \ (tclStubsPtr->tcl_GetStdChannel) /* 173 */ -#define Tcl_GetStringResult \ - (tclStubsPtr->tcl_GetStringResult) /* 174 */ -#define Tcl_GetVar \ - (tclStubsPtr->tcl_GetVar) /* 175 */ +/* Slot 174 is reserved */ +/* Slot 175 is reserved */ #define Tcl_GetVar2 \ (tclStubsPtr->tcl_GetVar2) /* 176 */ -#define Tcl_GlobalEval \ - (tclStubsPtr->tcl_GlobalEval) /* 177 */ -#define Tcl_GlobalEvalObj \ - (tclStubsPtr->tcl_GlobalEvalObj) /* 178 */ +/* Slot 177 is reserved */ +/* Slot 178 is reserved */ #define Tcl_HideCommand \ (tclStubsPtr->tcl_HideCommand) /* 179 */ #define Tcl_Init \ @@ -3182,8 +2930,7 @@ extern const TclStubs *tclStubsPtr; /* Slot 188 is reserved */ #define Tcl_MakeFileChannel \ (tclStubsPtr->tcl_MakeFileChannel) /* 189 */ -#define Tcl_MakeSafe \ - (tclStubsPtr->tcl_MakeSafe) /* 190 */ +/* Slot 190 is reserved */ #define Tcl_MakeTcpClientChannel \ (tclStubsPtr->tcl_MakeTcpClientChannel) /* 191 */ #define Tcl_Merge \ @@ -3242,8 +2989,7 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_ScanElement) /* 218 */ #define Tcl_ScanCountedElement \ (tclStubsPtr->tcl_ScanCountedElement) /* 219 */ -#define Tcl_SeekOld \ - (tclStubsPtr->tcl_SeekOld) /* 220 */ +/* Slot 220 is reserved */ #define Tcl_ServiceAll \ (tclStubsPtr->tcl_ServiceAll) /* 221 */ #define Tcl_ServiceEvent \ @@ -3262,12 +3008,10 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_SetErrorCode) /* 228 */ #define Tcl_SetMaxBlockTime \ (tclStubsPtr->tcl_SetMaxBlockTime) /* 229 */ -#define Tcl_SetPanicProc \ - (tclStubsPtr->tcl_SetPanicProc) /* 230 */ +/* Slot 230 is reserved */ #define Tcl_SetRecursionLimit \ (tclStubsPtr->tcl_SetRecursionLimit) /* 231 */ -#define Tcl_SetResult \ - (tclStubsPtr->tcl_SetResult) /* 232 */ +/* Slot 232 is reserved */ #define Tcl_SetServiceMode \ (tclStubsPtr->tcl_SetServiceMode) /* 233 */ #define Tcl_SetObjErrorCode \ @@ -3276,8 +3020,7 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_SetObjResult) /* 235 */ #define Tcl_SetStdChannel \ (tclStubsPtr->tcl_SetStdChannel) /* 236 */ -#define Tcl_SetVar \ - (tclStubsPtr->tcl_SetVar) /* 237 */ +/* Slot 237 is reserved */ #define Tcl_SetVar2 \ (tclStubsPtr->tcl_SetVar2) /* 238 */ #define Tcl_SignalId \ @@ -3286,18 +3029,14 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_SignalMsg) /* 240 */ #define Tcl_SourceRCFile \ (tclStubsPtr->tcl_SourceRCFile) /* 241 */ -#define Tcl_SplitList \ - (tclStubsPtr->tcl_SplitList) /* 242 */ -#define Tcl_SplitPath \ - (tclStubsPtr->tcl_SplitPath) /* 243 */ -#define Tcl_StaticLibrary \ - (tclStubsPtr->tcl_StaticLibrary) /* 244 */ -#define Tcl_StringMatch \ - (tclStubsPtr->tcl_StringMatch) /* 245 */ -#define Tcl_TellOld \ - (tclStubsPtr->tcl_TellOld) /* 246 */ -#define Tcl_TraceVar \ - (tclStubsPtr->tcl_TraceVar) /* 247 */ +#define TclSplitList \ + (tclStubsPtr->tclSplitList) /* 242 */ +#define TclSplitPath \ + (tclStubsPtr->tclSplitPath) /* 243 */ +/* Slot 244 is reserved */ +/* Slot 245 is reserved */ +/* Slot 246 is reserved */ +/* Slot 247 is reserved */ #define Tcl_TraceVar2 \ (tclStubsPtr->tcl_TraceVar2) /* 248 */ #define Tcl_TranslateFileName \ @@ -3308,24 +3047,20 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_UnlinkVar) /* 251 */ #define Tcl_UnregisterChannel \ (tclStubsPtr->tcl_UnregisterChannel) /* 252 */ -#define Tcl_UnsetVar \ - (tclStubsPtr->tcl_UnsetVar) /* 253 */ +/* Slot 253 is reserved */ #define Tcl_UnsetVar2 \ (tclStubsPtr->tcl_UnsetVar2) /* 254 */ -#define Tcl_UntraceVar \ - (tclStubsPtr->tcl_UntraceVar) /* 255 */ +/* Slot 255 is reserved */ #define Tcl_UntraceVar2 \ (tclStubsPtr->tcl_UntraceVar2) /* 256 */ #define Tcl_UpdateLinkedVar \ (tclStubsPtr->tcl_UpdateLinkedVar) /* 257 */ -#define Tcl_UpVar \ - (tclStubsPtr->tcl_UpVar) /* 258 */ +/* Slot 258 is reserved */ #define Tcl_UpVar2 \ (tclStubsPtr->tcl_UpVar2) /* 259 */ #define Tcl_VarEval \ (tclStubsPtr->tcl_VarEval) /* 260 */ -#define Tcl_VarTraceInfo \ - (tclStubsPtr->tcl_VarTraceInfo) /* 261 */ +/* Slot 261 is reserved */ #define Tcl_VarTraceInfo2 \ (tclStubsPtr->tcl_VarTraceInfo2) /* 262 */ #define Tcl_Write \ @@ -3336,30 +3071,22 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_DumpActiveMemory) /* 265 */ #define Tcl_ValidateAllMemory \ (tclStubsPtr->tcl_ValidateAllMemory) /* 266 */ -#define Tcl_AppendResultVA \ - (tclStubsPtr->tcl_AppendResultVA) /* 267 */ -#define Tcl_AppendStringsToObjVA \ - (tclStubsPtr->tcl_AppendStringsToObjVA) /* 268 */ +/* Slot 267 is reserved */ +/* Slot 268 is reserved */ #define Tcl_HashStats \ (tclStubsPtr->tcl_HashStats) /* 269 */ #define Tcl_ParseVar \ (tclStubsPtr->tcl_ParseVar) /* 270 */ -#define Tcl_PkgPresent \ - (tclStubsPtr->tcl_PkgPresent) /* 271 */ +/* Slot 271 is reserved */ #define Tcl_PkgPresentEx \ (tclStubsPtr->tcl_PkgPresentEx) /* 272 */ -#define Tcl_PkgProvide \ - (tclStubsPtr->tcl_PkgProvide) /* 273 */ -#define Tcl_PkgRequire \ - (tclStubsPtr->tcl_PkgRequire) /* 274 */ -#define Tcl_SetErrorCodeVA \ - (tclStubsPtr->tcl_SetErrorCodeVA) /* 275 */ -#define Tcl_VarEvalVA \ - (tclStubsPtr->tcl_VarEvalVA) /* 276 */ +/* Slot 273 is reserved */ +/* Slot 274 is reserved */ +/* Slot 275 is reserved */ +/* Slot 276 is reserved */ #define Tcl_WaitPid \ (tclStubsPtr->tcl_WaitPid) /* 277 */ -#define Tcl_PanicVA \ - (tclStubsPtr->tcl_PanicVA) /* 278 */ +/* Slot 278 is reserved */ #define Tcl_GetVersion \ (tclStubsPtr->tcl_GetVersion) /* 279 */ #define Tcl_InitMemory \ @@ -3381,8 +3108,7 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_CreateThreadExitHandler) /* 288 */ #define Tcl_DeleteThreadExitHandler \ (tclStubsPtr->tcl_DeleteThreadExitHandler) /* 289 */ -#define Tcl_DiscardResult \ - (tclStubsPtr->tcl_DiscardResult) /* 290 */ +/* Slot 290 is reserved */ #define Tcl_EvalEx \ (tclStubsPtr->tcl_EvalEx) /* 291 */ #define Tcl_EvalObjv \ @@ -3425,14 +3151,12 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_ConditionNotify) /* 310 */ #define Tcl_ConditionWait \ (tclStubsPtr->tcl_ConditionWait) /* 311 */ -#define Tcl_NumUtfChars \ - (tclStubsPtr->tcl_NumUtfChars) /* 312 */ +#define TclNumUtfChars \ + (tclStubsPtr->tclNumUtfChars) /* 312 */ #define Tcl_ReadChars \ (tclStubsPtr->tcl_ReadChars) /* 313 */ -#define Tcl_RestoreResult \ - (tclStubsPtr->tcl_RestoreResult) /* 314 */ -#define Tcl_SaveResult \ - (tclStubsPtr->tcl_SaveResult) /* 315 */ +/* Slot 314 is reserved */ +/* Slot 315 is reserved */ #define Tcl_SetSystemEncoding \ (tclStubsPtr->tcl_SetSystemEncoding) /* 316 */ #define Tcl_SetVar2Ex \ @@ -3451,8 +3175,8 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_UniCharToUpper) /* 323 */ #define Tcl_UniCharToUtf \ (tclStubsPtr->tcl_UniCharToUtf) /* 324 */ -#define Tcl_UtfAtIndex \ - (tclStubsPtr->tcl_UtfAtIndex) /* 325 */ +#define TclUtfAtIndex \ + (tclStubsPtr->tclUtfAtIndex) /* 325 */ #define TclUtfCharComplete \ (tclStubsPtr->tclUtfCharComplete) /* 326 */ #define Tcl_UtfBackslash \ @@ -3483,10 +3207,8 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_WriteObj) /* 339 */ #define Tcl_GetString \ (tclStubsPtr->tcl_GetString) /* 340 */ -#define Tcl_GetDefaultEncodingDir \ - (tclStubsPtr->tcl_GetDefaultEncodingDir) /* 341 */ -#define Tcl_SetDefaultEncodingDir \ - (tclStubsPtr->tcl_SetDefaultEncodingDir) /* 342 */ +/* Slot 341 is reserved */ +/* Slot 342 is reserved */ #define Tcl_AlertNotifier \ (tclStubsPtr->tcl_AlertNotifier) /* 343 */ #define Tcl_ServiceModeHook \ @@ -3507,16 +3229,14 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_UniCharIsWordChar) /* 351 */ #define Tcl_Char16Len \ (tclStubsPtr->tcl_Char16Len) /* 352 */ -#define Tcl_UniCharNcmp \ - (tclStubsPtr->tcl_UniCharNcmp) /* 353 */ +/* Slot 353 is reserved */ #define Tcl_Char16ToUtfDString \ (tclStubsPtr->tcl_Char16ToUtfDString) /* 354 */ #define Tcl_UtfToChar16DString \ (tclStubsPtr->tcl_UtfToChar16DString) /* 355 */ #define Tcl_GetRegExpFromObj \ (tclStubsPtr->tcl_GetRegExpFromObj) /* 356 */ -#define Tcl_EvalTokens \ - (tclStubsPtr->tcl_EvalTokens) /* 357 */ +/* Slot 357 is reserved */ #define Tcl_FreeParse \ (tclStubsPtr->tcl_FreeParse) /* 358 */ #define Tcl_LogCommandInfo \ @@ -3561,14 +3281,13 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_NewUnicodeObj) /* 378 */ #define Tcl_SetUnicodeObj \ (tclStubsPtr->tcl_SetUnicodeObj) /* 379 */ -#define Tcl_GetCharLength \ - (tclStubsPtr->tcl_GetCharLength) /* 380 */ -#define Tcl_GetUniChar \ - (tclStubsPtr->tcl_GetUniChar) /* 381 */ -#define Tcl_GetUnicode \ - (tclStubsPtr->tcl_GetUnicode) /* 382 */ -#define Tcl_GetRange \ - (tclStubsPtr->tcl_GetRange) /* 383 */ +#define TclGetCharLength \ + (tclStubsPtr->tclGetCharLength) /* 380 */ +#define TclGetUniChar \ + (tclStubsPtr->tclGetUniChar) /* 381 */ +/* Slot 382 is reserved */ +#define TclGetRange \ + (tclStubsPtr->tclGetRange) /* 383 */ #define Tcl_AppendUnicodeToObj \ (tclStubsPtr->tcl_AppendUnicodeToObj) /* 384 */ #define Tcl_RegExpMatchObj \ @@ -3603,16 +3322,14 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_ChannelVersion) /* 399 */ #define Tcl_ChannelBlockModeProc \ (tclStubsPtr->tcl_ChannelBlockModeProc) /* 400 */ -#define Tcl_ChannelCloseProc \ - (tclStubsPtr->tcl_ChannelCloseProc) /* 401 */ +/* Slot 401 is reserved */ #define Tcl_ChannelClose2Proc \ (tclStubsPtr->tcl_ChannelClose2Proc) /* 402 */ #define Tcl_ChannelInputProc \ (tclStubsPtr->tcl_ChannelInputProc) /* 403 */ #define Tcl_ChannelOutputProc \ (tclStubsPtr->tcl_ChannelOutputProc) /* 404 */ -#define Tcl_ChannelSeekProc \ - (tclStubsPtr->tcl_ChannelSeekProc) /* 405 */ +/* Slot 405 is reserved */ #define Tcl_ChannelSetOptionProc \ (tclStubsPtr->tcl_ChannelSetOptionProc) /* 406 */ #define Tcl_ChannelGetOptionProc \ @@ -3639,14 +3356,10 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_ClearChannelHandlers) /* 417 */ #define Tcl_IsChannelExisting \ (tclStubsPtr->tcl_IsChannelExisting) /* 418 */ -#define Tcl_UniCharNcasecmp \ - (tclStubsPtr->tcl_UniCharNcasecmp) /* 419 */ -#define Tcl_UniCharCaseMatch \ - (tclStubsPtr->tcl_UniCharCaseMatch) /* 420 */ -#define Tcl_FindHashEntry \ - (tclStubsPtr->tcl_FindHashEntry) /* 421 */ -#define Tcl_CreateHashEntry \ - (tclStubsPtr->tcl_CreateHashEntry) /* 422 */ +/* Slot 419 is reserved */ +/* Slot 420 is reserved */ +/* Slot 421 is reserved */ +/* Slot 422 is reserved */ #define Tcl_InitCustomHashTable \ (tclStubsPtr->tcl_InitCustomHashTable) /* 423 */ #define Tcl_InitObjHashTable \ @@ -3669,12 +3382,10 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_AttemptSetObjLength) /* 432 */ #define Tcl_GetChannelThread \ (tclStubsPtr->tcl_GetChannelThread) /* 433 */ -#define Tcl_GetUnicodeFromObj \ - (tclStubsPtr->tcl_GetUnicodeFromObj) /* 434 */ -#define Tcl_GetMathFuncInfo \ - (tclStubsPtr->tcl_GetMathFuncInfo) /* 435 */ -#define Tcl_ListMathFuncs \ - (tclStubsPtr->tcl_ListMathFuncs) /* 436 */ +#define TclGetUnicodeFromObj \ + (tclStubsPtr->tclGetUnicodeFromObj) /* 434 */ +/* Slot 435 is reserved */ +/* Slot 436 is reserved */ #define Tcl_SubstObj \ (tclStubsPtr->tcl_SubstObj) /* 437 */ #define Tcl_DetachChannel \ @@ -3723,8 +3434,8 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_FSConvertToPathType) /* 459 */ #define Tcl_FSJoinPath \ (tclStubsPtr->tcl_FSJoinPath) /* 460 */ -#define Tcl_FSSplitPath \ - (tclStubsPtr->tcl_FSSplitPath) /* 461 */ +#define TclFSSplitPath \ + (tclStubsPtr->tclFSSplitPath) /* 461 */ #define Tcl_FSEqualPaths \ (tclStubsPtr->tcl_FSEqualPaths) /* 462 */ #define Tcl_FSGetNormalizedPath \ @@ -3795,8 +3506,8 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_DictObjGet) /* 495 */ #define Tcl_DictObjRemove \ (tclStubsPtr->tcl_DictObjRemove) /* 496 */ -#define Tcl_DictObjSize \ - (tclStubsPtr->tcl_DictObjSize) /* 497 */ +#define TclDictObjSize \ + (tclStubsPtr->tclDictObjSize) /* 497 */ #define Tcl_DictObjFirst \ (tclStubsPtr->tcl_DictObjFirst) /* 498 */ #define Tcl_DictObjNext \ @@ -3839,8 +3550,7 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_GetCommandFullName) /* 517 */ #define Tcl_FSEvalFileEx \ (tclStubsPtr->tcl_FSEvalFileEx) /* 518 */ -#define Tcl_SetExitProc \ - (tclStubsPtr->tcl_SetExitProc) /* 519 */ +/* Slot 519 is reserved */ #define Tcl_LimitAddHandler \ (tclStubsPtr->tcl_LimitAddHandler) /* 520 */ #define Tcl_LimitRemoveHandler \ @@ -4009,8 +3719,8 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_SetEnsembleParameterList) /* 602 */ #define Tcl_GetEnsembleParameterList \ (tclStubsPtr->tcl_GetEnsembleParameterList) /* 603 */ -#define Tcl_ParseArgsObjv \ - (tclStubsPtr->tcl_ParseArgsObjv) /* 604 */ +#define TclParseArgsObjv \ + (tclStubsPtr->tclParseArgsObjv) /* 604 */ #define Tcl_GetErrorLine \ (tclStubsPtr->tcl_GetErrorLine) /* 605 */ #define Tcl_SetErrorLine \ @@ -4103,12 +3813,12 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tclGetBytesFromObj) /* 649 */ #define Tcl_GetBytesFromObj \ (tclStubsPtr->tcl_GetBytesFromObj) /* 650 */ -#define TclGetStringFromObj \ - (tclStubsPtr->tclGetStringFromObj) /* 651 */ -#define TclGetUnicodeFromObj \ - (tclStubsPtr->tclGetUnicodeFromObj) /* 652 */ -#define TclGetByteArrayFromObj \ - (tclStubsPtr->tclGetByteArrayFromObj) /* 653 */ +#define Tcl_GetStringFromObj \ + (tclStubsPtr->tcl_GetStringFromObj) /* 651 */ +#define Tcl_GetUnicodeFromObj \ + (tclStubsPtr->tcl_GetUnicodeFromObj) /* 652 */ +#define Tcl_GetByteArrayFromObj \ + (tclStubsPtr->tcl_GetByteArrayFromObj) /* 653 */ #define Tcl_UtfCharComplete \ (tclStubsPtr->tcl_UtfCharComplete) /* 654 */ #define Tcl_UtfNext \ @@ -4123,32 +3833,32 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_UtfToExternalDStringEx) /* 659 */ #define Tcl_AsyncMarkFromSignal \ (tclStubsPtr->tcl_AsyncMarkFromSignal) /* 660 */ -#define TclListObjGetElements \ - (tclStubsPtr->tclListObjGetElements) /* 661 */ -#define TclListObjLength \ - (tclStubsPtr->tclListObjLength) /* 662 */ -#define TclDictObjSize \ - (tclStubsPtr->tclDictObjSize) /* 663 */ -#define TclSplitList \ - (tclStubsPtr->tclSplitList) /* 664 */ -#define TclSplitPath \ - (tclStubsPtr->tclSplitPath) /* 665 */ -#define TclFSSplitPath \ - (tclStubsPtr->tclFSSplitPath) /* 666 */ -#define TclParseArgsObjv \ - (tclStubsPtr->tclParseArgsObjv) /* 667 */ +#define Tcl_ListObjGetElements \ + (tclStubsPtr->tcl_ListObjGetElements) /* 661 */ +#define Tcl_ListObjLength \ + (tclStubsPtr->tcl_ListObjLength) /* 662 */ +#define Tcl_DictObjSize \ + (tclStubsPtr->tcl_DictObjSize) /* 663 */ +#define Tcl_SplitList \ + (tclStubsPtr->tcl_SplitList) /* 664 */ +#define Tcl_SplitPath \ + (tclStubsPtr->tcl_SplitPath) /* 665 */ +#define Tcl_FSSplitPath \ + (tclStubsPtr->tcl_FSSplitPath) /* 666 */ +#define Tcl_ParseArgsObjv \ + (tclStubsPtr->tcl_ParseArgsObjv) /* 667 */ #define Tcl_UniCharLen \ (tclStubsPtr->tcl_UniCharLen) /* 668 */ -#define TclNumUtfChars \ - (tclStubsPtr->tclNumUtfChars) /* 669 */ -#define TclGetCharLength \ - (tclStubsPtr->tclGetCharLength) /* 670 */ -#define TclUtfAtIndex \ - (tclStubsPtr->tclUtfAtIndex) /* 671 */ -#define TclGetRange \ - (tclStubsPtr->tclGetRange) /* 672 */ -#define TclGetUniChar \ - (tclStubsPtr->tclGetUniChar) /* 673 */ +#define Tcl_NumUtfChars \ + (tclStubsPtr->tcl_NumUtfChars) /* 669 */ +#define Tcl_GetCharLength \ + (tclStubsPtr->tcl_GetCharLength) /* 670 */ +#define Tcl_UtfAtIndex \ + (tclStubsPtr->tcl_UtfAtIndex) /* 671 */ +#define Tcl_GetRange \ + (tclStubsPtr->tcl_GetRange) /* 672 */ +#define Tcl_GetUniChar \ + (tclStubsPtr->tcl_GetUniChar) /* 673 */ #define Tcl_GetBool \ (tclStubsPtr->tcl_GetBool) /* 674 */ #define Tcl_GetBoolFromObj \ @@ -4182,119 +3892,54 @@ extern const TclStubs *tclStubsPtr; /* !END!: Do not edit above this line. */ #undef TclUnusedStubEntry -#if defined(USE_TCL_STUBS) -# undef Tcl_CreateInterp -# undef Tcl_FindExecutable -# undef Tcl_GetStringResult -# undef Tcl_Init -# undef Tcl_SetPanicProc -# undef Tcl_SetExitProc -# undef Tcl_ObjSetVar2 -# undef Tcl_StaticLibrary -# define Tcl_CreateInterp() (tclStubsPtr->tcl_CreateInterp()) -# define Tcl_GetStringResult(interp) (tclStubsPtr->tcl_GetStringResult(interp)) -# define Tcl_Init(interp) (tclStubsPtr->tcl_Init(interp)) -# define Tcl_ObjSetVar2(interp, part1, part2, newValue, flags) \ - (tclStubsPtr->tcl_ObjSetVar2(interp, part1, part2, newValue, flags)) -#endif -#if defined(_WIN32) && defined(UNICODE) -# if defined(TCL_NO_DEPRECATED) -# define Tcl_FindExecutable(arg) ((Tcl_FindExecutable)((const char *)(arg))) -# else -# define Tcl_FindExecutable(arg) ((void)((Tcl_FindExecutable)((const char *)(arg)))) -# define Tcl_SetPanicProc(arg) ((void)((Tcl_SetPanicProc)(arg))) -# endif -# define Tcl_MainEx Tcl_MainExW - EXTERN void Tcl_MainExW(int argc, wchar_t **argv, - Tcl_AppInitProc *appInitProc, Tcl_Interp *interp); -#elif !defined(TCL_NO_DEPRECATED) -# define Tcl_FindExecutable(arg) ((void)((Tcl_FindExecutable)(arg))) -# define Tcl_SetPanicProc(arg) ((void)((Tcl_SetPanicProc)(arg))) +#ifdef _WIN32 +# undef Tcl_CreateFileHandler +# undef Tcl_DeleteFileHandler +# undef Tcl_GetOpenFile #endif #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLIMPORT -#undef Tcl_SeekOld -#undef Tcl_TellOld - -#undef Tcl_PkgPresent #define Tcl_PkgPresent(interp, name, version, exact) \ Tcl_PkgPresentEx(interp, name, version, exact, NULL) -#undef Tcl_PkgProvide #define Tcl_PkgProvide(interp, name, version) \ Tcl_PkgProvideEx(interp, name, version, NULL) -#undef Tcl_PkgRequire #define Tcl_PkgRequire(interp, name, version, exact) \ Tcl_PkgRequireEx(interp, name, version, exact, NULL) -#undef Tcl_GetIndexFromObj #define Tcl_GetIndexFromObj(interp, objPtr, tablePtr, msg, flags, indexPtr) \ Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, \ sizeof(char *), msg, flags, indexPtr) -#undef Tcl_NewBooleanObj #define Tcl_NewBooleanObj(intValue) \ Tcl_NewWideIntObj((intValue)!=0) -#undef Tcl_DbNewBooleanObj #define Tcl_DbNewBooleanObj(intValue, file, line) \ Tcl_DbNewWideIntObj((intValue)!=0, file, line) -#undef Tcl_SetBooleanObj #define Tcl_SetBooleanObj(objPtr, intValue) \ Tcl_SetWideIntObj(objPtr, (intValue)!=0) -#undef Tcl_SetVar #define Tcl_SetVar(interp, varName, newValue, flags) \ Tcl_SetVar2(interp, varName, NULL, newValue, flags) -#undef Tcl_UnsetVar #define Tcl_UnsetVar(interp, varName, flags) \ Tcl_UnsetVar2(interp, varName, NULL, flags) -#undef Tcl_GetVar #define Tcl_GetVar(interp, varName, flags) \ Tcl_GetVar2(interp, varName, NULL, flags) -#undef Tcl_TraceVar #define Tcl_TraceVar(interp, varName, flags, proc, clientData) \ Tcl_TraceVar2(interp, varName, NULL, flags, proc, clientData) -#undef Tcl_UntraceVar #define Tcl_UntraceVar(interp, varName, flags, proc, clientData) \ Tcl_UntraceVar2(interp, varName, NULL, flags, proc, clientData) -#undef Tcl_VarTraceInfo #define Tcl_VarTraceInfo(interp, varName, flags, proc, prevClientData) \ Tcl_VarTraceInfo2(interp, varName, NULL, flags, proc, prevClientData) -#undef Tcl_UpVar #define Tcl_UpVar(interp, frameName, varName, localName, flags) \ Tcl_UpVar2(interp, frameName, varName, NULL, localName, flags) -#undef Tcl_AddErrorInfo #define Tcl_AddErrorInfo(interp, message) \ Tcl_AppendObjToErrorInfo(interp, Tcl_NewStringObj(message, TCL_INDEX_NONE)) -#undef Tcl_AddObjErrorInfo #define Tcl_AddObjErrorInfo(interp, message, length) \ Tcl_AppendObjToErrorInfo(interp, Tcl_NewStringObj(message, length)) -#ifdef TCL_NO_DEPRECATED -#undef Tcl_FreeResult -#undef Tcl_AppendResultVA -#undef Tcl_AppendStringsToObjVA -#undef Tcl_SetErrorCodeVA -#undef Tcl_VarEvalVA -#undef Tcl_PanicVA -#undef Tcl_GetStringResult -#undef Tcl_GetDefaultEncodingDir -#undef Tcl_SetDefaultEncodingDir -#undef Tcl_UniCharNcmp -#undef Tcl_EvalTokens -#undef Tcl_UniCharNcasecmp -#undef Tcl_UniCharCaseMatch -#undef Tcl_GetMathFuncInfo -#undef Tcl_ListMathFuncs -#define Tcl_GetStringResult(interp) Tcl_GetString(Tcl_GetObjResult(interp)) -#undef Tcl_Eval #define Tcl_Eval(interp, objPtr) \ Tcl_EvalEx(interp, objPtr, TCL_INDEX_NONE, 0) -#undef Tcl_GlobalEval #define Tcl_GlobalEval(interp, objPtr) \ Tcl_EvalEx(interp, objPtr, TCL_INDEX_NONE, TCL_EVAL_GLOBAL) -#undef Tcl_SaveResult -#undef Tcl_RestoreResult -#undef Tcl_DiscardResult -#undef Tcl_SetResult +#define Tcl_GetStringResult(interp) Tcl_GetString(Tcl_GetObjResult(interp)) #define Tcl_SetResult(interp, result, freeProc) \ do { \ const char *__result = result; \ @@ -4302,13 +3947,21 @@ extern const TclStubs *tclStubsPtr; Tcl_SetObjResult(interp, Tcl_NewStringObj(__result, TCL_INDEX_NONE)); \ if (__result != NULL && __freeProc != NULL && __freeProc != TCL_VOLATILE) { \ if (__freeProc == TCL_DYNAMIC) { \ - ckfree((char *)__result); \ + Tcl_Free((char *)__result); \ } else { \ (*__freeProc)((char *)__result); \ } \ } \ } while(0) -#endif /* TCL_NO_DEPRECATED */ + +#undef Tcl_UtfToExternalDString +#define Tcl_UtfToExternalDString(encoding, src, len, ds) \ + (Tcl_UtfToExternalDStringEx((encoding), (src), (len), \ + TCL_ENCODING_NOCOMPLAIN, (ds)), Tcl_DStringValue(ds)) +#undef Tcl_ExternalToUtfDString +#define Tcl_ExternalToUtfDString(encoding, src, len, ds) \ + (Tcl_ExternalToUtfDStringEx((encoding), (src), (len), \ + TCL_ENCODING_NOCOMPLAIN, (ds)), Tcl_DStringValue(ds)) #if defined(USE_TCL_STUBS) # if defined(_WIN32) && defined(_WIN64) @@ -4339,10 +3992,6 @@ extern const TclStubs *tclStubsPtr; # undef Tcl_GetLongFromObj # undef Tcl_ExprLong # undef Tcl_ExprLongObj -# undef Tcl_UniCharNcmp -# undef Tcl_UtfNcmp -# undef Tcl_UtfNcasecmp -# undef Tcl_UniCharNcasecmp # define Tcl_GetLongFromObj ((int(*)(Tcl_Interp*,Tcl_Obj*,long*))Tcl_GetWideIntFromObj) # define Tcl_ExprLong TclExprLong static inline int TclExprLong(Tcl_Interp *interp, const char *string, long *ptr){ @@ -4358,14 +4007,6 @@ extern const TclStubs *tclStubsPtr; if (result == TCL_OK) *ptr = (long)intValue; return result; } -# define Tcl_UniCharNcmp(ucs,uct,n) \ - ((int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned int))tclStubsPtr->tcl_UniCharNcmp)(ucs,uct,(unsigned int)(n)) -# define Tcl_UtfNcmp(s1,s2,n) \ - ((int(*)(const char*,const char*,unsigned int))tclStubsPtr->tcl_UtfNcmp)(s1,s2,(unsigned int)(n)) -# define Tcl_UtfNcasecmp(s1,s2,n) \ - ((int(*)(const char*,const char*,unsigned int))tclStubsPtr->tcl_UtfNcasecmp)(s1,s2,(unsigned int)(n)) -# define Tcl_UniCharNcasecmp(ucs,uct,n) \ - ((int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned int))tclStubsPtr->tcl_UniCharNcasecmp)(ucs,uct,(unsigned int)(n)) # endif #endif @@ -4379,64 +4020,95 @@ extern const TclStubs *tclStubsPtr; #undef Tcl_GetIndexFromObjStruct #undef Tcl_GetBooleanFromObj #undef Tcl_GetBoolean -#ifdef TCL_NO_DEPRECATED #undef Tcl_GetStringFromObj #undef Tcl_GetUnicodeFromObj +#undef TclGetByteArrayFromObj #undef Tcl_GetByteArrayFromObj -#endif #if defined(USE_TCL_STUBS) #define Tcl_GetBytesFromObj(interp, objPtr, sizePtr) \ - (sizeof(*(sizePtr)) <= sizeof(int) ? tclStubsPtr->tclGetBytesFromObj(interp, objPtr, (int *)(sizePtr)) : tclStubsPtr->tcl_GetBytesFromObj(interp, objPtr, (size_t *)(sizePtr))) + (sizeof(*(sizePtr)) <= sizeof(int) ? \ + tclStubsPtr->tclGetBytesFromObj(interp, objPtr, (int *)(void *)(sizePtr)) : \ + tclStubsPtr->tcl_GetBytesFromObj(interp, objPtr, (size_t *)(void *)(sizePtr))) #define Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags, indexPtr) \ - (tclStubsPtr->tcl_GetIndexFromObjStruct((interp), (objPtr), (tablePtr), (offset), (msg), (flags)|(int)(sizeof(*(indexPtr))<<1), (indexPtr))) + (tclStubsPtr->tcl_GetIndexFromObjStruct((interp), (objPtr), (tablePtr), (offset), (msg), \ + (flags)|(int)(sizeof(*(indexPtr))<<1), (indexPtr))) #define Tcl_GetBooleanFromObj(interp, objPtr, boolPtr) \ - (sizeof(*(boolPtr)) == sizeof(int) ? tclStubsPtr->tcl_GetBooleanFromObj(interp, objPtr, (int *)(boolPtr)) : \ + ((sizeof(*(boolPtr)) == sizeof(int) && (TCL_MAJOR_VERSION == 8)) ? tclStubsPtr->tcl_GetBooleanFromObj(interp, objPtr, (int *)(boolPtr)) : \ Tcl_GetBoolFromObj(interp, objPtr, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr))) #define Tcl_GetBoolean(interp, src, boolPtr) \ - (sizeof(*(boolPtr)) == sizeof(int) ? tclStubsPtr->tcl_GetBoolean(interp, src, (int *)(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))) -#ifdef TCL_NO_DEPRECATED #define Tcl_GetStringFromObj(objPtr, sizePtr) \ - (sizeof(*(sizePtr)) <= sizeof(int) ? tclStubsPtr->tcl_GetStringFromObj(objPtr, (int *)(sizePtr)) : tclStubsPtr->tclGetStringFromObj(objPtr, (size_t *)(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->tcl_GetByteArrayFromObj(objPtr, (int *)(sizePtr)) : tclStubsPtr->tclGetByteArrayFromObj(objPtr, (size_t *)(sizePtr))) -#define Tcl_GetUnicodeFromObj(objPtr, sizePtr) \ - (sizeof(*(sizePtr)) <= sizeof(int) ? tclStubsPtr->tcl_GetUnicodeFromObj(objPtr, (int *)(sizePtr)) : tclStubsPtr->tclGetUnicodeFromObj(objPtr, (size_t *)(sizePtr))) + (sizeof(*(sizePtr)) <= sizeof(int) ? \ + tclStubsPtr->tclGetBytesFromObj(NULL, objPtr, (int *)(void *)(sizePtr)) : \ + tclStubsPtr->tcl_GetBytesFromObj(NULL, objPtr, (size_t *)(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))) #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 *)(sizePtr)) : (Tcl_GetBytesFromObj)(interp, objPtr, (size_t *)(sizePtr))) + (sizeof(*(sizePtr)) <= sizeof(int) ? \ + TclGetBytesFromObj(interp, objPtr, (int *)(void *)(sizePtr)) : \ + (Tcl_GetBytesFromObj)(interp, objPtr, (size_t *)(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))) + ((Tcl_GetIndexFromObjStruct)((interp), (objPtr), (tablePtr), (offset), (msg), \ + (flags)|(int)(sizeof(*(indexPtr))<<1), (indexPtr))) #define Tcl_GetBooleanFromObj(interp, objPtr, boolPtr) \ - (sizeof(*(boolPtr)) == sizeof(int) ? Tcl_GetBooleanFromObj(interp, objPtr, (int *)(boolPtr)) : \ + ((sizeof(*(boolPtr)) == sizeof(int) && (TCL_MAJOR_VERSION == 8)) ? Tcl_GetBooleanFromObj(interp, objPtr, (int *)(boolPtr)) : \ Tcl_GetBoolFromObj(interp, objPtr, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr))) #define Tcl_GetBoolean(interp, src, boolPtr) \ - (sizeof(*(boolPtr)) == sizeof(int) ? Tcl_GetBoolean(interp, src, (int *)(boolPtr)) : \ + ((sizeof(*(boolPtr)) == sizeof(int) && (TCL_MAJOR_VERSION == 8)) ? Tcl_GetBoolean(interp, src, (int *)(boolPtr)) : \ Tcl_GetBool(interp, src, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr))) -#ifdef TCL_NO_DEPRECATED #define Tcl_GetStringFromObj(objPtr, sizePtr) \ - (sizeof(*(sizePtr)) <= sizeof(int) ? (Tcl_GetStringFromObj)(objPtr, (int *)(sizePtr)) : (TclGetStringFromObj)(objPtr, (size_t *)(sizePtr))) + (sizeof(*(sizePtr)) <= sizeof(int) ? \ + TclGetStringFromObj(objPtr, (int *)(void *)(sizePtr)) : \ + (Tcl_GetStringFromObj)(objPtr, (size_t *)(void *)(sizePtr))) #define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \ - (sizeof(*(sizePtr)) <= sizeof(int) ? (Tcl_GetByteArrayFromObj)(objPtr, (int *)(sizePtr)) : TclGetByteArrayFromObj(objPtr, (size_t *)(sizePtr))) + (sizeof(*(sizePtr)) <= sizeof(int) ? \ + TclGetBytesFromObj(NULL, objPtr, (int *)(void *)(sizePtr)) : \ + (Tcl_GetBytesFromObj)(NULL, objPtr, (size_t *)(void *)(sizePtr))) #define Tcl_GetUnicodeFromObj(objPtr, sizePtr) \ - (sizeof(*(sizePtr)) <= sizeof(int) ? (Tcl_GetUnicodeFromObj)(objPtr, (int *)(sizePtr)) : TclGetUnicodeFromObj(objPtr, (size_t *)(sizePtr))) -#endif + (sizeof(*(sizePtr)) <= sizeof(int) ? \ + TclGetUnicodeFromObj(objPtr, (int *)(void *)(sizePtr)) : \ + (Tcl_GetUnicodeFromObj)(objPtr, (size_t *)(void *)(sizePtr))) #endif -#undef Tcl_NewLongObj +#ifdef TCL_MEM_DEBUG +# undef Tcl_Alloc +# define Tcl_Alloc(x) \ + (Tcl_DbCkalloc((x), __FILE__, __LINE__)) +# undef Tcl_Free +# define Tcl_Free(x) \ + Tcl_DbCkfree((x), __FILE__, __LINE__) +# undef Tcl_Realloc +# define Tcl_Realloc(x,y) \ + (Tcl_DbCkrealloc((x), (y), __FILE__, __LINE__)) +# undef Tcl_AttemptAlloc +# define Tcl_AttemptAlloc(x) \ + (Tcl_AttemptDbCkalloc((x), __FILE__, __LINE__)) +# undef Tcl_AttemptRealloc +# define Tcl_AttemptRealloc(x,y) \ + (Tcl_AttemptDbCkrealloc((x), (y), __FILE__, __LINE__)) +#endif /* !TCL_MEM_DEBUG */ + #define Tcl_NewLongObj(value) Tcl_NewWideIntObj((long)(value)) -#undef Tcl_NewIntObj #define Tcl_NewIntObj(value) Tcl_NewWideIntObj((int)(value)) -#undef Tcl_DbNewLongObj #define Tcl_DbNewLongObj(value, file, line) Tcl_DbNewWideIntObj((long)(value), file, line) -#undef Tcl_SetIntObj #define Tcl_SetIntObj(objPtr, value) Tcl_SetWideIntObj((objPtr), (int)(value)) -#undef Tcl_SetLongObj #define Tcl_SetLongObj(objPtr, value) Tcl_SetWideIntObj((objPtr), (long)(value)) -#undef Tcl_BackgroundError #define Tcl_BackgroundError(interp) Tcl_BackgroundException((interp), TCL_ERROR) -#undef Tcl_StringMatch #define Tcl_StringMatch(str, pattern) Tcl_StringCaseMatch((str), (pattern), 0) #if TCL_UTF_MAX < 4 @@ -4448,7 +4120,15 @@ extern const TclStubs *tclStubsPtr; # define Tcl_UtfToUniChar Tcl_UtfToChar16 # undef Tcl_UniCharLen # define Tcl_UniCharLen Tcl_Char16Len -#elif !defined(BUILD_tcl) +# undef Tcl_UniCharToUtf +# if defined(USE_TCL_STUBS) +# define Tcl_UniCharToUtf(c, p) \ + (tclStubsPtr->tcl_UniCharToUtf((c)|TCL_COMBINE, (p))) +# else +# define Tcl_UniCharToUtf(c, p) \ + ((Tcl_UniCharToUtf)((c)|TCL_COMBINE, (p))) +# endif +#if !defined(BUILD_tcl) # undef Tcl_NumUtfChars # define Tcl_NumUtfChars TclNumUtfChars # undef Tcl_GetCharLength @@ -4460,6 +4140,7 @@ extern const TclStubs *tclStubsPtr; # undef Tcl_GetUniChar # define Tcl_GetUniChar TclGetUniChar #endif +#endif #if defined(USE_TCL_STUBS) # define Tcl_WCharToUtfDString (sizeof(wchar_t) != sizeof(short) \ ? (char *(*)(const wchar_t *, Tcl_Size, Tcl_DString *))tclStubsPtr->tcl_UniCharToUtfDString \ @@ -4468,41 +4149,39 @@ extern const TclStubs *tclStubsPtr; ? (wchar_t *(*)(const char *, Tcl_Size, Tcl_DString *))tclStubsPtr->tcl_UtfToUniCharDString \ : (wchar_t *(*)(const char *, Tcl_Size, Tcl_DString *))Tcl_UtfToChar16DString) # define Tcl_UtfToWChar (sizeof(wchar_t) != sizeof(short) \ - ? (int (*)(const char *, wchar_t *))tclStubsPtr->tcl_UtfToUniChar \ - : (int (*)(const char *, wchar_t *))Tcl_UtfToChar16) + ? (Tcl_Size (*)(const char *, wchar_t *))tclStubsPtr->tcl_UtfToUniChar \ + : (Tcl_Size (*)(const char *, wchar_t *))Tcl_UtfToChar16) # define Tcl_WCharLen (sizeof(wchar_t) != sizeof(short) \ ? (Tcl_Size (*)(wchar_t *))tclStubsPtr->tcl_UniCharLen \ : (Tcl_Size (*)(wchar_t *))Tcl_Char16Len) -#ifdef TCL_NO_DEPRECATED # undef Tcl_ListObjGetElements # define Tcl_ListObjGetElements(interp, listPtr, objcPtr, objvPtr) (sizeof(*(objcPtr)) == sizeof(int) \ - ? tclStubsPtr->tcl_ListObjGetElements((interp), (listPtr), (int *)(void *)(objcPtr), (objvPtr)) \ - : tclStubsPtr->tclListObjGetElements((interp), (listPtr), (size_t *)(void *)(objcPtr), (objvPtr))) + ? tclStubsPtr->tclListObjGetElements((interp), (listPtr), (int *)(void *)(objcPtr), (objvPtr)) \ + : tclStubsPtr->tcl_ListObjGetElements((interp), (listPtr), (size_t *)(void *)(objcPtr), (objvPtr))) # undef Tcl_ListObjLength # define Tcl_ListObjLength(interp, listPtr, lengthPtr) (sizeof(*(lengthPtr)) == sizeof(int) \ - ? tclStubsPtr->tcl_ListObjLength((interp), (listPtr), (int *)(void *)(lengthPtr)) \ - : tclStubsPtr->tclListObjLength((interp), (listPtr), (size_t *)(void *)(lengthPtr))) + ? tclStubsPtr->tclListObjLength((interp), (listPtr), (int *)(void *)(lengthPtr)) \ + : tclStubsPtr->tcl_ListObjLength((interp), (listPtr), (size_t *)(void *)(lengthPtr))) # undef Tcl_DictObjSize # define Tcl_DictObjSize(interp, dictPtr, sizePtr) (sizeof(*(sizePtr)) == sizeof(int) \ - ? tclStubsPtr->tcl_DictObjSize((interp), (dictPtr), (int *)(void *)(sizePtr)) \ - : tclStubsPtr->tclDictObjSize((interp), (dictPtr), (size_t *)(void *)(sizePtr))) + ? tclStubsPtr->tclDictObjSize((interp), (dictPtr), (int *)(void *)(sizePtr)) \ + : tclStubsPtr->tcl_DictObjSize((interp), (dictPtr), (size_t *)(void *)(sizePtr))) # undef Tcl_SplitList # define Tcl_SplitList(interp, listStr, argcPtr, argvPtr) (sizeof(*(argcPtr)) == sizeof(int) \ - ? tclStubsPtr->tcl_SplitList((interp), (listStr), (int *)(void *)(argcPtr), (argvPtr)) \ - : tclStubsPtr->tclSplitList((interp), (listStr), (size_t *)(void *)(argcPtr), (argvPtr))) + ? tclStubsPtr->tclSplitList((interp), (listStr), (int *)(void *)(argcPtr), (argvPtr)) \ + : tclStubsPtr->tcl_SplitList((interp), (listStr), (size_t *)(void *)(argcPtr), (argvPtr))) # undef Tcl_SplitPath # define Tcl_SplitPath(path, argcPtr, argvPtr) (sizeof(*(argcPtr)) == sizeof(int) \ - ? tclStubsPtr->tcl_SplitPath((path), (int *)(void *)(argcPtr), (argvPtr)) \ - : tclStubsPtr->tclSplitPath((path), (size_t *)(void *)(argcPtr), (argvPtr))) + ? tclStubsPtr->tclSplitPath((path), (int *)(void *)(argcPtr), (argvPtr)) \ + : tclStubsPtr->tcl_SplitPath((path), (size_t *)(void *)(argcPtr), (argvPtr))) # undef Tcl_FSSplitPath # define Tcl_FSSplitPath(pathPtr, lenPtr) (sizeof(*(lenPtr)) == sizeof(int) \ - ? tclStubsPtr->tcl_FSSplitPath((pathPtr), (int *)(void *)(lenPtr)) \ - : tclStubsPtr->tclFSSplitPath((pathPtr), (size_t *)(void *)(lenPtr))) + ? tclStubsPtr->tclFSSplitPath((pathPtr), (int *)(void *)(lenPtr)) \ + : tclStubsPtr->tcl_FSSplitPath((pathPtr), (size_t *)(void *)(lenPtr))) # undef Tcl_ParseArgsObjv # define Tcl_ParseArgsObjv(interp, argTable, objcPtr, objv, remObjv) (sizeof(*(objcPtr)) == sizeof(int) \ - ? tclStubsPtr->tcl_ParseArgsObjv((interp), (argTable), (int *)(void *)(objcPtr), (objv), (remObjv)) \ - : tclStubsPtr->tclParseArgsObjv((interp), (argTable), (size_t *)(void *)(objcPtr), (objv), (remObjv))) -#endif /* TCL_NO_DEPRECATED */ + ? tclStubsPtr->tclParseArgsObjv((interp), (argTable), (int *)(void *)(objcPtr), (objv), (remObjv)) \ + : tclStubsPtr->tcl_ParseArgsObjv((interp), (argTable), (size_t *)(void *)(objcPtr), (objv), (remObjv))) #else # define Tcl_WCharToUtfDString (sizeof(wchar_t) != sizeof(short) \ ? (char *(*)(const wchar_t *, Tcl_Size, Tcl_DString *))Tcl_UniCharToUtfDString \ @@ -4511,68 +4190,93 @@ extern const TclStubs *tclStubsPtr; ? (wchar_t *(*)(const char *, Tcl_Size, Tcl_DString *))Tcl_UtfToUniCharDString \ : (wchar_t *(*)(const char *, Tcl_Size, Tcl_DString *))Tcl_UtfToChar16DString) # define Tcl_UtfToWChar (sizeof(wchar_t) != sizeof(short) \ - ? (int (*)(const char *, wchar_t *))Tcl_UtfToUniChar \ - : (int (*)(const char *, wchar_t *))Tcl_UtfToChar16) + ? (Tcl_Size (*)(const char *, wchar_t *))Tcl_UtfToUniChar \ + : (Tcl_Size (*)(const char *, wchar_t *))Tcl_UtfToChar16) # define Tcl_WCharLen (sizeof(wchar_t) != sizeof(short) \ ? (Tcl_Size (*)(wchar_t *))Tcl_UniCharLen \ : (Tcl_Size (*)(wchar_t *))Tcl_Char16Len) -#ifdef TCL_NO_DEPRECATED +#if !defined(BUILD_tcl) # define Tcl_ListObjGetElements(interp, listPtr, objcPtr, objvPtr) (sizeof(*(objcPtr)) == sizeof(int) \ - ? (Tcl_ListObjGetElements)((interp), (listPtr), (int *)(void *)(objcPtr), (objvPtr)) \ - : TclListObjGetElements((interp), (listPtr), (size_t *)(void *)(objcPtr), (objvPtr))) + ? TclListObjGetElements((interp), (listPtr), (int *)(void *)(objcPtr), (objvPtr)) \ + : (Tcl_ListObjGetElements)((interp), (listPtr), (size_t *)(void *)(objcPtr), (objvPtr))) # define Tcl_ListObjLength(interp, listPtr, lengthPtr) (sizeof(*(lengthPtr)) == sizeof(int) \ - ? (Tcl_ListObjLength)((interp), (listPtr), (int *)(void *)(lengthPtr)) \ - : TclListObjLength((interp), (listPtr), (size_t *)(void *)(lengthPtr))) + ? TclListObjLength((interp), (listPtr), (int *)(void *)(lengthPtr)) \ + : (Tcl_ListObjLength)((interp), (listPtr), (size_t *)(void *)(lengthPtr))) # define Tcl_DictObjSize(interp, dictPtr, sizePtr) (sizeof(*(sizePtr)) == sizeof(int) \ - ? (Tcl_DictObjSize)((interp), (dictPtr), (int *)(void *)(sizePtr)) \ - : TclDictObjSize((interp), (dictPtr), (size_t *)(void *)(sizePtr))) + ? TclDictObjSize((interp), (dictPtr), (int *)(void *)(sizePtr)) \ + : (Tcl_DictObjSize)((interp), (dictPtr), (size_t *)(void *)(sizePtr))) # define Tcl_SplitList(interp, listStr, argcPtr, argvPtr) (sizeof(*(argcPtr)) == sizeof(int) \ - ? (Tcl_SplitList)((interp), (listStr), (int *)(void *)(argcPtr), (argvPtr)) \ - : TclSplitList((interp), (listStr), (size_t *)(void *)(argcPtr), (argvPtr))) + ? TclSplitList((interp), (listStr), (int *)(void *)(argcPtr), (argvPtr)) \ + : (Tcl_SplitList)((interp), (listStr), (size_t *)(void *)(argcPtr), (argvPtr))) # define Tcl_SplitPath(path, argcPtr, argvPtr) (sizeof(*(argcPtr)) == sizeof(int) \ - ? (Tcl_SplitPath)((path), (int *)(void *)(argcPtr), (argvPtr)) \ - : TclSplitPath((path), (size_t *)(void *)(argcPtr), (argvPtr))) + ? TclSplitPath((path), (int *)(void *)(argcPtr), (argvPtr)) \ + : (Tcl_SplitPath)((path), (size_t *)(void *)(argcPtr), (argvPtr))) # define Tcl_FSSplitPath(pathPtr, lenPtr) (sizeof(*(lenPtr)) == sizeof(int) \ - ? (Tcl_FSSplitPath)((pathPtr), (int *)(void *)(lenPtr)) \ - : TclFSSplitPath((pathPtr), (size_t *)(void *)(lenPtr))) + ? TclFSSplitPath((pathPtr), (int *)(void *)(lenPtr)) \ + : (Tcl_FSSplitPath)((pathPtr), (size_t *)(void *)(lenPtr))) # define Tcl_ParseArgsObjv(interp, argTable, objcPtr, objv, remObjv) (sizeof(*(objcPtr)) == sizeof(int) \ - ? (Tcl_ParseArgsObjv)((interp), (argTable), (int *)(void *)(objcPtr), (objv), (remObjv)) \ - : TclParseArgsObjv((interp), (argTable), (size_t *)(void *)(objcPtr), (objv), (remObjv))) -#endif /* TCL_NO_DEPRECATED */ + ? TclParseArgsObjv((interp), (argTable), (int *)(void *)(objcPtr), (objv), (remObjv)) \ + : (Tcl_ParseArgsObjv)((interp), (argTable), (size_t *)(void *)(objcPtr), (objv), (remObjv))) +#endif /* !defined(BUILD_tcl) */ #endif /* * Deprecated Tcl procedures: */ -#ifdef TCL_NO_DEPRECATED -# undef Tcl_SavedResult -#endif /* TCL_NO_DEPRECATED */ -#undef Tcl_EvalObj #define Tcl_EvalObj(interp, objPtr) \ Tcl_EvalObjEx(interp, objPtr, 0) -#undef Tcl_GlobalEvalObj #define Tcl_GlobalEvalObj(interp, objPtr) \ Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL) -#if defined(TCL_NO_DEPRECATED) && defined(USE_TCL_STUBS) -#undef Tcl_Close -#define Tcl_Close(interp, chan) Tcl_CloseEx(interp, chan, 0) +#if defined(TCL_8_COMPAT) && !defined(BUILD_tcl) +# 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) #endif #undef TclUtfCharComplete #undef TclUtfNext #undef TclUtfPrev -#if defined(USE_TCL_STUBS) && (TCL_UTF_MAX < 4) && !defined(TCL_NO_DEPRECATED) -# undef Tcl_UtfCharComplete -# undef Tcl_UtfNext -# undef Tcl_UtfPrev -# define Tcl_UtfCharComplete (tclStubsPtr->tclUtfCharComplete) -# define Tcl_UtfNext (tclStubsPtr->tclUtfNext) -# define Tcl_UtfPrev (tclStubsPtr->tclUtfPrev) +#ifndef TCL_NO_DEPRECATED +# define Tcl_CreateSlave Tcl_CreateChild +# define Tcl_GetSlave Tcl_GetChild +# define Tcl_GetMaster Tcl_GetParent #endif -#define Tcl_CreateSlave Tcl_CreateChild -#define Tcl_GetSlave Tcl_GetChild -#define Tcl_GetMaster Tcl_GetParent #endif /* _TCLDECLS */ diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index 55664ce..26f98e1 100644 --- a/generic/tclDictObj.c +++ b/generic/tclDictObj.c @@ -146,7 +146,8 @@ const Tcl_ObjType tclDictType = { FreeDictInternalRep, /* freeIntRepProc */ DupDictInternalRep, /* dupIntRepProc */ UpdateStringOfDict, /* updateStringProc */ - SetDictFromAny /* setFromAnyProc */ + SetDictFromAny, /* setFromAnyProc */ + TCL_OBJTYPE_V0 }; #define DictSetInternalRep(objPtr, dictRepPtr) \ @@ -228,7 +229,7 @@ AllocChainEntry( Tcl_Obj *objPtr = (Tcl_Obj *)keyPtr; ChainEntry *cPtr; - cPtr = (ChainEntry *)ckalloc(sizeof(ChainEntry)); + cPtr = (ChainEntry *)Tcl_Alloc(sizeof(ChainEntry)); cPtr->entry.key.objPtr = objPtr; Tcl_IncrRefCount(objPtr); Tcl_SetHashValue(&cPtr->entry, NULL); @@ -359,7 +360,7 @@ DupDictInternalRep( Tcl_Obj *srcPtr, Tcl_Obj *copyPtr) { - Dict *oldDict, *newDict = (Dict *)ckalloc(sizeof(Dict)); + Dict *oldDict, *newDict = (Dict *)Tcl_Alloc(sizeof(Dict)); ChainEntry *cPtr; DictGetInternalRep(srcPtr, oldDict); @@ -454,7 +455,7 @@ DeleteDict( Dict *dict) { DeleteChainTable(dict); - ckfree(dict); + Tcl_Free(dict); } /* @@ -488,7 +489,7 @@ UpdateStringOfDict( Dict *dict; ChainEntry *cPtr; Tcl_Obj *keyPtr, *valuePtr; - int i, length; + size_t i, length; TCL_HASH_TYPE bytesNeeded = 0; const char *elem; char *dst; @@ -498,7 +499,7 @@ UpdateStringOfDict( * is not exposed by any API function... */ - int numElems; + size_t numElems; DictGetInternalRep(dictPtr, dict); @@ -519,7 +520,7 @@ UpdateStringOfDict( if (numElems <= LOCAL_SIZE) { flagPtr = localFlags; } else { - flagPtr = (char *)ckalloc(numElems); + flagPtr = (char *)Tcl_Alloc(numElems); } for (i=0,cPtr=dict->entryChainHead; i<numElems; i+=2,cPtr=cPtr->nextPtr) { /* @@ -529,22 +530,12 @@ UpdateStringOfDict( flagPtr[i] = ( i ? TCL_DONT_QUOTE_HASH : 0 ); keyPtr = (Tcl_Obj *)Tcl_GetHashKey(&dict->table, &cPtr->entry); - elem = TclGetStringFromObj(keyPtr, &length); + elem = Tcl_GetStringFromObj(keyPtr, &length); bytesNeeded += TclScanElement(elem, length, flagPtr+i); - if (bytesNeeded > INT_MAX) { - Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); - } - flagPtr[i+1] = TCL_DONT_QUOTE_HASH; valuePtr = (Tcl_Obj *)Tcl_GetHashValue(&cPtr->entry); - elem = TclGetStringFromObj(valuePtr, &length); + elem = Tcl_GetStringFromObj(valuePtr, &length); bytesNeeded += TclScanElement(elem, length, flagPtr+i+1); - if (bytesNeeded > INT_MAX) { - Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); - } - } - if (bytesNeeded + numElems > INT_MAX + 1U) { - Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); } bytesNeeded += numElems; @@ -557,13 +548,13 @@ UpdateStringOfDict( for (i=0,cPtr=dict->entryChainHead; i<numElems; i+=2,cPtr=cPtr->nextPtr) { flagPtr[i] |= ( i ? TCL_DONT_QUOTE_HASH : 0 ); keyPtr = (Tcl_Obj *)Tcl_GetHashKey(&dict->table, &cPtr->entry); - elem = TclGetStringFromObj(keyPtr, &length); + elem = Tcl_GetStringFromObj(keyPtr, &length); dst += TclConvertElement(elem, length, dst, flagPtr[i]); *dst++ = ' '; flagPtr[i+1] |= TCL_DONT_QUOTE_HASH; valuePtr = (Tcl_Obj *)Tcl_GetHashValue(&cPtr->entry); - elem = TclGetStringFromObj(valuePtr, &length); + elem = Tcl_GetStringFromObj(valuePtr, &length); dst += TclConvertElement(elem, length, dst, flagPtr[i+1]); *dst++ = ' '; } @@ -571,7 +562,7 @@ UpdateStringOfDict( (void)Tcl_InitStringRep(dictPtr, NULL, bytesNeeded - 1); if (flagPtr != localFlags) { - ckfree(flagPtr); + Tcl_Free(flagPtr); } } @@ -602,7 +593,7 @@ SetDictFromAny( { Tcl_HashEntry *hPtr; int isNew; - Dict *dict = (Dict *)ckalloc(sizeof(Dict)); + Dict *dict = (Dict *)Tcl_Alloc(sizeof(Dict)); InitChainTable(dict); @@ -613,7 +604,7 @@ SetDictFromAny( */ if (TclHasInternalRep(objPtr, &tclListType)) { - int objc, i; + size_t objc, i; Tcl_Obj **objv; /* Cannot fail, we already know the Tcl_ObjType is "list". */ @@ -635,7 +626,7 @@ SetDictFromAny( * convert back. */ - (void) Tcl_GetString(objPtr); + (void) TclGetString(objPtr); TclDecrRefCount(discardedValue); } @@ -643,14 +634,14 @@ SetDictFromAny( Tcl_IncrRefCount(objv[i+1]); /* Since hash now holds ref to it */ } } else { - int length; - const char *nextElem = TclGetStringFromObj(objPtr, &length); + size_t length; + const char *nextElem = Tcl_GetStringFromObj(objPtr, &length); const char *limit = (nextElem + length); while (nextElem < limit) { Tcl_Obj *keyPtr, *valuePtr; const char *elemStart; - int elemSize; + size_t elemSize; int literal; if (TclFindDictElement(interp, nextElem, (limit - nextElem), @@ -731,7 +722,7 @@ SetDictFromAny( } errorInFindDictElement: DeleteChainTable(dict); - ckfree(dict); + Tcl_Free(dict); return TCL_ERROR; } @@ -788,12 +779,12 @@ Tcl_Obj * TclTraceDictPath( Tcl_Interp *interp, Tcl_Obj *dictPtr, - int keyc, + size_t keyc, Tcl_Obj *const keyv[], int flags) { Dict *dict, *newDict; - int i; + size_t i; DictGetInternalRep(dictPtr, dict); if (dict == NULL) { @@ -1077,7 +1068,7 @@ int Tcl_DictObjSize( Tcl_Interp *interp, Tcl_Obj *dictPtr, - int *sizePtr) + size_t *sizePtr) { Dict *dict; @@ -1290,7 +1281,7 @@ int Tcl_DictObjPutKeyList( Tcl_Interp *interp, Tcl_Obj *dictPtr, - int keyc, + size_t keyc, Tcl_Obj *const keyv[], Tcl_Obj *valuePtr) { @@ -1301,7 +1292,7 @@ Tcl_DictObjPutKeyList( if (Tcl_IsShared(dictPtr)) { Tcl_Panic("%s called with shared object", "Tcl_DictObjPutKeyList"); } - if (keyc < 1) { + if (keyc + 1 < 2) { Tcl_Panic("%s called with empty key list", "Tcl_DictObjPutKeyList"); } @@ -1351,7 +1342,7 @@ int Tcl_DictObjRemoveKeyList( Tcl_Interp *interp, Tcl_Obj *dictPtr, - int keyc, + size_t keyc, Tcl_Obj *const keyv[]) { Dict *dict; @@ -1410,7 +1401,7 @@ Tcl_NewDictObj(void) TclNewObj(dictPtr); TclInvalidateStringRep(dictPtr); - dict = (Dict *)ckalloc(sizeof(Dict)); + dict = (Dict *)Tcl_Alloc(sizeof(Dict)); InitChainTable(dict); dict->epoch = 1; dict->chain = NULL; @@ -1458,7 +1449,7 @@ Tcl_DbNewDictObj( TclDbNewObj(dictPtr, file, line); TclInvalidateStringRep(dictPtr); - dict = (Dict *)ckalloc(sizeof(Dict)); + dict = (Dict *)Tcl_Alloc(sizeof(Dict)); InitChainTable(dict); dict->epoch = 1; dict->chain = NULL; @@ -2034,7 +2025,7 @@ DictSizeCmd( Tcl_Obj *const *objv) { int result; - int size; + size_t size; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "dictionary"); @@ -2129,7 +2120,7 @@ DictInfoCmd( statsStr = Tcl_HashStats(&dict->table); Tcl_SetObjResult(interp, Tcl_NewStringObj(statsStr, -1)); - ckfree(statsStr); + Tcl_Free(statsStr); return TCL_OK; } @@ -2472,7 +2463,7 @@ DictForNRCmd( Tcl_Obj *scriptObj, *keyVarObj, *valueVarObj; Tcl_Obj **varv, *keyObj, *valueObj; Tcl_DictSearch *searchPtr; - int varc; + size_t varc; int done; if (objc != 4) { @@ -2667,7 +2658,7 @@ DictMapNRCmd( Interp *iPtr = (Interp *) interp; Tcl_Obj **varv, *keyObj, *valueObj; DictMapStorage *storagePtr; - int varc; + size_t varc; int done; if (objc != 4) { @@ -3002,12 +2993,12 @@ DictFilterCmd( }; enum FilterTypes { FILTER_KEYS, FILTER_SCRIPT, FILTER_VALUES - }; + } index; Tcl_Obj *scriptObj, *keyVarObj, *valueVarObj; Tcl_Obj **varv, *keyObj = NULL, *valueObj = NULL, *resultObj, *boolObj; Tcl_DictSearch search; - int index, done, result, satisfied; - int varc; + int done, result, satisfied; + size_t varc; const char *pattern; if (objc < 3) { @@ -3019,7 +3010,7 @@ DictFilterCmd( return TCL_ERROR; } - switch ((enum FilterTypes) index) { + switch (index) { case FILTER_KEYS: /* * Create a dictionary whose keys all match a certain pattern. @@ -3285,7 +3276,7 @@ DictUpdateCmd( Interp *iPtr = (Interp *) interp; Tcl_Obj *dictPtr, *objPtr; int i; - int dummy; + size_t dummy; if (objc < 5 || !(objc & 1)) { Tcl_WrongNumArgs(interp, 1, objv, @@ -3308,7 +3299,7 @@ DictUpdateCmd( } if (objPtr == NULL) { /* ??? */ - Tcl_UnsetVar2(interp, Tcl_GetString(objv[i+1]), NULL, 0); + Tcl_UnsetVar2(interp, TclGetString(objv[i+1]), NULL, 0); } else if (Tcl_ObjSetVar2(interp, objv[i+1], NULL, objPtr, TCL_LEAVE_ERR_MSG) == NULL) { TclDecrRefCount(dictPtr); @@ -3338,7 +3329,7 @@ FinalizeDictUpdate( { Tcl_Obj *dictPtr, *objPtr, **objv; Tcl_InterpState state; - int i, objc; + size_t i, objc; Tcl_Obj *varName = (Tcl_Obj *)data[0]; Tcl_Obj *argsObj = (Tcl_Obj *)data[1]; @@ -3488,7 +3479,7 @@ FinalizeDictWith( int result) { Tcl_Obj **pathv; - int pathc; + size_t pathc; Tcl_InterpState state; Tcl_Obj *varName = (Tcl_Obj *)data[0]; Tcl_Obj *keysPtr = (Tcl_Obj *)data[1]; @@ -3565,14 +3556,14 @@ Tcl_Obj * TclDictWithInit( Tcl_Interp *interp, Tcl_Obj *dictPtr, - int pathc, + size_t pathc, Tcl_Obj *const pathv[]) { Tcl_DictSearch s; Tcl_Obj *keyPtr, *valPtr, *keysPtr; int done; - if (pathc > 0) { + if (pathc + 1 > 1) { dictPtr = TclTraceDictPath(interp, dictPtr, pathc, pathv, DICT_PATH_READ); if (dictPtr == NULL) { @@ -3652,7 +3643,7 @@ TclDictWithFinish( * the result value from TclDictWithInit. */ { Tcl_Obj *dictPtr, *leafPtr, *valPtr; - int i, allocdict, keyc; + size_t i, allocdict, keyc; Tcl_Obj **keyv; /* diff --git a/generic/tclDisassemble.c b/generic/tclDisassemble.c index 0bc3de1..57adcf0 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, int maxChars); + const char *stringPtr, size_t maxChars); static void UpdateStringOfInstName(Tcl_Obj *objPtr); /* @@ -42,6 +42,7 @@ static const Tcl_ObjType instNameType = { NULL, /* dupIntRepProc */ UpdateStringOfInstName, /* updateStringProc */ NULL, /* setFromAnyProc */ + TCL_OBJTYPE_V0 }; #define InstNameSetInternalRep(objPtr, inst) \ @@ -56,7 +57,7 @@ static const Tcl_ObjType instNameType = { const Tcl_ObjInternalRep *irPtr; \ irPtr = TclFetchInternalRep((objPtr), &instNameType); \ assert(irPtr != NULL); \ - (inst) = (size_t)irPtr->wideValue; \ + (inst) = irPtr->wideValue; \ } while (0) @@ -193,12 +194,12 @@ TclPrintObject( FILE *outFile, /* The file to print the source to. */ Tcl_Obj *objPtr, /* Points to the Tcl object whose string * representation should be printed. */ - int maxChars) /* Maximum number of chars to print. */ + size_t maxChars) /* Maximum number of chars to print. */ { char *bytes; - int length; + size_t length; - bytes = TclGetStringFromObj(objPtr, &length); + bytes = Tcl_GetStringFromObj(objPtr, &length); TclPrintSource(outFile, bytes, TclMin(length, maxChars)); } @@ -224,7 +225,7 @@ void TclPrintSource( FILE *outFile, /* The file to print the source to. */ const char *stringPtr, /* The string to print. */ - int maxChars) /* Maximum number of chars to print. */ + size_t maxChars) /* Maximum number of chars to print. */ { Tcl_Obj *bufferObj; @@ -277,19 +278,18 @@ DisassembleByteCodeObj( */ Tcl_AppendPrintfToObj(bufferObj, - "ByteCode %p, refCt %u, epoch %u, interp %p (epoch %u)\n", - codePtr, codePtr->refCount, codePtr->compileEpoch, iPtr, - iPtr->compileEpoch); + "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 ", -1); PrintSourceToObj(bufferObj, codePtr->source, TclMin(codePtr->numSrcBytes, 55)); GetLocationInformation(codePtr->procPtr, &fileObj, &line); if (line >= 0 && fileObj != NULL) { Tcl_AppendPrintfToObj(bufferObj, "\n File \"%s\" Line %d", - Tcl_GetString(fileObj), line); + TclGetString(fileObj), line); } Tcl_AppendPrintfToObj(bufferObj, - "\n Cmds %d, src %d, inst %d, litObjs %u, aux %d, stkDepth %u, code/src %.2f\n", + "\n Cmds %d, src %" TCL_Z_MODIFIER "u, inst %" TCL_Z_MODIFIER "u, litObjs %" TCL_Z_MODIFIER "u, aux %" TCL_Z_MODIFIER "u, stkDepth %" TCL_Z_MODIFIER "u, code/src %.2f\n", numCmds, codePtr->numSrcBytes, codePtr->numCodeBytes, codePtr->numLitObjects, codePtr->numAuxDataItems, codePtr->maxStackDepth, @@ -301,8 +301,8 @@ DisassembleByteCodeObj( #ifdef TCL_COMPILE_STATS Tcl_AppendPrintfToObj(bufferObj, - " Code %" TCL_Z_MODIFIER "u = header %" TCL_Z_MODIFIER "u+inst %d+litObj %" - TCL_Z_MODIFIER "u+exc %" TCL_Z_MODIFIER "u+aux %" TCL_Z_MODIFIER "u+cmdMap %d\n", + " Code %" TCL_Z_MODIFIER "u = header %" TCL_Z_MODIFIER "u+inst %" TCL_Z_MODIFIER "u+litObj %" + TCL_Z_MODIFIER "u+exc %" TCL_Z_MODIFIER "u+aux %" TCL_Z_MODIFIER "u+cmdMap %" TCL_Z_MODIFIER "u\n", codePtr->structureSize, offsetof(ByteCode, localCachePtr), codePtr->numCodeBytes, @@ -323,7 +323,7 @@ DisassembleByteCodeObj( int numCompiledLocals = procPtr->numCompiledLocals; Tcl_AppendPrintfToObj(bufferObj, - " Proc %p, refCt %u, args %d, compiled locals %d\n", + " Proc %p, refCt %" TCL_Z_MODIFIER "u, args %" TCL_Z_MODIFIER "u, compiled locals %d\n", procPtr, procPtr->refCount, procPtr->numArgs, numCompiledLocals); if (numCompiledLocals > 0) { @@ -353,25 +353,25 @@ DisassembleByteCodeObj( * Print the ExceptionRange array. */ - if (codePtr->numExceptRanges > 0) { - Tcl_AppendPrintfToObj(bufferObj, " Exception ranges %d, depth %d:\n", + if ((int)codePtr->numExceptRanges > 0) { + Tcl_AppendPrintfToObj(bufferObj, " Exception ranges %" TCL_Z_MODIFIER "u, depth %" TCL_Z_MODIFIER "u:\n", codePtr->numExceptRanges, codePtr->maxExceptDepth); - for (i = 0; i < codePtr->numExceptRanges; i++) { + for (i = 0; i < (int)codePtr->numExceptRanges; i++) { ExceptionRange *rangePtr = &codePtr->exceptArrayPtr[i]; Tcl_AppendPrintfToObj(bufferObj, - " %d: level %d, %s, pc %d-%d, ", + " %d: level %" TCL_Z_MODIFIER "u, %s, pc %" TCL_Z_MODIFIER "u-%" TCL_Z_MODIFIER "u, ", i, rangePtr->nestingLevel, (rangePtr->type==LOOP_EXCEPTION_RANGE ? "loop" : "catch"), rangePtr->codeOffset, (rangePtr->codeOffset + rangePtr->numCodeBytes - 1)); switch (rangePtr->type) { case LOOP_EXCEPTION_RANGE: - Tcl_AppendPrintfToObj(bufferObj, "continue %d, break %d\n", + Tcl_AppendPrintfToObj(bufferObj, "continue %" TCL_Z_MODIFIER "u, break %" TCL_Z_MODIFIER "u\n", rangePtr->continueOffset, rangePtr->breakOffset); break; case CATCH_EXCEPTION_RANGE: - Tcl_AppendPrintfToObj(bufferObj, "catch %d\n", + Tcl_AppendPrintfToObj(bufferObj, "catch %" TCL_Z_MODIFIER "u\n", rangePtr->catchOffset); break; default: @@ -407,7 +407,7 @@ DisassembleByteCodeObj( srcLengthNext = codePtr->srcLengthStart; codeOffset = srcOffset = 0; for (i = 0; i < numCmds; i++) { - if ((unsigned) *codeDeltaNext == (unsigned) 0xFF) { + if (*codeDeltaNext == 0xFF) { codeDeltaNext++; delta = TclGetInt4AtPtr(codeDeltaNext); codeDeltaNext += 4; @@ -417,7 +417,7 @@ DisassembleByteCodeObj( } codeOffset += delta; - if ((unsigned) *codeLengthNext == (unsigned) 0xFF) { + if (*codeLengthNext == 0xFF) { codeLengthNext++; codeLen = TclGetInt4AtPtr(codeLengthNext); codeLengthNext += 4; @@ -426,7 +426,7 @@ DisassembleByteCodeObj( codeLengthNext++; } - if ((unsigned) *srcDeltaNext == (unsigned) 0xFF) { + if (*srcDeltaNext == 0xFF) { srcDeltaNext++; delta = TclGetInt4AtPtr(srcDeltaNext); srcDeltaNext += 4; @@ -436,7 +436,7 @@ DisassembleByteCodeObj( } srcOffset += delta; - if ((unsigned) *srcLengthNext == (unsigned) 0xFF) { + if (*srcLengthNext == 0xFF) { srcLengthNext++; srcLen = TclGetInt4AtPtr(srcLengthNext); srcLengthNext += 4; @@ -466,7 +466,7 @@ DisassembleByteCodeObj( codeOffset = srcOffset = 0; pc = codeStart; for (i = 0; i < numCmds; i++) { - if ((unsigned) *codeDeltaNext == (unsigned) 0xFF) { + if (*codeDeltaNext == 0xFF) { codeDeltaNext++; delta = TclGetInt4AtPtr(codeDeltaNext); codeDeltaNext += 4; @@ -476,7 +476,7 @@ DisassembleByteCodeObj( } codeOffset += delta; - if ((unsigned) *srcDeltaNext == (unsigned) 0xFF) { + if (*srcDeltaNext == 0xFF) { srcDeltaNext++; delta = TclGetInt4AtPtr(srcDeltaNext); srcDeltaNext += 4; @@ -486,7 +486,7 @@ DisassembleByteCodeObj( } srcOffset += delta; - if ((unsigned) *srcLengthNext == (unsigned) 0xFF) { + if (*srcLengthNext == 0xFF) { srcLengthNext++; srcLen = TclGetInt4AtPtr(srcLengthNext); srcLengthNext += 4; @@ -544,7 +544,7 @@ FormatInstruction( unsigned char *codeStart = codePtr->codeStart; unsigned pcOffset = pc - codeStart; int opnd = 0, i, j, numBytes = 1; - int localCt = procPtr ? procPtr->numCompiledLocals : 0; + int localCt = procPtr ? (int)procPtr->numCompiledLocals : 0; CompiledLocal *localPtr = procPtr ? procPtr->firstLocalPtr : NULL; char suffixBuffer[128]; /* Additional info to print after main opcode * and immediates. */ @@ -566,7 +566,7 @@ FormatInstruction( break; case OPERAND_UINT1: opnd = TclGetUInt1AtPtr(pc+numBytes); numBytes++; - Tcl_AppendPrintfToObj(bufferObj, "%u ", (unsigned) opnd); + Tcl_AppendPrintfToObj(bufferObj, "%u ", opnd); break; case OPERAND_UINT4: opnd = TclGetUInt4AtPtr(pc+numBytes); numBytes += 4; @@ -574,7 +574,7 @@ FormatInstruction( sprintf(suffixBuffer+strlen(suffixBuffer), ", %u cmds start here", opnd); } - Tcl_AppendPrintfToObj(bufferObj, "%u ", (unsigned) opnd); + Tcl_AppendPrintfToObj(bufferObj, "%u ", opnd); break; case OPERAND_OFFSET1: opnd = TclGetInt1AtPtr(pc+numBytes); numBytes++; @@ -593,16 +593,16 @@ FormatInstruction( case OPERAND_LIT1: opnd = TclGetUInt1AtPtr(pc+numBytes); numBytes++; suffixObj = codePtr->objArrayPtr[opnd]; - Tcl_AppendPrintfToObj(bufferObj, "%u ", (unsigned) opnd); + Tcl_AppendPrintfToObj(bufferObj, "%u ", opnd); break; case OPERAND_LIT4: opnd = TclGetUInt4AtPtr(pc+numBytes); numBytes += 4; suffixObj = codePtr->objArrayPtr[opnd]; - Tcl_AppendPrintfToObj(bufferObj, "%u ", (unsigned) opnd); + Tcl_AppendPrintfToObj(bufferObj, "%u ", opnd); break; case OPERAND_AUX4: opnd = TclGetUInt4AtPtr(pc+numBytes); numBytes += 4; - Tcl_AppendPrintfToObj(bufferObj, "%u ", (unsigned) opnd); + Tcl_AppendPrintfToObj(bufferObj, "%u ", opnd); auxPtr = &codePtr->auxDataArrayPtr[opnd]; break; case OPERAND_IDX4: @@ -626,19 +626,19 @@ FormatInstruction( if (localPtr != NULL) { if (opnd >= localCt) { Tcl_Panic("FormatInstruction: bad local var index %u (%u locals)", - (unsigned) opnd, localCt); + opnd, localCt); } for (j = 0; j < opnd; j++) { localPtr = localPtr->nextPtr; } if (TclIsVarTemporary(localPtr)) { - sprintf(suffixBuffer, "temp var %u", (unsigned) opnd); + sprintf(suffixBuffer, "temp var %u", opnd); } else { sprintf(suffixBuffer, "var "); suffixSrc = localPtr->name; } } - Tcl_AppendPrintfToObj(bufferObj, "%%v%u ", (unsigned) opnd); + Tcl_AppendPrintfToObj(bufferObj, "%%v%u ", opnd); break; case OPERAND_SCLS1: opnd = TclGetUInt1AtPtr(pc+numBytes); numBytes++; @@ -652,10 +652,10 @@ FormatInstruction( } if (suffixObj) { const char *bytes; - int length; + size_t length; Tcl_AppendToObj(bufferObj, "\t# ", -1); - bytes = TclGetStringFromObj(codePtr->objArrayPtr[opnd], &length); + bytes = Tcl_GetStringFromObj(codePtr->objArrayPtr[opnd], &length); PrintSourceToObj(bufferObj, bytes, TclMin(length, 40)); } else if (suffixBuffer[0]) { Tcl_AppendPrintfToObj(bufferObj, "\t# %s", suffixBuffer); @@ -690,7 +690,7 @@ TclGetInnerContext( const unsigned char *pc, Tcl_Obj **tosPtr) { - int objc = 0, off = 0; + size_t 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 { - int len; + size_t len; /* * Reset while keeping the list internalrep as much as possible. @@ -773,7 +773,7 @@ TclGetInnerContext( for (; objc>0 ; objc--) { Tcl_Obj *objPtr; - objPtr = tosPtr[1 - objc + off]; + objPtr = tosPtr[1 - objc]; if (!objPtr) { Tcl_Panic("InnerContext: bad tos -- appending null object"); } @@ -833,14 +833,14 @@ UpdateStringOfInstName( InstNameGetInternalRep(objPtr, inst); - if (inst > LAST_INST_OPCODE) { + 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); (void) Tcl_InitStringRep(objPtr, NULL, strlen(dst)); } else { const char *s = tclInstructionTable[inst].name; - unsigned int len = strlen(s); + size_t len = strlen(s); dst = Tcl_InitStringRep(objPtr, s, len); TclOOM(dst, len); } @@ -860,10 +860,10 @@ static void PrintSourceToObj( Tcl_Obj *appendObj, /* The object to print the source to. */ const char *stringPtr, /* The string to print. */ - int maxChars) /* Maximum number of chars to print. */ + size_t maxChars) /* Maximum number of chars to print. */ { const char *p; - int i = 0, len; + size_t i = 0, len; if (stringPtr == NULL) { Tcl_AppendToObj(appendObj, "\"\"", -1); @@ -953,7 +953,7 @@ DisassembleByteCodeAsDicts( */ TclNewObj(literals); - for (i=0 ; i<codePtr->numLitObjects ; i++) { + for (i=0 ; i<(int)codePtr->numLitObjects ; i++) { Tcl_ListObjAppendElement(NULL, literals, codePtr->objArrayPtr[i]); } @@ -1113,7 +1113,7 @@ DisassembleByteCodeAsDicts( */ TclNewObj(aux); - for (i=0 ; i<codePtr->numAuxDataItems ; i++) { + for (i=0 ; i<(int)codePtr->numAuxDataItems ; i++) { AuxData *auxData = &codePtr->auxDataArrayPtr[i]; Tcl_Obj *auxDesc = Tcl_NewStringObj(auxData->type->name, -1); @@ -1140,20 +1140,20 @@ DisassembleByteCodeAsDicts( */ TclNewObj(exn); - for (i=0 ; i<codePtr->numExceptRanges ; i++) { + for (i=0 ; i<(int)codePtr->numExceptRanges ; i++) { ExceptionRange *rangePtr = &codePtr->exceptArrayPtr[i]; switch (rangePtr->type) { case LOOP_EXCEPTION_RANGE: Tcl_ListObjAppendElement(NULL, exn, Tcl_ObjPrintf( - "type %s level %d from %d to %d break %d continue %d", + "type %s level %" TCL_Z_MODIFIER "u from %" TCL_Z_MODIFIER "u to %" TCL_Z_MODIFIER "u break %" TCL_Z_MODIFIER "u continue %" TCL_Z_MODIFIER "u", "loop", rangePtr->nestingLevel, rangePtr->codeOffset, rangePtr->codeOffset + rangePtr->numCodeBytes - 1, rangePtr->breakOffset, rangePtr->continueOffset)); break; case CATCH_EXCEPTION_RANGE: Tcl_ListObjAppendElement(NULL, exn, Tcl_ObjPrintf( - "type %s level %d from %d to %d catch %d", + "type %s level %" TCL_Z_MODIFIER "u from %" TCL_Z_MODIFIER "u to %" TCL_Z_MODIFIER "u catch %" TCL_Z_MODIFIER "u", "catch", rangePtr->nestingLevel, rangePtr->codeOffset, rangePtr->codeOffset + rangePtr->numCodeBytes - 1, rangePtr->catchOffset)); @@ -1180,7 +1180,7 @@ DisassembleByteCodeAsDicts( srcOffPtr = codePtr->srcDeltaStart; srcLenPtr = codePtr->srcLengthStart; codeOffset = sourceOffset = 0; - for (i=0 ; i<codePtr->numCommands ; i++) { + for (i=0 ; i<(int)codePtr->numCommands ; i++) { Tcl_Obj *cmd; codeOffset += Decode(codeOffPtr); @@ -1268,7 +1268,7 @@ DisassembleByteCodeAsDicts( int Tcl_DisassembleObjCmd( - ClientData clientData, /* What type of operation. */ + void *clientData, /* What type of operation. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -1281,8 +1281,8 @@ Tcl_DisassembleObjCmd( DISAS_CLASS_CONSTRUCTOR, DISAS_CLASS_DESTRUCTOR, DISAS_LAMBDA, DISAS_CLASS_METHOD, DISAS_OBJECT_METHOD, DISAS_PROC, DISAS_SCRIPT - }; - int idx, result; + } idx; + int result; Tcl_Obj *codeObjPtr = NULL; Proc *procPtr = NULL; Tcl_HashEntry *hPtr; @@ -1298,7 +1298,7 @@ Tcl_DisassembleObjCmd( return TCL_ERROR; } - switch ((enum Types) idx) { + switch (idx) { case DISAS_LAMBDA: { Command cmd; Tcl_Obj *nsObjPtr; @@ -1528,7 +1528,7 @@ Tcl_DisassembleObjCmd( return TCL_ERROR; } hPtr = Tcl_FindHashEntry(&oPtr->classPtr->classMethods, - (char *) objv[3]); + objv[3]); goto methodBody; case DISAS_OBJECT_METHOD: if (objc != 4) { @@ -1547,7 +1547,7 @@ Tcl_DisassembleObjCmd( if (oPtr->methodsPtr == NULL) { goto unknownMethod; } - hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) objv[3]); + hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, objv[3]); /* * Compile (if necessary) and disassemble a method body. diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index eb217b4..3013916 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -236,8 +236,14 @@ static Tcl_EncodingConvertProc Iso88591ToUtfProc; */ static const Tcl_ObjType encodingType = { - "encoding", FreeEncodingInternalRep, DupEncodingInternalRep, NULL, NULL + "encoding", + FreeEncodingInternalRep, + DupEncodingInternalRep, + NULL, + NULL, + TCL_OBJTYPE_V0 }; + #define EncodingSetInternalRep(objPtr, encoding) \ do { \ Tcl_ObjInternalRep ir; \ @@ -368,7 +374,7 @@ int Tcl_SetEncodingSearchPath( Tcl_Obj *searchPath) { - int dummy; + size_t dummy; if (TCL_ERROR == TclListObjLengthM(NULL, searchPath, &dummy)) { return TCL_ERROR; @@ -415,7 +421,7 @@ void TclSetLibraryPath( Tcl_Obj *path) { - int dummy; + size_t dummy; if (TCL_ERROR == TclListObjLengthM(NULL, path, &dummy)) { return; @@ -451,7 +457,7 @@ TclSetLibraryPath( static void FillEncodingFileMap(void) { - int i, numDirs = 0; + size_t i, numDirs = 0; Tcl_Obj *map, *searchPath; searchPath = Tcl_GetEncodingSearchPath(); @@ -460,13 +466,13 @@ FillEncodingFileMap(void) map = Tcl_NewDictObj(); Tcl_IncrRefCount(map); - for (i = numDirs-1; i >= 0; i--) { + for (i = numDirs-1; i != TCL_INDEX_NONE; i--) { /* * Iterate backwards through the search path so as we overwrite * entries found, we favor files earlier on the search path. */ - int j, numFiles; + size_t j, numFiles; Tcl_Obj *directory, *matchFileList; Tcl_Obj **filev; Tcl_GlobTypeData readableFiles = { @@ -620,14 +626,14 @@ TclInitEncodingSubsystem(void) * code to duplicate the structure of a table encoding here. */ - dataPtr = (TableEncodingData *)ckalloc(sizeof(TableEncodingData)); + dataPtr = (TableEncodingData *)Tcl_Alloc(sizeof(TableEncodingData)); memset(dataPtr, 0, sizeof(TableEncodingData)); dataPtr->fallback = '?'; size = 256*(sizeof(unsigned short *) + sizeof(unsigned short)); - dataPtr->toUnicode = (unsigned short **)ckalloc(size); + dataPtr->toUnicode = (unsigned short **)Tcl_Alloc(size); memset(dataPtr->toUnicode, 0, size); - dataPtr->fromUnicode = (unsigned short **)ckalloc(size); + dataPtr->fromUnicode = (unsigned short **)Tcl_Alloc(size); memset(dataPtr->fromUnicode, 0, size); dataPtr->toUnicode[0] = (unsigned short *) (dataPtr->toUnicode + 256); @@ -704,70 +710,6 @@ TclFinalizeEncodingSubsystem(void) /* *------------------------------------------------------------------------- * - * Tcl_GetDefaultEncodingDir -- - * - * Legacy public interface to retrieve first directory in the encoding - * searchPath. - * - * Results: - * The directory pathname, as a string, or NULL for an empty encoding - * search path. - * - * Side effects: - * None. - * - *------------------------------------------------------------------------- - */ - -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 -const char * -Tcl_GetDefaultEncodingDir(void) -{ - int numDirs; - Tcl_Obj *first, *searchPath = Tcl_GetEncodingSearchPath(); - - TclListObjLengthM(NULL, searchPath, &numDirs); - if (numDirs == 0) { - return NULL; - } - Tcl_ListObjIndex(NULL, searchPath, 0, &first); - - return TclGetString(first); -} - -/* - *------------------------------------------------------------------------- - * - * Tcl_SetDefaultEncodingDir -- - * - * Legacy public interface to set the first directory in the encoding - * search path. - * - * Results: - * None. - * - * Side effects: - * Modifies the encoding search path. - * - *------------------------------------------------------------------------- - */ - -void -Tcl_SetDefaultEncodingDir( - const char *path) -{ - Tcl_Obj *searchPath = Tcl_GetEncodingSearchPath(); - Tcl_Obj *directory = Tcl_NewStringObj(path, -1); - - searchPath = Tcl_DuplicateObj(searchPath); - Tcl_ListObjReplace(NULL, searchPath, 0, 0, 1, &directory); - Tcl_SetEncodingSearchPath(searchPath); -} -#endif - -/* - *------------------------------------------------------------------------- - * * Tcl_GetEncoding -- * * Given the name of a encoding, find the corresponding Tcl_Encoding @@ -877,9 +819,9 @@ FreeEncoding( Tcl_DeleteHashEntry(encodingPtr->hPtr); } if (encodingPtr->name) { - ckfree(encodingPtr->name); + Tcl_Free(encodingPtr->name); } - ckfree(encodingPtr); + Tcl_Free(encodingPtr); } } @@ -1094,7 +1036,7 @@ Tcl_CreateEncoding( const Tcl_EncodingType *typePtr) /* The encoding type. */ { - Encoding *encodingPtr = (Encoding *)ckalloc(sizeof(Encoding)); + Encoding *encodingPtr = (Encoding *)Tcl_Alloc(sizeof(Encoding)); encodingPtr->name = NULL; encodingPtr->toUtfProc = typePtr->toUtfProc; encodingPtr->fromUtfProc = typePtr->fromUtfProc; @@ -1128,7 +1070,7 @@ Tcl_CreateEncoding( replaceMe->hPtr = NULL; } - name = (char *)ckalloc(strlen(typePtr->encodingName) + 1); + name = (char *)Tcl_Alloc(strlen(typePtr->encodingName) + 1); encodingPtr->name = strcpy(name, typePtr->encodingName); encodingPtr->hPtr = hPtr; Tcl_SetHashValue(hPtr, encodingPtr); @@ -1159,12 +1101,13 @@ Tcl_CreateEncoding( *------------------------------------------------------------------------- */ +#undef Tcl_ExternalToUtfDString char * Tcl_ExternalToUtfDString( Tcl_Encoding encoding, /* The encoding for the source string, or NULL * for the default system encoding. */ const char *src, /* Source string in specified encoding. */ - int srcLen, /* Source string length in bytes, or < 0 for + size_t srcLen, /* Source string length in bytes, or -1 for * encoding-specific string length. */ Tcl_DString *dstPtr) /* Uninitialized or free DString in which the * converted string is stored. */ @@ -1180,11 +1123,9 @@ Tcl_ExternalToUtfDString( * Tcl_ExternalToUtfDStringEx -- * * Convert a source buffer from the specified encoding into UTF-8. -* The parameter flags controls the behavior, if any of the bytes in + * The parameter flags controls the behavior, if any of the bytes in * the source buffer are invalid or cannot be represented in utf-8. * Possible flags values: - * TCL_ENCODING_STOPONERROR: don't replace invalid characters/bytes but - * return the first error position (Default in Tcl 9.0). * TCL_ENCODING_NOCOMPLAIN: replace invalid characters/bytes by a default * fallback character. Always return -1 (Default in Tcl 8.7). * TCL_ENCODING_MODIFIED: convert NULL bytes to \xC0\x80 in stead of 0x00. @@ -1203,12 +1144,12 @@ Tcl_ExternalToUtfDString( *------------------------------------------------------------------------- */ -int +size_t Tcl_ExternalToUtfDStringEx( Tcl_Encoding encoding, /* The encoding for the source string, or NULL * for the default system encoding. */ const char *src, /* Source string in specified encoding. */ - int srcLen, /* Source string length in bytes, or < 0 for + size_t srcLen, /* Source string length in bytes, or TCL_INDEX_NONE for * encoding-specific string length. */ int flags, /* Conversion control flags. */ Tcl_DString *dstPtr) /* Uninitialized or free DString in which the @@ -1217,7 +1158,8 @@ Tcl_ExternalToUtfDStringEx( char *dst; Tcl_EncodingState state; const Encoding *encodingPtr; - int dstLen, result, soFar, srcRead, dstWrote, dstChars; + int result, soFar, srcRead, dstWrote, dstChars; + size_t dstLen; const char *srcStart = src; Tcl_DStringInit(dstPtr); @@ -1231,7 +1173,7 @@ Tcl_ExternalToUtfDStringEx( if (src == NULL) { srcLen = 0; - } else if (srcLen < 0) { + } else if (srcLen == TCL_INDEX_NONE) { srcLen = encodingPtr->lengthProc(src); } @@ -1248,7 +1190,7 @@ Tcl_ExternalToUtfDStringEx( src += srcRead; if (result != TCL_CONVERT_NOSPACE) { Tcl_DStringSetLength(dstPtr, soFar); - return (result == TCL_OK) ? TCL_INDEX_NONE : (int)(src - srcStart); + return (result == TCL_OK) ? TCL_INDEX_NONE : (size_t)(src - srcStart); } flags &= ~TCL_ENCODING_START; srcLen -= srcRead; @@ -1285,8 +1227,8 @@ Tcl_ExternalToUtf( Tcl_Encoding encoding, /* The encoding for the source string, or NULL * for the default system encoding. */ const char *src, /* Source string in specified encoding. */ - int srcLen, /* Source string length in bytes, or < 0 for - * encoding-specific string length. */ + size_t srcLen, /* Source string length in bytes, or -1 + * for encoding-specific string length. */ int flags, /* Conversion control flags. */ Tcl_EncodingState *statePtr,/* Place for conversion routine to store state * information used during a piecewise @@ -1295,7 +1237,7 @@ Tcl_ExternalToUtf( * routine under control of flags argument. */ char *dst, /* Output buffer in which converted string is * stored. */ - int dstLen, /* The maximum length of output buffer in + size_t dstLen, /* The maximum length of output buffer in * bytes. */ int *srcReadPtr, /* Filled with the number of bytes from the * source string that were converted. This may @@ -1323,7 +1265,7 @@ Tcl_ExternalToUtf( if (src == NULL) { srcLen = 0; - } else if (srcLen < 0) { + } else if (srcLen == TCL_INDEX_NONE) { srcLen = encodingPtr->lengthProc(src); } if (statePtr == NULL) { @@ -1365,7 +1307,7 @@ Tcl_ExternalToUtf( if (*dstCharsPtr <= maxChars) { break; } - dstLen = TclUtfAtIndex(dst, maxChars) - dst + (TCL_UTF_MAX - 1); + dstLen = Tcl_UtfAtIndex(dst, maxChars) - dst + (TCL_UTF_MAX - 1); *statePtr = savedState; } while (1); if (!noTerminate) { @@ -1396,13 +1338,13 @@ Tcl_ExternalToUtf( * *------------------------------------------------------------------------- */ - +#undef Tcl_UtfToExternalDString char * Tcl_UtfToExternalDString( Tcl_Encoding encoding, /* The encoding for the converted string, or * NULL for the default system encoding. */ const char *src, /* Source string in UTF-8. */ - int srcLen, /* Source string length in bytes, or < 0 for + size_t srcLen, /* Source string length in bytes, or -1 for * strlen(). */ Tcl_DString *dstPtr) /* Uninitialized or free DString in which the * converted string is stored. */ @@ -1422,8 +1364,6 @@ Tcl_UtfToExternalDString( * the source buffer are invalid or cannot be represented in the * target encoding. * Possible flags values: - * TCL_ENCODING_STOPONERROR: don't replace invalid characters/bytes but - * return the first error position (Default in Tcl 9.0). * TCL_ENCODING_NOCOMPLAIN: replace invalid characters/bytes by a default * fallback character. Always return -1 (Default in Tcl 8.7). * TCL_ENCODING_MODIFIED: convert NULL bytes to \xC0\x80 in stead of 0x00. @@ -1442,12 +1382,12 @@ Tcl_UtfToExternalDString( *------------------------------------------------------------------------- */ -int +size_t Tcl_UtfToExternalDStringEx( Tcl_Encoding encoding, /* The encoding for the converted string, or * NULL for the default system encoding. */ const char *src, /* Source string in UTF-8. */ - int srcLen, /* Source string length in bytes, or < 0 for + size_t srcLen, /* Source string length in bytes, or < 0 for * strlen(). */ int flags, /* Conversion control flags. */ Tcl_DString *dstPtr) /* Uninitialized or free DString in which the @@ -1456,8 +1396,9 @@ Tcl_UtfToExternalDStringEx( char *dst; Tcl_EncodingState state; const Encoding *encodingPtr; - int dstLen, result, soFar, srcRead, dstWrote, dstChars; + int result, soFar, srcRead, dstWrote, dstChars; const char *srcStart = src; + size_t dstLen; Tcl_DStringInit(dstPtr); dst = Tcl_DStringValue(dstPtr); @@ -1470,7 +1411,7 @@ Tcl_UtfToExternalDStringEx( if (src == NULL) { srcLen = 0; - } else if (srcLen < 0) { + } else if (srcLen == TCL_INDEX_NONE) { srcLen = strlen(src); } flags |= TCL_ENCODING_START | TCL_ENCODING_END; @@ -1486,7 +1427,7 @@ Tcl_UtfToExternalDStringEx( while (i >= soFar) { Tcl_DStringSetLength(dstPtr, i--); } - return (result == TCL_OK) ? TCL_INDEX_NONE : (int)(src - srcStart); + return (result == TCL_OK) ? TCL_INDEX_NONE : (size_t)(src - srcStart); } flags &= ~TCL_ENCODING_START; @@ -1524,8 +1465,8 @@ Tcl_UtfToExternal( Tcl_Encoding encoding, /* The encoding for the converted string, or * NULL for the default system encoding. */ const char *src, /* Source string in UTF-8. */ - int srcLen, /* Source string length in bytes, or < 0 for - * strlen(). */ + size_t srcLen, /* Source string length in bytes, or -1 + * for strlen(). */ int flags, /* Conversion control flags. */ Tcl_EncodingState *statePtr,/* Place for conversion routine to store state * information used during a piecewise @@ -1534,7 +1475,7 @@ Tcl_UtfToExternal( * routine under control of flags argument. */ char *dst, /* Output buffer in which converted string * is stored. */ - int dstLen, /* The maximum length of output buffer in + size_t dstLen, /* The maximum length of output buffer in * bytes. */ int *srcReadPtr, /* Filled with the number of bytes from the * source string that were converted. This may @@ -1559,7 +1500,7 @@ Tcl_UtfToExternal( if (src == NULL) { srcLen = 0; - } else if (srcLen < 0) { + } else if (srcLen == TCL_INDEX_NONE) { srcLen = strlen(src); } if (statePtr == NULL) { @@ -1645,7 +1586,7 @@ OpenEncodingFileChannel( Tcl_Obj *map = TclGetProcessGlobalValue(&encodingFileMap); Tcl_Obj **dir, *path, *directory = NULL; Tcl_Channel chan = NULL; - int i, numDirs; + size_t i, numDirs; TclListObjGetElementsM(NULL, searchPath, &numDirs, &dir); Tcl_IncrRefCount(nameObj); @@ -1799,7 +1740,7 @@ LoadEncodingFile( "invalid encoding file \"%s\"", name)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ENCODING", name, NULL); } - Tcl_Close(NULL, chan); + Tcl_CloseEx(NULL, chan, 0); return encoding; } @@ -1889,7 +1830,7 @@ LoadTableEncoding( #undef PAGESIZE #define PAGESIZE (256 * sizeof(unsigned short)) - dataPtr = (TableEncodingData *)ckalloc(sizeof(TableEncodingData)); + dataPtr = (TableEncodingData *)Tcl_Alloc(sizeof(TableEncodingData)); memset(dataPtr, 0, sizeof(TableEncodingData)); dataPtr->fallback = fallback; @@ -1901,7 +1842,7 @@ LoadTableEncoding( */ size = 256 * sizeof(unsigned short *) + numPages * PAGESIZE; - dataPtr->toUnicode = (unsigned short **)ckalloc(size); + dataPtr->toUnicode = (unsigned short **)Tcl_Alloc(size); memset(dataPtr->toUnicode, 0, size); pageMemPtr = (unsigned short *) (dataPtr->toUnicode + 256); @@ -1910,7 +1851,7 @@ LoadTableEncoding( for (i = 0; i < numPages; i++) { int ch; const char *p; - int expected = 3 + 16 * (16 * 4 + 1); + size_t expected = 3 + 16 * (16 * 4 + 1); if (Tcl_ReadChars(chan, objPtr, expected, 0) != expected) { return NULL; @@ -1962,7 +1903,7 @@ LoadTableEncoding( } } size = 256 * sizeof(unsigned short *) + numPages * PAGESIZE; - dataPtr->fromUnicode = (unsigned short **)ckalloc(size); + dataPtr->fromUnicode = (unsigned short **)Tcl_Alloc(size); memset(dataPtr->fromUnicode, 0, size); pageMemPtr = (unsigned short *) (dataPtr->fromUnicode + 256); @@ -2058,7 +1999,7 @@ LoadTableEncoding( */ for (TclDStringClear(&lineString); - (len = Tcl_Gets(chan, &lineString)) >= 0; + (len = Tcl_Gets(chan, &lineString)) != -1; TclDStringClear(&lineString)) { const unsigned char *p; int to, from; @@ -2146,13 +2087,13 @@ LoadEscapeEncoding( Tcl_DStringInit(&escapeData); while (1) { - int argc; + size_t argc; const char **argv; char *line; Tcl_DString lineString; Tcl_DStringInit(&lineString); - if (Tcl_Gets(chan, &lineString) < 0) { + if (Tcl_Gets(chan, &lineString) == TCL_IO_FAILURE) { break; } line = Tcl_DStringValue(&lineString); @@ -2194,13 +2135,13 @@ LoadEscapeEncoding( Tcl_DStringAppend(&escapeData, (char *) &est, sizeof(est)); } } - ckfree(argv); + Tcl_Free((void *)argv); Tcl_DStringFree(&lineString); } size = offsetof(EscapeEncodingData, subTables) + Tcl_DStringLength(&escapeData); - dataPtr = (EscapeEncodingData *)ckalloc(size); + dataPtr = (EscapeEncodingData *)Tcl_Alloc(size); dataPtr->initLen = strlen(init); memcpy(dataPtr->init, init, dataPtr->initLen + 1); dataPtr->finalLen = strlen(final); @@ -2314,11 +2255,7 @@ BinaryProc( *------------------------------------------------------------------------- */ -#if TCL_MAJOR_VERSION > 8 || defined(TCL_NO_DEPRECATED) -# define STOPONERROR (!(flags & TCL_ENCODING_NOCOMPLAIN) || (flags & TCL_ENCODING_STOPONERROR)) -#else -# define STOPONERROR (flags & TCL_ENCODING_STOPONERROR) -#endif +#define STOPONERROR (!(flags & TCL_ENCODING_NOCOMPLAIN)) static int UtfToUtfProc( @@ -2425,7 +2362,6 @@ UtfToUtfProc( } dst += Tcl_UniCharToUtf(ch, dst); } else { - int low; const char *saveSrc = src; size_t len = TclUtfToUCS4(src, &ch); if ((len < 2) && (ch != 0) && (flags & TCL_ENCODING_MODIFIED) @@ -2443,13 +2379,20 @@ UtfToUtfProc( *dst++ = (char) (((ch >> 10) & 0x3F) | 0x80); ch = (ch & 0x0CFF) | 0xDC00; } - goto cesu8; +#if TCL_UTF_MAX < 4 + cesu8: +#endif + *dst++ = (char) (((ch >> 12) | 0xE0) & 0xEF); + *dst++ = (char) (((ch >> 6) | 0x80) & 0xBF); + *dst++ = (char) ((ch | 0x80) & 0xBF); + continue; +#if TCL_UTF_MAX < 4 } else if ((ch | 0x7FF) == 0xDFFF) { /* * A surrogate character is detected, handle especially. */ - low = ch; + int low = ch; len = (src <= srcEnd-3) ? TclUtfToUCS4(src, &low) : 0; if (((low & ~0x3FF) != 0xDC00) || (ch & 0x400)) { @@ -2459,15 +2402,12 @@ UtfToUtfProc( src = saveSrc; break; } - cesu8: - *dst++ = (char) (((ch >> 12) | 0xE0) & 0xEF); - *dst++ = (char) (((ch >> 6) | 0x80) & 0xBF); - *dst++ = (char) ((ch | 0x80) & 0xBF); - continue; + goto cesu8; } src += len; dst += Tcl_UniCharToUtf(ch, dst); ch = low; +#endif } else if (!Tcl_UniCharIsUnicode(ch)) { if (STOPONERROR) { result = TCL_CONVERT_UNKNOWN; @@ -2776,7 +2716,7 @@ Utf16ToUtfProc( if (ch && ch < 0x80) { *dst++ = (ch & 0xFF); } else { - dst += Tcl_UniCharToUtf(ch, dst); + dst += Tcl_UniCharToUtf(ch | TCL_COMBINE, dst); } src += sizeof(unsigned short); } @@ -3440,11 +3380,11 @@ TableFreeProc( * Make sure we aren't freeing twice on shutdown. [Bug 219314] */ - ckfree(dataPtr->toUnicode); + Tcl_Free(dataPtr->toUnicode); dataPtr->toUnicode = NULL; - ckfree(dataPtr->fromUnicode); + Tcl_Free(dataPtr->fromUnicode); dataPtr->fromUnicode = NULL; - ckfree(dataPtr); + Tcl_Free(dataPtr); } /* @@ -3817,8 +3757,7 @@ EscapeFromUtfProc( result = TCL_CONVERT_NOSPACE; break; } - memcpy(dst, subTablePtr->sequence, - subTablePtr->sequenceLen); + memcpy(dst, subTablePtr->sequence, subTablePtr->sequenceLen); dst += subTablePtr->sequenceLen; } } @@ -3922,7 +3861,7 @@ EscapeFreeProc( subTablePtr++; } } - ckfree(dataPtr); + Tcl_Free(dataPtr); } /* @@ -4036,11 +3975,12 @@ unilen4( static void InitializeEncodingSearchPath( char **valuePtr, - unsigned int *lengthPtr, + size_t *lengthPtr, Tcl_Encoding *encodingPtr) { const char *bytes; - int i, numDirs, numBytes; + size_t i, numDirs; + size_t numBytes; Tcl_Obj *libPathObj, *encodingObj, *searchPathObj; TclNewLiteralStringObj(encodingObj, "encoding"); @@ -4073,7 +4013,7 @@ InitializeEncodingSearchPath( bytes = Tcl_GetStringFromObj(searchPathObj, &numBytes); *lengthPtr = numBytes; - *valuePtr = (char *)ckalloc(numBytes + 1); + *valuePtr = (char *)Tcl_Alloc(numBytes + 1); memcpy(*valuePtr, bytes, numBytes + 1); Tcl_DecrRefCount(searchPathObj); } diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index 88b611f..6a9dc9e 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -81,7 +81,8 @@ static const Tcl_ObjType ensembleCmdType = { FreeEnsembleCmdRep, /* freeIntRepProc */ DupEnsembleCmdRep, /* dupIntRepProc */ NULL, /* updateStringProc */ - NULL /* setFromAnyProc */ + NULL, /* setFromAnyProc */ + TCL_OBJTYPE_V0 }; #define ECRSetInternalRep(objPtr, ecRepPtr) \ @@ -105,7 +106,7 @@ static const Tcl_ObjType ensembleCmdType = { */ typedef struct { - int epoch; /* Used to confirm when the data in this + size_t 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 @@ -163,7 +164,7 @@ TclNamespaceEnsembleCmd( Tcl_DictSearch search; Tcl_Obj *listObj; const char *simpleName; - int index; + enum EnsSubcmds index; int done; if (nsPtr == NULL || nsPtr->flags & NS_DEAD) { @@ -185,10 +186,10 @@ TclNamespaceEnsembleCmd( return TCL_ERROR; } - switch ((enum EnsSubcmds) index) { + switch (index) { case ENS_CREATE: { const char *name; - int len; + size_t len; int allocatedMapFlag = 0; /* * Defaults @@ -221,14 +222,15 @@ TclNamespaceEnsembleCmd( */ for (; objc>1 ; objc-=2,objv+=2) { + enum EnsCreateOpts idx; if (Tcl_GetIndexFromObj(interp, objv[0], ensembleCreateOptions, - "option", 0, &index) != TCL_OK) { + "option", 0, &idx) != TCL_OK) { if (allocatedMapFlag) { Tcl_DecrRefCount(mapObj); } return TCL_ERROR; } - switch ((enum EnsCreateOpts) index) { + switch (idx) { case CRT_CMD: name = TclGetString(objv[1]); cxtPtr = nsPtr; @@ -400,13 +402,14 @@ TclNamespaceEnsembleCmd( } if (objc == 4) { + enum EnsConfigOpts idx; Tcl_Obj *resultObj = NULL; /* silence gcc 4 warning */ if (Tcl_GetIndexFromObj(interp, objv[3], ensembleConfigOptions, - "option", 0, &index) != TCL_OK) { + "option", 0, &idx) != TCL_OK) { return TCL_ERROR; } - switch ((enum EnsConfigOpts) index) { + switch (idx) { case CONF_SUBCMDS: Tcl_GetEnsembleSubcommandList(NULL, token, &resultObj); if (resultObj != NULL) { @@ -500,7 +503,7 @@ TclNamespaceEnsembleCmd( Tcl_SetObjResult(interp, resultObj); } else { - int len; + size_t len; int allocatedMapFlag = 0; Tcl_Obj *subcmdObj = NULL, *mapObj = NULL, *paramObj = NULL, *unknownObj = NULL; /* Defaults, silence gcc 4 warnings */ @@ -524,15 +527,16 @@ TclNamespaceEnsembleCmd( */ for (; objc>0 ; objc-=2,objv+=2) { + enum EnsConfigOpts idx; if (Tcl_GetIndexFromObj(interp, objv[0],ensembleConfigOptions, - "option", 0, &index) != TCL_OK) { + "option", 0, &idx) != TCL_OK) { freeMapAndError: if (allocatedMapFlag) { Tcl_DecrRefCount(mapObj); } return TCL_ERROR; } - switch ((enum EnsConfigOpts) index) { + switch (idx) { case CONF_SUBCMDS: if (TclListObjLengthM(interp, objv[1], &len) != TCL_OK) { goto freeMapAndError; @@ -678,12 +682,12 @@ TclCreateEnsembleInNs( EnsembleConfig *ensemblePtr; Tcl_Command token; - ensemblePtr = (EnsembleConfig *)ckalloc(sizeof(EnsembleConfig)); + ensemblePtr = (EnsembleConfig *)Tcl_Alloc(sizeof(EnsembleConfig)); token = TclNRCreateCommandInNs(interp, name, (Tcl_Namespace *) nameNsPtr, TclEnsembleImplementationCmd, NsEnsembleImplementationCmdNR, ensemblePtr, DeleteEnsembleConfig); if (token == NULL) { - ckfree(ensemblePtr); + Tcl_Free(ensemblePtr); return NULL; } @@ -791,7 +795,7 @@ Tcl_SetEnsembleSubcommandList( return TCL_ERROR; } if (subcmdList != NULL) { - int length; + size_t length; if (TclListObjLengthM(interp, subcmdList, &length) != TCL_OK) { return TCL_ERROR; @@ -858,7 +862,7 @@ Tcl_SetEnsembleParameterList( Command *cmdPtr = (Command *) token; EnsembleConfig *ensemblePtr; Tcl_Obj *oldList; - int length; + size_t length; if (cmdPtr->objProc != TclEnsembleImplementationCmd) { Tcl_SetObjResult(interp, Tcl_NewStringObj( @@ -943,7 +947,7 @@ Tcl_SetEnsembleMappingDict( return TCL_ERROR; } if (mapDict != NULL) { - int size; + size_t size; int done; Tcl_DictSearch search; Tcl_Obj *valuePtr; @@ -1043,7 +1047,7 @@ Tcl_SetEnsembleUnknownHandler( return TCL_ERROR; } if (unknownList != NULL) { - int length; + size_t length; if (TclListObjLengthM(interp, unknownList, &length) != TCL_OK) { return TCL_ERROR; @@ -1527,7 +1531,7 @@ TclMakeEnsemble( Tcl_DString buf, hiddenBuf; const char **nameParts = NULL; const char *cmdName = NULL; - int i, nameCount = 0; + size_t i, nameCount = 0; int ensembleFlags = 0, hiddenLen; /* @@ -1629,7 +1633,7 @@ TclMakeEnsemble( Tcl_DStringSetLength(&hiddenBuf, hiddenLen); if (Tcl_HideCommand(interp, "___tmp", Tcl_DStringAppend(&hiddenBuf, map[i].name, -1))) { - Tcl_Panic("%s", Tcl_GetString(Tcl_GetObjResult(interp))); + Tcl_Panic("%s", Tcl_GetStringResult(interp)); } } else { /* @@ -1650,7 +1654,7 @@ TclMakeEnsemble( Tcl_DStringFree(&buf); Tcl_DStringFree(&hiddenBuf); if (nameParts != NULL) { - ckfree(nameParts); + Tcl_Free((void *)nameParts); } return ensemble; } @@ -1706,7 +1710,7 @@ NsEnsembleImplementationCmdNR( int reparseCount = 0; /* Number of reparses. */ Tcl_Obj *errorObj; /* Used for building error messages. */ Tcl_Obj *subObj; - int subIdx; + size_t subIdx; /* * Must recheck objc since numParameters might have changed. See test @@ -1715,7 +1719,7 @@ NsEnsembleImplementationCmdNR( restartEnsembleParse: subIdx = 1 + ensemblePtr->numParameters; - if (objc < subIdx + 1) { + if ((size_t)objc < subIdx + 1) { /* * No subcommand argument. Make error message. */ @@ -1809,11 +1813,11 @@ NsEnsembleImplementationCmdNR( * it (a non-unique prefix produces an error). */ char *fullName = NULL; /* Full name of the subcommand. */ - int stringLength, i; - int tableLength = ensemblePtr->subcommandTable.numEntries; + size_t stringLength, i; + size_t tableLength = ensemblePtr->subcommandTable.numEntries; Tcl_Obj *fix; - subcmdName = TclGetStringFromObj(subObj, &stringLength); + subcmdName = Tcl_GetStringFromObj(subObj, &stringLength); for (i=0 ; i<tableLength ; i++) { int cmp = strncmp(subcmdName, ensemblePtr->subcommandArrayPtr[i], @@ -1887,7 +1891,7 @@ NsEnsembleImplementationCmdNR( Tcl_Obj *copyPtr; /* The list of words to dispatch on. * Will be freed by the dispatch engine. */ Tcl_Obj **copyObjv; - int copyObjc, prefixObjc; + size_t copyObjc, prefixObjc; TclListObjLengthM(NULL, prefixObj, &prefixObjc); @@ -1970,7 +1974,7 @@ NsEnsembleImplementationCmdNR( if (ensemblePtr->subcommandTable.numEntries == 1) { Tcl_AppendToObj(errorObj, ensemblePtr->subcommandArrayPtr[0], -1); } else { - int i; + size_t i; for (i=0 ; i<ensemblePtr->subcommandTable.numEntries-1 ; i++) { Tcl_AppendToObj(errorObj, ensemblePtr->subcommandArrayPtr[i], -1); @@ -2015,8 +2019,8 @@ TclClearRootEnsemble( int TclInitRewriteEnsemble( Tcl_Interp *interp, - int numRemoved, - int numInserted, + size_t numRemoved, + size_t numInserted, Tcl_Obj *const *objv) { Interp *iPtr = (Interp *) interp; @@ -2028,7 +2032,7 @@ TclInitRewriteEnsemble( iPtr->ensembleRewrite.numRemovedObjs = numRemoved; iPtr->ensembleRewrite.numInsertedObjs = numInserted; } else { - int numIns = iPtr->ensembleRewrite.numInsertedObjs; + size_t numIns = iPtr->ensembleRewrite.numInsertedObjs; if (numIns < numRemoved) { iPtr->ensembleRewrite.numRemovedObjs += numRemoved - numIns; @@ -2098,8 +2102,8 @@ FreeER( Tcl_Obj **tmp = (Tcl_Obj **) data[0]; Tcl_Obj **store = (Tcl_Obj **) data[1]; - ckfree(store); - ckfree(tmp); + Tcl_Free(store); + Tcl_Free(tmp); return result; } @@ -2107,16 +2111,16 @@ void TclSpellFix( Tcl_Interp *interp, Tcl_Obj *const *objv, - int objc, - int badIdx, + size_t objc, + size_t badIdx, Tcl_Obj *bad, Tcl_Obj *fix) { Interp *iPtr = (Interp *) interp; Tcl_Obj *const *search; Tcl_Obj **store; - int idx; - int size; + size_t idx; + size_t size; if (iPtr->ensembleRewrite.sourceObjs == NULL) { iPtr->ensembleRewrite.sourceObjs = objv; @@ -2174,9 +2178,9 @@ TclSpellFix( if (search[0] == NULL) { store = (Tcl_Obj **) search[2]; } else { - Tcl_Obj **tmp = (Tcl_Obj **)ckalloc(3 * sizeof(Tcl_Obj *)); + Tcl_Obj **tmp = (Tcl_Obj **)Tcl_Alloc(3 * sizeof(Tcl_Obj *)); - store = (Tcl_Obj **)ckalloc(size * sizeof(Tcl_Obj *)); + store = (Tcl_Obj **)Tcl_Alloc(size * sizeof(Tcl_Obj *)); memcpy(store, iPtr->ensembleRewrite.sourceObjs, size * sizeof(Tcl_Obj *)); @@ -2232,8 +2236,8 @@ Tcl_Obj *const * TclFetchEnsembleRoot( Tcl_Interp *interp, Tcl_Obj *const *objv, - int objc, - int *objcPtr) + size_t objc, + size_t *objcPtr) { Tcl_Obj *const *sourceObjs; Interp *iPtr = (Interp *) interp; @@ -2283,8 +2287,9 @@ EnsembleUnknownCallback( Tcl_Obj *const objv[], Tcl_Obj **prefixObjPtr) { - int paramc, i, prefixObjc; + size_t paramc; int result; + size_t i, prefixObjc; Tcl_Obj **paramv, *unknownCmd, *ensObj; /* @@ -2295,7 +2300,7 @@ EnsembleUnknownCallback( TclNewObj(ensObj); Tcl_GetCommandFullName(interp, ensemblePtr->token, ensObj); Tcl_ListObjAppendElement(NULL, unknownCmd, ensObj); - for (i = 1 ; i < objc ; i++) { + for (i = 1 ; i < (size_t)objc ; i++) { Tcl_ListObjAppendElement(NULL, unknownCmd, objv[i]); } TclListObjGetElementsM(NULL, unknownCmd, ¶mc, ¶mv); @@ -2428,7 +2433,7 @@ MakeCachedEnsembleCommand( * Replace any old internal representation with a new one. */ - ensembleCmd = (EnsembleCmdRep *)ckalloc(sizeof(EnsembleCmdRep)); + ensembleCmd = (EnsembleCmdRep *)Tcl_Alloc(sizeof(EnsembleCmdRep)); ECRSetInternalRep(objPtr, ensembleCmd); } @@ -2480,7 +2485,7 @@ ClearTable( Tcl_DecrRefCount(prefixObj); hPtr = Tcl_NextHashEntry(&search); } - ckfree((char *) ensemblePtr->subcommandArrayPtr); + Tcl_Free(ensemblePtr->subcommandArrayPtr); } Tcl_DeleteHashTable(hash); } @@ -2572,7 +2577,7 @@ BuildEnsembleConfig( { Tcl_HashSearch search; /* Used for scanning the commands in * the namespace for this ensemble. */ - int i, j; + size_t i, j; int isNew; Tcl_HashTable *hash = &ensemblePtr->subcommandTable; Tcl_HashEntry *hPtr; @@ -2583,7 +2588,7 @@ BuildEnsembleConfig( Tcl_InitHashTable(hash, TCL_STRING_KEYS); if (subList) { - int subc; + size_t subc; Tcl_Obj **subv, *target, *cmdObj, *cmdPrefixObj; const char *name; @@ -2647,7 +2652,7 @@ BuildEnsembleConfig( * Target was not in the dictionary. Map onto the namespace. * In this case there is no guarantee that the command * is actually there. It is the responsibility of the - * programmer (or [::unknown] of course) to provide the procedure. + * programmer (or [::unknown] of course) to provide the procedure. */ cmdObj = Tcl_NewStringObj(name, -1); @@ -2730,7 +2735,7 @@ BuildEnsembleConfig( } /* - * Create a sorted array of all subcommands in the ensemble; hash tables + * Create a sorted array of all subcommands in the ensemble. Hash tables * are all very well for a quick look for an exact match, but they can't * determine things like whether a string is a prefix of another, at least * not without a lot of preparation, and they're not useful for generating @@ -2742,7 +2747,7 @@ BuildEnsembleConfig( */ ensemblePtr->subcommandArrayPtr = - (char **)ckalloc(sizeof(char *) * hash->numEntries); + (char **)Tcl_Alloc(sizeof(char *) * hash->numEntries); /* * Fill the array from both ends as this reduces the likelihood of @@ -2835,7 +2840,7 @@ FreeEnsembleCmdRep( if (ensembleCmd->fix) { Tcl_DecrRefCount(ensembleCmd->fix); } - ckfree(ensembleCmd); + Tcl_Free(ensembleCmd); } /* @@ -2862,7 +2867,7 @@ DupEnsembleCmdRep( Tcl_Obj *copyPtr) { EnsembleCmdRep *ensembleCmd; - EnsembleCmdRep *ensembleCopy = (EnsembleCmdRep *)ckalloc(sizeof(EnsembleCmdRep)); + EnsembleCmdRep *ensembleCopy = (EnsembleCmdRep *)Tcl_Alloc(sizeof(EnsembleCmdRep)); ECRGetInternalRep(objPtr, ensembleCmd); ECRSetInternalRep(copyPtr, ensembleCopy); @@ -2915,13 +2920,12 @@ TclCompileEnsemble( Command *oldCmdPtr = cmdPtr, *newCmdPtr; int result, flags = 0, depth = 1, invokeAnyway = 0; int ourResult = TCL_ERROR; - int i, len; - TCL_HASH_TYPE numBytes; + size_t i, len, numBytes; const char *word; TclNewObj(replaced); Tcl_IncrRefCount(replaced); - if (parsePtr->numWords <= depth) { + if ((int)parsePtr->numWords <= depth) { goto failed; } if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { @@ -2986,7 +2990,7 @@ TclCompileEnsemble( (void) Tcl_GetEnsembleSubcommandList(NULL, ensemble, &listObj); if (listObj != NULL) { - int sclen; + size_t sclen; const char *str; Tcl_Obj *matchObj = NULL; @@ -2994,8 +2998,8 @@ TclCompileEnsemble( goto failed; } for (i=0 ; i<len ; i++) { - str = TclGetStringFromObj(elems[i], &sclen); - if ((sclen == (int) numBytes) && !memcmp(word, str, numBytes)) { + str = Tcl_GetStringFromObj(elems[i], &sclen); + if ((sclen == numBytes) && !memcmp(word, str, numBytes)) { /* * Exact match! Excellent! */ @@ -3042,7 +3046,7 @@ TclCompileEnsemble( * No map, so check the dictionary directly. */ - TclNewStringObj(subcmdObj, word, (int) numBytes); + TclNewStringObj(subcmdObj, word, numBytes); result = Tcl_DictObjGet(NULL, mapObj, subcmdObj, &targetCmdObj); if (result == TCL_OK && targetCmdObj != NULL) { /* @@ -3148,7 +3152,7 @@ TclCompileEnsemble( if (cmdPtr->compileProc == TclCompileEnsemble) { tokenPtr = TokenAfter(tokenPtr); - if (parsePtr->numWords < depth + 1 + if ((int)parsePtr->numWords < depth + 1 || tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { /* * Too hard because the user has done something unpleasant like @@ -3183,7 +3187,7 @@ TclCompileEnsemble( while (mapPtr->nuloc > eclIndex + 1) { mapPtr->nuloc--; - ckfree(mapPtr->loc[mapPtr->nuloc].line); + Tcl_Free(mapPtr->loc[mapPtr->nuloc].line); mapPtr->loc[mapPtr->nuloc].line = NULL; } @@ -3243,20 +3247,20 @@ int TclAttemptCompileProc( Tcl_Interp *interp, Tcl_Parse *parsePtr, - int depth, + size_t depth, Command *cmdPtr, CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; int result; - int i; + size_t i; Tcl_Token *saveTokenPtr = parsePtr->tokenPtr; - int savedStackDepth = envPtr->currStackDepth; - TCL_HASH_TYPE savedCodeNext = envPtr->codeNext - envPtr->codeStart; - int savedAuxDataArrayNext = envPtr->auxDataArrayNext; - int savedExceptArrayNext = envPtr->exceptArrayNext; + size_t savedStackDepth = envPtr->currStackDepth; + unsigned savedCodeNext = envPtr->codeNext - envPtr->codeStart; + size_t savedAuxDataArrayNext = envPtr->auxDataArrayNext; + size_t savedExceptArrayNext = envPtr->exceptArrayNext; #ifdef TCL_COMPILE_DEBUG - int savedExceptDepth = envPtr->exceptDepth; + size_t savedExceptDepth = envPtr->exceptDepth; #endif if (cmdPtr->compileProc == NULL) { @@ -3315,12 +3319,12 @@ TclAttemptCompileProc( ExceptionAux *auxPtr = envPtr->exceptAuxArrayPtr; for (i = 0; i < savedExceptArrayNext; i++) { - while (auxPtr->numBreakTargets > 0 + while ((int)auxPtr->numBreakTargets > 0 && auxPtr->breakTargets[auxPtr->numBreakTargets - 1] >= savedCodeNext) { auxPtr->numBreakTargets--; } - while (auxPtr->numContinueTargets > 0 + while ((int)auxPtr->numContinueTargets > 0 && auxPtr->continueTargets[auxPtr->numContinueTargets - 1] >= savedCodeNext) { auxPtr->numContinueTargets--; @@ -3359,7 +3363,7 @@ TclAttemptCompileProc( if (diff != 1) { Tcl_Panic("bad stack adjustment when compiling" - " %.*s (was %d instead of 1)", parsePtr->tokenPtr->size, + " %.*s (was %d instead of 1)", (int)parsePtr->tokenPtr->size, parsePtr->tokenPtr->start, diff); } #endif @@ -3386,7 +3390,7 @@ CompileToInvokedCommand( Tcl_Obj *objPtr, **words; const char *bytes; int cmdLit, extraLiteralFlags = LITERAL_CMD_NAME; - int i, numWords, length; + size_t i, numWords, length; /* * Push the words of the command. Take care; the command words may be @@ -3398,7 +3402,7 @@ CompileToInvokedCommand( for (i = 0, tokPtr = parsePtr->tokenPtr; i < parsePtr->numWords; i++, tokPtr = TokenAfter(tokPtr)) { if (i > 0 && i <= numWords) { - bytes = TclGetStringFromObj(words[i-1], &length); + bytes = Tcl_GetStringFromObj(words[i-1], &length); PushLiteral(envPtr, bytes, length); continue; } @@ -3427,7 +3431,7 @@ CompileToInvokedCommand( TclNewObj(objPtr); Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, objPtr); - bytes = TclGetStringFromObj(objPtr, &length); + bytes = Tcl_GetStringFromObj(objPtr, &length); if ((cmdPtr != NULL) && (cmdPtr->flags & CMD_VIA_RESOLVER)) { extraLiteralFlags |= LITERAL_UNSHARED; } @@ -3688,7 +3692,7 @@ TclCompileBasicMin0ArgCmd( * which is the only code that sees the shenanigans of ensemble dispatch. */ - if (parsePtr->numWords < 1) { + if ((int)parsePtr->numWords < 1) { return TCL_ERROR; } @@ -3710,7 +3714,7 @@ TclCompileBasicMin1ArgCmd( * which is the only code that sees the shenanigans of ensemble dispatch. */ - if (parsePtr->numWords < 2) { + if ((int)parsePtr->numWords < 2) { return TCL_ERROR; } @@ -3732,7 +3736,7 @@ TclCompileBasicMin2ArgCmd( * which is the only code that sees the shenanigans of ensemble dispatch. */ - if (parsePtr->numWords < 3) { + if ((int)parsePtr->numWords < 3) { return TCL_ERROR; } diff --git a/generic/tclEnv.c b/generic/tclEnv.c index 1378708..630e89c 100644 --- a/generic/tclEnv.c +++ b/generic/tclEnv.c @@ -42,7 +42,7 @@ size_t TclEnvEpoch = 0; /* Epoch of the tcl environment * (if changed with tcl-env). */ static struct { - int cacheSize; /* Number of env strings in cache. */ + size_t cacheSize; /* Number of env strings in cache. */ char **cache; /* Array containing all of the environment * strings that Tcl has allocated. */ #ifndef USE_PUTENV @@ -50,7 +50,7 @@ static struct { * need to track this in case another * subsystem swaps around the environ array * like we do. */ - int ourEnvironSize; /* Non-zero means that the environ array was + size_t 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 @@ -64,7 +64,7 @@ static struct { * Declarations for local functions defined in this file: */ -static char * EnvTraceProc(ClientData clientData, Tcl_Interp *interp, +static char * EnvTraceProc(void *clientData, Tcl_Interp *interp, const char *name1, const char *name2, int flags); static void ReplaceString(const char *oldStr, char *newStr); MODULE_SCOPE void TclSetEnv(const char *name, const char *value); @@ -253,8 +253,8 @@ TclSetEnv( const char *value) /* New value for variable (UTF-8). */ { Tcl_DString envString; - unsigned nameLength, valueLength; - int index, length; + size_t nameLength, valueLength; + size_t index, length; char *p, *oldValue; const techar *p2; @@ -267,7 +267,7 @@ TclSetEnv( Tcl_MutexLock(&envMutex); index = TclpFindVariable(name, &length); - if (index == -1) { + if (index == TCL_INDEX_NONE) { #ifndef USE_PUTENV /* * We need to handle the case where the environment may be changed @@ -276,11 +276,11 @@ TclSetEnv( */ if ((env.ourEnviron != tenviron) || (length+2 > env.ourEnvironSize)) { - techar **newEnviron = (techar **)ckalloc((length + 5) * sizeof(techar *)); + techar **newEnviron = (techar **)Tcl_Alloc((length + 5) * sizeof(techar *)); memcpy(newEnviron, tenviron, length * sizeof(techar *)); if ((env.ourEnvironSize != 0) && (env.ourEnviron != NULL)) { - ckfree(env.ourEnviron); + Tcl_Free(env.ourEnviron); } tenviron = (env.ourEnviron = newEnviron); env.ourEnvironSize = length + 5; @@ -320,7 +320,7 @@ TclSetEnv( */ valueLength = strlen(value); - p = (char *)ckalloc(nameLength + valueLength + 2); + p = (char *)Tcl_Alloc(nameLength + valueLength + 2); memcpy(p, name, nameLength); p[nameLength] = '='; memcpy(p+nameLength+1, value, valueLength+1); @@ -330,7 +330,7 @@ TclSetEnv( * Copy the native string to heap memory. */ - p = (char *)ckrealloc(p, Tcl_DStringLength(&envString) + tNTL); + p = (char *)Tcl_Realloc(p, Tcl_DStringLength(&envString) + tNTL); memcpy(p, p2, Tcl_DStringLength(&envString) + tNTL); Tcl_DStringFree(&envString); @@ -351,7 +351,7 @@ TclSetEnv( * string in the cache. */ - if ((index != -1) && (tenviron[index] == (techar *)p)) { + if ((index != TCL_INDEX_NONE) && (tenviron[index] == (techar *)p)) { ReplaceString(oldValue, p); #ifdef HAVE_PUTENV_THAT_COPIES } else { @@ -359,20 +359,11 @@ TclSetEnv( * This putenv() copies instead of taking ownership. */ - ckfree(p); + Tcl_Free(p); #endif /* HAVE_PUTENV_THAT_COPIES */ } Tcl_MutexUnlock(&envMutex); - - if (!strcmp(name, "HOME")) { - /* - * If the user's home directory has changed, we must invalidate the - * filesystem cache, because '~' expansions will now be incorrect. - */ - - Tcl_FSMountsChanged(NULL); - } } /* @@ -462,8 +453,7 @@ TclUnsetEnv( const char *name) /* Name of variable to remove (UTF-8). */ { char *oldValue; - int length; - int index; + size_t length, index; #ifdef USE_PUTENV_FOR_UNSET Tcl_DString envString; char *string; @@ -479,7 +469,7 @@ TclUnsetEnv( * needless work and to avoid recursion on the unset. */ - if (index == -1) { + if (index == TCL_INDEX_NONE) { Tcl_MutexUnlock(&envMutex); return; } @@ -502,18 +492,18 @@ TclUnsetEnv( */ #if defined(_WIN32) - string = (char *)ckalloc(length + 2); + string = (char *)Tcl_Alloc(length + 2); memcpy(string, name, length); string[length] = '='; string[length+1] = '\0'; #else - string = (char *)ckalloc(length + 1); + string = (char *)Tcl_Alloc(length + 1); memcpy(string, name, length); string[length] = '\0'; #endif /* _WIN32 */ utf2tenvirondstr(string, -1, &envString); - string = (char *)ckrealloc(string, Tcl_DStringLength(&envString) + tNTL); + string = (char *)Tcl_Realloc(string, Tcl_DStringLength(&envString) + tNTL); memcpy(string, Tcl_DStringValue(&envString), Tcl_DStringLength(&envString) + tNTL); Tcl_DStringFree(&envString); @@ -534,7 +524,7 @@ TclUnsetEnv( * This putenv() copies instead of taking ownership. */ - ckfree(string); + Tcl_Free(string); #endif /* HAVE_PUTENV_THAT_COPIES */ } #else /* !USE_PUTENV_FOR_UNSET */ @@ -578,13 +568,13 @@ TclGetEnv( * value of the environment variable is * stored. */ { - int length, index; + size_t length, index; const char *result; Tcl_MutexLock(&envMutex); index = TclpFindVariable(name, &length); result = NULL; - if (index != -1) { + if (index != TCL_INDEX_NONE) { Tcl_DString envStr; result = tenviron2utfdstr(tenviron[index], -1, &envStr); @@ -626,7 +616,7 @@ TclGetEnv( static char * EnvTraceProc( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Interpreter whose "env" variable is being * modified. */ const char *name1, /* Better be "env". */ @@ -713,7 +703,7 @@ ReplaceString( const char *oldStr, /* Old environment string. */ char *newStr) /* New environment string. */ { - int i; + size_t i; /* * Check to see if the old value was allocated by Tcl. If so, it needs to @@ -733,7 +723,7 @@ ReplaceString( */ if (env.cache[i]) { - ckfree(env.cache[i]); + Tcl_Free(env.cache[i]); } if (newStr) { @@ -751,11 +741,11 @@ ReplaceString( const int growth = 5; - env.cache = (char **)ckrealloc(env.cache, + env.cache = (char **)Tcl_Realloc(env.cache, (env.cacheSize + growth) * sizeof(char *)); env.cache[env.cacheSize] = newStr; (void) memset(env.cache+env.cacheSize+1, 0, - (size_t) (growth-1) * sizeof(char *)); + (growth-1) * sizeof(char *)); env.cacheSize += growth; } } @@ -792,17 +782,17 @@ TclFinalizeEnvironment(void) if (env.cache) { #ifdef PURIFY - int i; + size_t i; for (i = 0; i < env.cacheSize; i++) { - ckfree(env.cache[i]); + Tcl_Free(env.cache[i]); } #endif - ckfree(env.cache); + Tcl_Free(env.cache); env.cache = NULL; env.cacheSize = 0; #ifndef USE_PUTENV if ((env.ourEnviron != NULL)) { - ckfree(env.ourEnviron); + Tcl_Free(env.ourEnviron); env.ourEnviron = NULL; } env.ourEnvironSize = 0; diff --git a/generic/tclEvent.c b/generic/tclEvent.c index 1e2e7bf..4a61d60 100644 --- a/generic/tclEvent.c +++ b/generic/tclEvent.c @@ -141,7 +141,7 @@ static void FinalizeThread(int quick); /* *---------------------------------------------------------------------- * - * Tcl_BackgroundError -- + * Tcl_BackgroundException -- * * This function is invoked to handle errors that occur in Tcl commands * that are invoked in "background" (e.g. from event or timer bindings). @@ -156,17 +156,6 @@ static void FinalizeThread(int quick); *---------------------------------------------------------------------- */ -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 -#undef Tcl_BackgroundError -void -Tcl_BackgroundError( - Tcl_Interp *interp) /* Interpreter in which an error has - * occurred. */ -{ - Tcl_BackgroundException(interp, TCL_ERROR); -} -#endif /* TCL_NO_DEPRECATED */ - void Tcl_BackgroundException( Tcl_Interp *interp, /* Interpreter in which an exception has @@ -180,7 +169,7 @@ Tcl_BackgroundException( return; } - errPtr = (BgError*)ckalloc(sizeof(BgError)); + errPtr = (BgError*)Tcl_Alloc(sizeof(BgError)); errPtr->errorMsg = Tcl_GetObjResult(interp); Tcl_IncrRefCount(errPtr->errorMsg); errPtr->returnOpts = Tcl_GetReturnOptions(interp, code); @@ -234,7 +223,8 @@ HandleBgErrors( Tcl_Preserve(assocPtr); Tcl_Preserve(interp); while (assocPtr->firstBgPtr != NULL) { - int code, prefixObjc; + int code; + size_t prefixObjc; Tcl_Obj **prefixObjv, **tempObjv; /* @@ -247,7 +237,7 @@ HandleBgErrors( errPtr = assocPtr->firstBgPtr; TclListObjGetElementsM(NULL, copyObj, &prefixObjc, &prefixObjv); - tempObjv = (Tcl_Obj**)ckalloc((prefixObjc+2) * sizeof(Tcl_Obj *)); + tempObjv = (Tcl_Obj**)Tcl_Alloc((prefixObjc+2) * sizeof(Tcl_Obj *)); memcpy(tempObjv, prefixObjv, prefixObjc*sizeof(Tcl_Obj *)); tempObjv[prefixObjc] = errPtr->errorMsg; tempObjv[prefixObjc+1] = errPtr->returnOpts; @@ -262,8 +252,8 @@ HandleBgErrors( Tcl_DecrRefCount(errPtr->errorMsg); Tcl_DecrRefCount(errPtr->returnOpts); assocPtr->firstBgPtr = errPtr->nextPtr; - ckfree(errPtr); - ckfree(tempObjv); + Tcl_Free(errPtr); + Tcl_Free(tempObjv); if (code == TCL_BREAK) { /* @@ -276,7 +266,7 @@ HandleBgErrors( assocPtr->firstBgPtr = errPtr->nextPtr; Tcl_DecrRefCount(errPtr->errorMsg); Tcl_DecrRefCount(errPtr->returnOpts); - ckfree(errPtr); + Tcl_Free(errPtr); } } else if ((code == TCL_ERROR) && !Tcl_IsSafe(interp)) { Tcl_Channel errChannel = Tcl_GetStdChannel(TCL_STDERR); @@ -545,7 +535,7 @@ TclSetBgErrorHandler( * First access: initialize. */ - assocPtr = (ErrAssocData*)ckalloc(sizeof(ErrAssocData)); + assocPtr = (ErrAssocData*)Tcl_Alloc(sizeof(ErrAssocData)); assocPtr->interp = interp; assocPtr->cmdPrefix = NULL; assocPtr->firstBgPtr = NULL; @@ -624,7 +614,7 @@ BgErrorDeleteProc( assocPtr->firstBgPtr = errPtr->nextPtr; Tcl_DecrRefCount(errPtr->errorMsg); Tcl_DecrRefCount(errPtr->returnOpts); - ckfree(errPtr); + Tcl_Free(errPtr); } Tcl_CancelIdleCall(HandleBgErrors, assocPtr); Tcl_DecrRefCount(assocPtr->cmdPrefix); @@ -654,7 +644,7 @@ Tcl_CreateExitHandler( Tcl_ExitProc *proc, /* Function to invoke. */ void *clientData) /* Arbitrary value to pass to proc. */ { - ExitHandler *exitPtr = (ExitHandler*)ckalloc(sizeof(ExitHandler)); + ExitHandler *exitPtr = (ExitHandler*)Tcl_Alloc(sizeof(ExitHandler)); exitPtr->proc = proc; exitPtr->clientData = clientData; @@ -687,7 +677,7 @@ TclCreateLateExitHandler( Tcl_ExitProc *proc, /* Function to invoke. */ void *clientData) /* Arbitrary value to pass to proc. */ { - ExitHandler *exitPtr = (ExitHandler*)ckalloc(sizeof(ExitHandler)); + ExitHandler *exitPtr = (ExitHandler*)Tcl_Alloc(sizeof(ExitHandler)); exitPtr->proc = proc; exitPtr->clientData = clientData; @@ -732,7 +722,7 @@ Tcl_DeleteExitHandler( } else { prevPtr->nextPtr = exitPtr->nextPtr; } - ckfree(exitPtr); + Tcl_Free(exitPtr); break; } } @@ -775,7 +765,7 @@ TclDeleteLateExitHandler( } else { prevPtr->nextPtr = exitPtr->nextPtr; } - ckfree(exitPtr); + Tcl_Free(exitPtr); break; } } @@ -809,7 +799,7 @@ Tcl_CreateThreadExitHandler( ExitHandler *exitPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - exitPtr = (ExitHandler*)ckalloc(sizeof(ExitHandler)); + exitPtr = (ExitHandler*)Tcl_Alloc(sizeof(ExitHandler)); exitPtr->proc = proc; exitPtr->clientData = clientData; exitPtr->nextPtr = tsdPtr->firstExitPtr; @@ -851,7 +841,7 @@ Tcl_DeleteThreadExitHandler( } else { prevPtr->nextPtr = exitPtr->nextPtr; } - ckfree(exitPtr); + Tcl_Free(exitPtr); return; } } @@ -929,7 +919,7 @@ InvokeExitHandlers(void) firstExitPtr = exitPtr->nextPtr; Tcl_MutexUnlock(&exitMutex); exitPtr->proc(exitPtr->clientData); - ckfree(exitPtr); + Tcl_Free(exitPtr); Tcl_MutexLock(&exitMutex); } firstExitPtr = NULL; @@ -1240,7 +1230,7 @@ Tcl_Finalize(void) firstLateExitPtr = exitPtr->nextPtr; Tcl_MutexUnlock(&exitMutex); exitPtr->proc(exitPtr->clientData); - ckfree(exitPtr); + Tcl_Free(exitPtr); Tcl_MutexLock(&exitMutex); } firstLateExitPtr = NULL; @@ -1351,7 +1341,7 @@ Tcl_Finalize(void) TclResetFilesystem(); /* - * At this point, there should no longer be any ckalloc'ed memory. + * At this point, there should no longer be any Tcl_Alloc'ed memory. */ TclFinalizeMemorySubsystem(); @@ -1410,7 +1400,7 @@ FinalizeThread( tsdPtr->firstExitPtr = exitPtr->nextPtr; exitPtr->proc(exitPtr->clientData); - ckfree(exitPtr); + Tcl_Free(exitPtr); } TclFinalizeIOSubsystem(); TclFinalizeNotifier(); @@ -1531,7 +1521,7 @@ Tcl_VwaitObjCmd( } if ((unsigned) objc - 1 > sizeof(localItems) / sizeof(localItems[0])) { - vwaitItems = (VwaitItem *) ckalloc(sizeof(VwaitItem) * (objc - 1)); + vwaitItems = (VwaitItem *) Tcl_Alloc(sizeof(VwaitItem) * (objc - 1)); } for (i = 1; i < objc; i++) { @@ -1861,7 +1851,7 @@ Tcl_VwaitObjCmd( result = Tcl_RestoreInterpState(interp, saved); } if (vwaitItems != localItems) { - ckfree(vwaitItems); + Tcl_Free(vwaitItems); } return result; } @@ -1956,10 +1946,9 @@ Tcl_UpdateObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int optionIndex; int flags = 0; /* Initialized to avoid compiler warning. */ static const char *const updateOptions[] = {"idletasks", NULL}; - enum updateOptionsEnum {OPT_IDLETASKS}; + enum updateOptionsEnum {OPT_IDLETASKS} optionIndex; if (objc == 1) { flags = TCL_ALL_EVENTS|TCL_DONT_WAIT; @@ -1968,7 +1957,7 @@ Tcl_UpdateObjCmd( "option", 0, &optionIndex) != TCL_OK) { return TCL_ERROR; } - switch ((enum updateOptionsEnum) optionIndex) { + switch (optionIndex) { case OPT_IDLETASKS: flags = TCL_IDLE_EVENTS|TCL_DONT_WAIT; break; @@ -2027,7 +2016,7 @@ NewThreadProc( threadProc = cdPtr->proc; threadClientData = cdPtr->clientData; - ckfree(clientData); /* Allocated in Tcl_CreateThread() */ + Tcl_Free(clientData); /* Allocated in Tcl_CreateThread() */ threadProc(threadClientData); @@ -2059,19 +2048,19 @@ 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() */ - int stackSize, /* Size of stack for the new thread */ + size_t stackSize, /* Size of stack for the new thread */ int flags) /* Flags controlling behaviour of the new * thread. */ { #if TCL_THREADS - ThreadClientData *cdPtr = (ThreadClientData *)ckalloc(sizeof(ThreadClientData)); + ThreadClientData *cdPtr = (ThreadClientData *)Tcl_Alloc(sizeof(ThreadClientData)); int result; cdPtr->proc = proc; cdPtr->clientData = clientData; result = TclpThreadCreate(idPtr, NewThreadProc, cdPtr, stackSize, flags); if (result != TCL_OK) { - ckfree(cdPtr); + Tcl_Free(cdPtr); } return result; #else diff --git a/generic/tclExecute.c b/generic/tclExecute.c index a8d9d57..950cabe 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -78,7 +78,7 @@ int tclTraceExec = 0; */ static const char *const operatorStrings[] = { - "||", "&&", "|", "^", "&", "==", "!=", "<", ">", "<=", ">=", "<<", ">>", + "|", "^", "&", "==", "!=", "<", ">", "<=", ">=", "<<", ">>", "+", "-", "*", "/", "%", "+", "-", "~", "!" }; @@ -102,64 +102,6 @@ size_t tclObjsAlloced = 0; size_t tclObjsFreed = 0; size_t tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 }; #endif /* TCL_COMPILE_STATS */ - -/* - * Support pre-8.5 bytecodes unless specifically requested otherwise. - */ - -#ifndef TCL_SUPPORT_84_BYTECODE -#define TCL_SUPPORT_84_BYTECODE 1 -#endif - -#if TCL_SUPPORT_84_BYTECODE -/* - * We need to know the tclBuiltinFuncTable to support translation of pre-8.5 - * math functions to the namespace-based ::tcl::mathfunc::op in 8.5+. - */ - -typedef struct { - const char *name; /* Name of function. */ - int numArgs; /* Number of arguments for function. */ -} BuiltinFunc; - -/* - * Table describing the built-in math functions. Entries in this table are - * indexed by the values of the INST_CALL_BUILTIN_FUNC instruction's - * operand byte. - */ - -static BuiltinFunc const tclBuiltinFuncTable[] = { - {"acos", 1}, - {"asin", 1}, - {"atan", 1}, - {"atan2", 2}, - {"ceil", 1}, - {"cos", 1}, - {"cosh", 1}, - {"exp", 1}, - {"floor", 1}, - {"fmod", 2}, - {"hypot", 2}, - {"log", 1}, - {"log10", 1}, - {"pow", 2}, - {"sin", 1}, - {"sinh", 1}, - {"sqrt", 1}, - {"tan", 1}, - {"tanh", 1}, - {"abs", 1}, - {"double", 1}, - {"int", 1}, - {"rand", 0}, - {"round", 1}, - {"srand", 1}, - {"wide", 1}, - {NULL, 0}, -}; - -#define LAST_BUILTIN_FUNC 25 -#endif /* * NR_TEBC @@ -438,7 +380,7 @@ VarHashCreateVar( #ifdef TCL_COMPILE_DEBUG # define TRACE(a) \ while (traceInstructions) { \ - fprintf(stdout, "%2d: %2" TCL_Z_MODIFIER "u (%" TCL_Z_MODIFIER "u) %s ", iPtr->numLevels, \ + fprintf(stdout, "%2" TCL_Z_MODIFIER "u: %2" TCL_Z_MODIFIER "u (%" TCL_Z_MODIFIER "u) %s ", iPtr->numLevels, \ CURR_DEPTH, \ (size_t)(pc - codePtr->codeStart), \ GetOpcodeName(pc)); \ @@ -454,7 +396,7 @@ VarHashCreateVar( TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp)))); # define TRACE_WITH_OBJ(a, objPtr) \ while (traceInstructions) { \ - fprintf(stdout, "%2d: %2" TCL_Z_MODIFIER "u (%" TCL_Z_MODIFIER "u) %s ", iPtr->numLevels, \ + fprintf(stdout, "%2" TCL_Z_MODIFIER "u: %2" TCL_Z_MODIFIER "u (%" TCL_Z_MODIFIER "u) %s ", iPtr->numLevels, \ CURR_DEPTH, \ (size_t)(pc - codePtr->codeStart), \ GetOpcodeName(pc)); \ @@ -693,9 +635,9 @@ 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, int *lengthPtr, + ByteCode *codePtr, size_t *lengthPtr, const unsigned char **pcBeg, int *cmdIdxPtr); -static Tcl_Obj ** GrowEvaluationStack(ExecEnv *eePtr, int growth, +static Tcl_Obj ** GrowEvaluationStack(ExecEnv *eePtr, size_t growth, int move); static void IllegalExprOperandType(Tcl_Interp *interp, const unsigned char *pc, Tcl_Obj *opndPtr); @@ -703,8 +645,8 @@ static void InitByteCodeExecution(Tcl_Interp *interp); static inline int wordSkip(void *ptr); static void ReleaseDictIterator(Tcl_Obj *objPtr); /* Useful elsewhere, make available in tclInt.h or stubs? */ -static Tcl_Obj ** StackAllocWords(Tcl_Interp *interp, int numWords); -static Tcl_Obj ** StackReallocWords(Tcl_Interp *interp, int numWords); +static Tcl_Obj ** StackAllocWords(Tcl_Interp *interp, size_t numWords); +static Tcl_Obj ** StackReallocWords(Tcl_Interp *interp, size_t numWords); static Tcl_NRPostProc CopyCallback; static Tcl_NRPostProc ExprObjCallback; static Tcl_NRPostProc FinalizeOONext; @@ -721,7 +663,8 @@ static const Tcl_ObjType exprCodeType = { FreeExprCodeInternalRep, /* freeIntRepProc */ DupExprCodeInternalRep, /* dupIntRepProc */ NULL, /* updateStringProc */ - NULL /* setFromAnyProc */ + NULL, /* setFromAnyProc */ + TCL_OBJTYPE_V0 }; /* @@ -732,7 +675,7 @@ static const Tcl_ObjType exprCodeType = { static const Tcl_ObjType dictIteratorType = { "dictIterator", ReleaseDictIterator, - NULL, NULL, NULL + NULL, NULL, NULL, TCL_OBJTYPE_V0 }; /* @@ -770,7 +713,7 @@ ReleaseDictIterator( searchPtr = (Tcl_DictSearch *)irPtr->twoPtrValue.ptr1; Tcl_DictObjDone(searchPtr); - ckfree(searchPtr); + Tcl_Free(searchPtr); dictPtr = (Tcl_Obj *)irPtr->twoPtrValue.ptr2; TclDecrRefCount(dictPtr); @@ -850,11 +793,11 @@ ExecEnv * TclCreateExecEnv( Tcl_Interp *interp, /* Interpreter for which the execution * environment is being created. */ - int size) /* The initial stack size, in number of words + size_t size) /* The initial stack size, in number of words * [sizeof(Tcl_Obj*)] */ { - ExecEnv *eePtr = (ExecEnv *)ckalloc(sizeof(ExecEnv)); - ExecStack *esPtr = (ExecStack *)ckalloc(offsetof(ExecStack, stackWords) + ExecEnv *eePtr = (ExecEnv *)Tcl_Alloc(sizeof(ExecEnv)); + ExecStack *esPtr = (ExecStack *)Tcl_Alloc(offsetof(ExecStack, stackWords) + size * sizeof(Tcl_Obj *)); eePtr->execStackPtr = esPtr; @@ -914,7 +857,7 @@ DeleteExecStack( if (esPtr->nextPtr) { esPtr->nextPtr->prevPtr = esPtr->prevPtr; } - ckfree(esPtr); + Tcl_Free(esPtr); } void @@ -946,7 +889,7 @@ TclDeleteExecEnv( if (eePtr->corPtr && !cachedInExit) { Tcl_Panic("Deleting execEnv with existing coroutine"); } - ckfree(eePtr); + Tcl_Free(eePtr); } /* @@ -1032,13 +975,14 @@ static Tcl_Obj ** GrowEvaluationStack( ExecEnv *eePtr, /* Points to the ExecEnv with an evaluation * stack to enlarge. */ - int growth, /* How much larger than the current used + size_t growth1, /* How much larger than the current used * size. */ int move) /* 1 if move words since last marker. */ { ExecStack *esPtr = eePtr->execStackPtr, *oldPtr = NULL; - int newBytes, newElems, currElems; - int needed = growth - (esPtr->endPtr - esPtr->tosPtr); + size_t newBytes; + int growth = growth1; + int newElems, currElems, needed = growth - (esPtr->endPtr - esPtr->tosPtr); Tcl_Obj **markerPtr = esPtr->markerPtr, **memStart; int moveWords = 0; @@ -1123,7 +1067,7 @@ GrowEvaluationStack( newBytes = offsetof(ExecStack, stackWords) + newElems * sizeof(Tcl_Obj *); oldPtr = esPtr; - esPtr = (ExecStack *)ckalloc(newBytes); + esPtr = (ExecStack *)Tcl_Alloc(newBytes); oldPtr->nextPtr = esPtr; esPtr->prevPtr = oldPtr; @@ -1183,7 +1127,7 @@ GrowEvaluationStack( static Tcl_Obj ** StackAllocWords( Tcl_Interp *interp, - int numWords) + size_t numWords) { /* * Note that GrowEvaluationStack sets a marker in the stack. This marker @@ -1201,7 +1145,7 @@ StackAllocWords( static Tcl_Obj ** StackReallocWords( Tcl_Interp *interp, - int numWords) + size_t numWords) { Interp *iPtr = (Interp *) interp; ExecEnv *eePtr = iPtr->execEnvPtr; @@ -1222,7 +1166,7 @@ TclStackFree( Tcl_Obj **markerPtr, *marker; if (iPtr == NULL || iPtr->execEnvPtr == NULL) { - ckfree(freePtr); + Tcl_Free(freePtr); return; } @@ -1280,32 +1224,32 @@ TclStackFree( void * TclStackAlloc( Tcl_Interp *interp, - int numBytes) + size_t numBytes) { Interp *iPtr = (Interp *) interp; - int numWords; + size_t numWords; if (iPtr == NULL || iPtr->execEnvPtr == NULL) { - return (void *) ckalloc(numBytes); + return (void *) Tcl_Alloc(numBytes); } numWords = (numBytes + (sizeof(Tcl_Obj *) - 1))/sizeof(Tcl_Obj *); - return (void *) StackAllocWords(interp, numWords); + return StackAllocWords(interp, numWords); } void * TclStackRealloc( Tcl_Interp *interp, void *ptr, - int numBytes) + size_t numBytes) { Interp *iPtr = (Interp *) interp; ExecEnv *eePtr; ExecStack *esPtr; Tcl_Obj **markerPtr; - int numWords; + size_t numWords; if (iPtr == NULL || iPtr->execEnvPtr == NULL) { - return (void *) ckrealloc((char *) ptr, numBytes); + return Tcl_Realloc(ptr, numBytes); } eePtr = iPtr->execEnvPtr; @@ -1493,8 +1437,8 @@ CompileExprObj( * TIP #280: No invoker (yet) - Expression compilation. */ - int length; - const char *string = TclGetStringFromObj(objPtr, &length); + size_t length; + const char *string = Tcl_GetStringFromObj(objPtr, &length); TclInitCompileEnv(interp, &compEnv, string, length, NULL, 0); TclCompileExpr(interp, string, length, &compEnv, 0); @@ -1736,7 +1680,7 @@ TclCompileObj( } } - if (word < ctxCopyPtr->nline) { + if ((size_t)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 @@ -1945,10 +1889,10 @@ TclNRExecuteByteCode( { Interp *iPtr = (Interp *) interp; TEBCdata *TD; - int size = sizeof(TEBCdata) - 1 + size_t size = sizeof(TEBCdata) - 1 + (codePtr->maxStackDepth + codePtr->maxExceptDepth) * sizeof(void *); - int numWords = (size + sizeof(Tcl_Obj *) - 1) / sizeof(Tcl_Obj *); + size_t numWords = (size + sizeof(Tcl_Obj *) - 1) / sizeof(Tcl_Obj *); TclPreserveByteCode(codePtr); @@ -2105,7 +2049,7 @@ TEBCresume( Tcl_Obj *objPtr, *valuePtr, *value2Ptr, *part1Ptr, *part2Ptr, *tmpPtr; Tcl_Obj **objv = NULL; - int length, objc = 0; + size_t length, objc = 0; int opnd, pcAdjustment; Var *varPtr, *arrayPtr; #ifdef TCL_COMPILE_DEBUG @@ -2181,7 +2125,7 @@ TEBCresume( * instruction. */ - TRACE_WITH_OBJ(("%u => ... after \"%.20s\": TCL_OK, result=", + TRACE_WITH_OBJ(("%" TCL_Z_MODIFIER "u => ... after \"%.20s\": TCL_OK, result=", objc, cmdNameBuf), Tcl_GetObjResult(interp)); /* @@ -2326,7 +2270,7 @@ TEBCresume( CHECK_STACK(); if (traceInstructions) { - fprintf(stdout, "%2d: %2" TCL_Z_MODIFIER "u ", iPtr->numLevels, CURR_DEPTH); + fprintf(stdout, "%2" TCL_Z_MODIFIER "u: %2" TCL_Z_MODIFIER "u ", iPtr->numLevels, CURR_DEPTH); TclPrintInstruction(codePtr, pc); fflush(stdout); } @@ -2446,7 +2390,7 @@ TEBCresume( if (traceInstructions) { TRACE_APPEND(("YIELD...\n")); } else { - fprintf(stdout, "%d: (%" TCL_Z_MODIFIER "u) yielding value \"%.30s\"\n", + fprintf(stdout, "%" TCL_Z_MODIFIER "d: (%" TCL_Z_MODIFIER "u) yielding value \"%.30s\"\n", iPtr->numLevels, (size_t)(pc - codePtr->codeStart), Tcl_GetString(OBJ_AT_TOS)); } @@ -2489,7 +2433,7 @@ TEBCresume( TRACE(("[%.30s] => YIELD...\n", O2S(valuePtr))); } else { /* FIXME: What is the right thing to trace? */ - fprintf(stdout, "%d: (%" TCL_Z_MODIFIER "u) yielding to [%.30s]\n", + fprintf(stdout, "%" TCL_Z_MODIFIER "d: (%" TCL_Z_MODIFIER "u) yielding to [%.30s]\n", iPtr->numLevels, (size_t)(pc - codePtr->codeStart), TclGetString(valuePtr)); } @@ -2685,7 +2629,7 @@ TEBCresume( * command starts. * * Use a Tcl_Obj as linked list element; slight mem waste, but faster - * allocation than ckalloc. This also abuses the Tcl_Obj structure, as + * allocation than Tcl_Alloc. This also abuses the Tcl_Obj structure, as * we do not define a special tclObjType for it. It is not dangerous * as the obj is never passed anywhere, so that all manipulations are * performed here and in INST_INVOKE_EXPANDED (in case of an expansion @@ -2714,11 +2658,11 @@ TEBCresume( /* Ugly abuse! */ starting = 1; #endif - TRACE(("=> drop %d items\n", objc)); + TRACE(("=> drop %" TCL_Z_MODIFIER "u items\n", objc)); NEXT_INST_V(1, objc, 0); case INST_EXPAND_STKTOP: { - int i; + size_t i; TEBCdata *newTD; ptrdiff_t oldCatchTopOff, oldTosPtrOff; @@ -2845,13 +2789,13 @@ TEBCresume( #ifdef TCL_COMPILE_DEBUG if (tclTraceExec >= 2) { - int i; + size_t i; if (traceInstructions) { strncpy(cmdNameBuf, TclGetString(objv[0]), 20); - TRACE(("%u => call ", objc)); + TRACE(("%" TCL_Z_MODIFIER "u => call ", objc)); } else { - fprintf(stdout, "%d: (%" TCL_Z_MODIFIER "u) invoking ", iPtr->numLevels, + fprintf(stdout, "%" TCL_Z_MODIFIER "d: (%" TCL_Z_MODIFIER "u) invoking ", iPtr->numLevels, (size_t)(pc - codePtr->codeStart)); } for (i = 0; i < objc; i++) { @@ -2884,91 +2828,6 @@ TEBCresume( return TclNREvalObjv(interp, objc, objv, TCL_EVAL_NOERR | TCL_EVAL_SOURCE_IN_FRAME, NULL); -#if TCL_SUPPORT_84_BYTECODE - case INST_CALL_BUILTIN_FUNC1: - /* - * Call one of the built-in pre-8.5 Tcl math functions. This - * translates to INST_INVOKE_STK1 with the first argument of - * ::tcl::mathfunc::$objv[0]. We need to insert the named math - * function into the stack. - */ - - opnd = TclGetUInt1AtPtr(pc+1); - if ((opnd < 0) || (opnd > LAST_BUILTIN_FUNC)) { - TRACE(("UNRECOGNIZED BUILTIN FUNC CODE %d\n", opnd)); - Tcl_Panic("TclNRExecuteByteCode: unrecognized builtin function code %d", opnd); - } - - TclNewLiteralStringObj(objPtr, "::tcl::mathfunc::"); - Tcl_AppendToObj(objPtr, tclBuiltinFuncTable[opnd].name, -1); - - /* - * Only 0, 1 or 2 args. - */ - - { - int numArgs = tclBuiltinFuncTable[opnd].numArgs; - Tcl_Obj *tmpPtr1, *tmpPtr2; - - if (numArgs == 0) { - PUSH_OBJECT(objPtr); - } else if (numArgs == 1) { - tmpPtr1 = POP_OBJECT(); - PUSH_OBJECT(objPtr); - PUSH_OBJECT(tmpPtr1); - Tcl_DecrRefCount(tmpPtr1); - } else { - tmpPtr2 = POP_OBJECT(); - tmpPtr1 = POP_OBJECT(); - PUSH_OBJECT(objPtr); - PUSH_OBJECT(tmpPtr1); - PUSH_OBJECT(tmpPtr2); - Tcl_DecrRefCount(tmpPtr1); - Tcl_DecrRefCount(tmpPtr2); - } - objc = numArgs + 1; - } - pcAdjustment = 2; - goto doInvocation; - - case INST_CALL_FUNC1: - /* - * Call a non-builtin Tcl math function previously registered by a - * call to Tcl_CreateMathFunc pre-8.5. This is essentially - * INST_INVOKE_STK1 converting the first arg to - * ::tcl::mathfunc::$objv[0]. - */ - - objc = TclGetUInt1AtPtr(pc+1); /* Number of arguments. The function - * name is the 0-th argument. */ - - objPtr = OBJ_AT_DEPTH(objc-1); - TclNewLiteralStringObj(tmpPtr, "::tcl::mathfunc::"); - Tcl_AppendObjToObj(tmpPtr, objPtr); - Tcl_DecrRefCount(objPtr); - - /* - * Variation of PUSH_OBJECT. - */ - - OBJ_AT_DEPTH(objc-1) = tmpPtr; - Tcl_IncrRefCount(tmpPtr); - - pcAdjustment = 2; - goto doInvocation; -#else - /* - * INST_CALL_BUILTIN_FUNC1 and INST_CALL_FUNC1 were made obsolete by the - * changes to add a ::tcl::mathfunc namespace in 8.5. Optional support - * remains for existing bytecode precompiled files. - */ - - case INST_CALL_BUILTIN_FUNC1: - Tcl_Panic("TclNRExecuteByteCode: obsolete INST_CALL_BUILTIN_FUNC1 found"); - case INST_CALL_FUNC1: - Tcl_Panic("TclNRExecuteByteCode: obsolete INST_CALL_FUNC1 found"); -#endif - case INST_INVOKE_REPLACE: objc = TclGetUInt4AtPtr(pc+1); opnd = TclGetUInt1AtPtr(pc+5); @@ -2977,19 +2836,19 @@ TEBCresume( cleanup = objc; #ifdef TCL_COMPILE_DEBUG if (tclTraceExec >= 2) { - int i; + size_t i; if (traceInstructions) { strncpy(cmdNameBuf, TclGetString(objv[0]), 20); - TRACE(("%u => call (implementation %s) ", objc, O2S(objPtr))); + TRACE(("%" TCL_Z_MODIFIER "u => call (implementation %s) ", objc, O2S(objPtr))); } else { fprintf(stdout, - "%d: (%" TCL_Z_MODIFIER "u) invoking (using implementation %s) ", + "%" TCL_Z_MODIFIER "d: (%" TCL_Z_MODIFIER "u) invoking (using implementation %s) ", iPtr->numLevels, (size_t)(pc - codePtr->codeStart), O2S(objPtr)); } for (i = 0; i < objc; i++) { - if (i < opnd) { + if (i < (size_t)opnd) { fprintf(stdout, "<"); TclPrintObject(stdout, objv[i], 15); fprintf(stdout, ">"); @@ -3188,7 +3047,7 @@ TEBCresume( { int storeFlags; - int len; + size_t len; case INST_STORE_ARRAY4: opnd = TclGetUInt4AtPtr(pc+1); @@ -3790,7 +3649,7 @@ TEBCresume( arrayPtr = NULL; part1Ptr = part2Ptr = NULL; cleanup = 0; - TRACE(("%u %s => ", opnd, Tcl_GetString(incrPtr))); + TRACE(("%u %s => ", opnd, TclGetString(incrPtr))); doIncrVar: if (TclIsVarDirectModifyable2(varPtr, arrayPtr)) { @@ -4057,29 +3916,6 @@ TEBCresume( CACHE_STACK_INFO(); TRACE_ERROR(interp); goto gotError; - - /* - * This is really an unset operation these days. Do not issue. - */ - - case INST_DICT_DONE: - opnd = TclGetUInt4AtPtr(pc+1); - TRACE(("%u => OK\n", opnd)); - varPtr = LOCAL(opnd); - while (TclIsVarLink(varPtr)) { - varPtr = varPtr->value.linkPtr; - } - if (TclIsVarDirectUnsettable(varPtr) && !TclIsVarInHash(varPtr)) { - if (!TclIsVarUndefined(varPtr)) { - TclDecrRefCount(varPtr->value.objPtr); - } - varPtr->value.objPtr = NULL; - } else { - DECACHE_STACK_INFO(); - TclPtrUnsetVarIdx(interp, varPtr, NULL, NULL, NULL, 0, opnd); - CACHE_STACK_INFO(); - } - NEXT_INST_F(5, 0, 0); } break; @@ -4403,51 +4239,6 @@ TEBCresume( break; /* - * These two instructions are now redundant: the complete logic of the LOR - * and LAND is now handled by the expression compiler. - */ - - case INST_LOR: - case INST_LAND: { - /* - * Operands must be boolean or numeric. No int->double conversions are - * performed. - */ - - int i1, i2, iResult; - - value2Ptr = OBJ_AT_TOS; - valuePtr = OBJ_UNDER_TOS; - if (TclGetBooleanFromObj(NULL, valuePtr, &i1) != TCL_OK) { - TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr), - (valuePtr->typePtr? valuePtr->typePtr->name : "null"))); - DECACHE_STACK_INFO(); - IllegalExprOperandType(interp, pc, valuePtr); - CACHE_STACK_INFO(); - goto gotError; - } - - if (TclGetBooleanFromObj(NULL, value2Ptr, &i2) != TCL_OK) { - TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(value2Ptr), - (value2Ptr->typePtr? value2Ptr->typePtr->name : "null"))); - DECACHE_STACK_INFO(); - IllegalExprOperandType(interp, pc, value2Ptr); - CACHE_STACK_INFO(); - goto gotError; - } - - if (*pc == INST_LOR) { - iResult = (i1 || i2); - } else { - iResult = (i1 && i2); - } - objResultPtr = TCONST(iResult); - TRACE(("%.20s %.20s => %d\n", O2S(valuePtr),O2S(value2Ptr),iResult)); - NEXT_INST_F(1, 2, 1); - } - break; - - /* * ----------------------------------------------------------------- * Start of general introspector instructions. */ @@ -4478,7 +4269,7 @@ TEBCresume( } break; case INST_INFO_LEVEL_NUM: - TclNewIntObj(objResultPtr, iPtr->varFramePtr->level); + TclNewIntObj(objResultPtr, (int)iPtr->varFramePtr->level); TRACE_WITH_OBJ(("=> "), objResultPtr); NEXT_INST_F(1, 0, 1); break; @@ -4495,7 +4286,7 @@ TEBCresume( if (level <= 0) { level += framePtr->level; } - for (; (framePtr->level!=level) && (framePtr!=rootFramePtr) ; + for (; ((int)framePtr->level!=level) && (framePtr!=rootFramePtr) ; framePtr = framePtr->callerVarPtr) { /* Empty loop body */ } @@ -4563,7 +4354,7 @@ TEBCresume( Object *oPtr; CallFrame *framePtr; CallContext *contextPtr; - int skip, newDepth; + size_t skip, newDepth; case INST_TCLOO_SELF: framePtr = iPtr->varFramePtr; @@ -4615,7 +4406,7 @@ TEBCresume( } else { Class *classPtr = oPtr->classPtr; struct MInvoke *miPtr; - int i; + size_t i; const char *methodType; if (classPtr == NULL) { @@ -4638,11 +4429,11 @@ TEBCresume( if (traceInstructions) { strncpy(cmdNameBuf, TclGetString(objv[0]), 20); } else { - fprintf(stdout, "%d: (%" TCL_Z_MODIFIER "u) invoking ", + fprintf(stdout, "%" TCL_Z_MODIFIER "d: (%" TCL_Z_MODIFIER "u) invoking ", iPtr->numLevels, (size_t)(pc - codePtr->codeStart)); } - for (i = 0; i < opnd; i++) { + for (i = 0; i < (size_t)opnd; i++) { TclPrintObject(stdout, objv[i], 15); fprintf(stdout, " "); } @@ -4740,7 +4531,7 @@ TEBCresume( if (traceInstructions) { strncpy(cmdNameBuf, TclGetString(objv[0]), 20); } else { - fprintf(stdout, "%d: (%" TCL_Z_MODIFIER "u) invoking ", + fprintf(stdout, "%" TCL_Z_MODIFIER "d: (%" TCL_Z_MODIFIER "u) invoking ", iPtr->numLevels, (size_t)(pc - codePtr->codeStart)); } for (i = 0; i < opnd; i++) { @@ -4838,7 +4629,7 @@ TEBCresume( { int numIndices, nocase, match, cflags; - int length2, fromIdx, toIdx, index, s1len, s2len; + size_t slength, length2, fromIdx, toIdx, index, s1len, s2len; const char *s1, *s2; case INST_LIST: @@ -4859,7 +4650,7 @@ TEBCresume( goto gotError; } TclNewIntObj(objResultPtr, length); - TRACE_APPEND(("%d\n", length)); + TRACE_APPEND(("%" TCL_Z_MODIFIER "u\n", length)); NEXT_INST_F(1, 1, 1); case INST_LIST_INDEX: /* lindex with objc == 3 */ @@ -4940,7 +4731,7 @@ TEBCresume( index = TclIndexDecode(opnd, length-1); /* Compute value @ index */ - if (index >= 0 && index < length) { + if (index < length) { if (TclArithSeriesObjIndex(valuePtr, index, &objResultPtr) != TCL_OK) { CACHE_STACK_INFO(); TRACE_ERROR(interp); @@ -4969,7 +4760,7 @@ TEBCresume( pcAdjustment = 5; lindexFastPath: - if (index >= 0 && index < objc) { + if (index < (size_t)objc) { objResultPtr = objv[index]; } else { TclNewObj(objResultPtr); @@ -5134,13 +4925,13 @@ TEBCresume( NEXT_INST_F(9, 1, 1); } toIdx = TclIndexDecode(toIdx, objc - 1); - if (toIdx < 0) { + if (toIdx == TCL_INDEX_NONE) { goto emptyList; - } else if (toIdx >= objc) { + } else if (toIdx + 1 >= (size_t)objc + 1) { toIdx = objc - 1; } - assert ( toIdx >= 0 && toIdx < objc); + assert (toIdx < (size_t)objc); /* assert ( fromIdx != TCL_INDEX_NONE ); * @@ -5170,7 +4961,7 @@ TEBCresume( value2Ptr = OBJ_AT_TOS; valuePtr = OBJ_UNDER_TOS; - s1 = TclGetStringFromObj(valuePtr, &s1len); + s1 = Tcl_GetStringFromObj(valuePtr, &s1len); TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr))); if (TclListObjLengthM(interp, value2Ptr, &length) != TCL_OK) { TRACE_ERROR(interp); @@ -5178,7 +4969,7 @@ TEBCresume( } match = 0; if (length > 0) { - int i = 0; + size_t i = 0; Tcl_Obj *o; int isArithSeries = TclHasInternalRep(value2Ptr,&tclArithSeriesType); /* @@ -5192,7 +4983,7 @@ TEBCresume( Tcl_ListObjIndex(NULL, value2Ptr, i, &o); } if (o != NULL) { - s2 = TclGetStringFromObj(o, &s2len); + s2 = Tcl_GetStringFromObj(o, &s2len); } else { s2 = ""; s2len = 0; @@ -5246,7 +5037,8 @@ TEBCresume( case INST_LREPLACE4: { - int numToDelete, numNewElems, end_indicator; + Tcl_Size numToDelete, numNewElems; + int end_indicator; int haveSecondIndex, flags; Tcl_Obj *fromIdxObj, *toIdxObj; opnd = TclGetInt4AtPtr(pc + 1); @@ -5292,11 +5084,13 @@ TEBCresume( TRACE_ERROR(interp); goto gotError; } - if (toIdx > length) { - toIdx = length; - } - if (toIdx >= fromIdx) { - numToDelete = toIdx - fromIdx + 1; + if (toIdx != TCL_INDEX_NONE) { + if (toIdx > length) { + toIdx = length; + } + if (toIdx >= fromIdx) { + numToDelete = toIdx - fromIdx + 1; + } } } @@ -5401,24 +5195,24 @@ TEBCresume( case INST_STR_LEN: valuePtr = OBJ_AT_TOS; - length = TclGetCharLength(valuePtr); - TclNewIntObj(objResultPtr, length); - TRACE(("\"%.20s\" => %d\n", O2S(valuePtr), length)); + slength = Tcl_GetCharLength(valuePtr); + TclNewIntObj(objResultPtr, slength); + TRACE(("\"%.20s\" => %" TCL_Z_MODIFIER "u\n", O2S(valuePtr), slength)); NEXT_INST_F(1, 1, 1); case INST_STR_UPPER: valuePtr = OBJ_AT_TOS; TRACE(("\"%.20s\" => ", O2S(valuePtr))); if (Tcl_IsShared(valuePtr)) { - s1 = TclGetStringFromObj(valuePtr, &length); - TclNewStringObj(objResultPtr, s1, length); - length = Tcl_UtfToUpper(TclGetString(objResultPtr)); - Tcl_SetObjLength(objResultPtr, length); + s1 = Tcl_GetStringFromObj(valuePtr, &slength); + TclNewStringObj(objResultPtr, s1, slength); + slength = Tcl_UtfToUpper(TclGetString(objResultPtr)); + Tcl_SetObjLength(objResultPtr, slength); TRACE_APPEND(("\"%.20s\"\n", O2S(objResultPtr))); NEXT_INST_F(1, 1, 1); } else { - length = Tcl_UtfToUpper(TclGetString(valuePtr)); - Tcl_SetObjLength(valuePtr, length); + slength = Tcl_UtfToUpper(TclGetString(valuePtr)); + Tcl_SetObjLength(valuePtr, slength); TclFreeInternalRep(valuePtr); TRACE_APPEND(("\"%.20s\"\n", O2S(valuePtr))); NEXT_INST_F(1, 0, 0); @@ -5427,15 +5221,15 @@ TEBCresume( valuePtr = OBJ_AT_TOS; TRACE(("\"%.20s\" => ", O2S(valuePtr))); if (Tcl_IsShared(valuePtr)) { - s1 = TclGetStringFromObj(valuePtr, &length); - TclNewStringObj(objResultPtr, s1, length); - length = Tcl_UtfToLower(TclGetString(objResultPtr)); - Tcl_SetObjLength(objResultPtr, length); + s1 = Tcl_GetStringFromObj(valuePtr, &slength); + TclNewStringObj(objResultPtr, s1, slength); + slength = Tcl_UtfToLower(TclGetString(objResultPtr)); + Tcl_SetObjLength(objResultPtr, slength); TRACE_APPEND(("\"%.20s\"\n", O2S(objResultPtr))); NEXT_INST_F(1, 1, 1); } else { - length = Tcl_UtfToLower(TclGetString(valuePtr)); - Tcl_SetObjLength(valuePtr, length); + slength = Tcl_UtfToLower(TclGetString(valuePtr)); + Tcl_SetObjLength(valuePtr, slength); TclFreeInternalRep(valuePtr); TRACE_APPEND(("\"%.20s\"\n", O2S(valuePtr))); NEXT_INST_F(1, 0, 0); @@ -5444,15 +5238,15 @@ TEBCresume( valuePtr = OBJ_AT_TOS; TRACE(("\"%.20s\" => ", O2S(valuePtr))); if (Tcl_IsShared(valuePtr)) { - s1 = TclGetStringFromObj(valuePtr, &length); - TclNewStringObj(objResultPtr, s1, length); - length = Tcl_UtfToTitle(TclGetString(objResultPtr)); - Tcl_SetObjLength(objResultPtr, length); + s1 = Tcl_GetStringFromObj(valuePtr, &slength); + TclNewStringObj(objResultPtr, s1, slength); + slength = Tcl_UtfToTitle(TclGetString(objResultPtr)); + Tcl_SetObjLength(objResultPtr, slength); TRACE_APPEND(("\"%.20s\"\n", O2S(objResultPtr))); NEXT_INST_F(1, 1, 1); } else { - length = Tcl_UtfToTitle(TclGetString(valuePtr)); - Tcl_SetObjLength(valuePtr, length); + slength = Tcl_UtfToTitle(TclGetString(valuePtr)); + Tcl_SetObjLength(valuePtr, slength); TclFreeInternalRep(valuePtr); TRACE_APPEND(("\"%.20s\"\n", O2S(valuePtr))); NEXT_INST_F(1, 0, 0); @@ -5467,26 +5261,26 @@ TEBCresume( * Get char length to calulate what 'end' means. */ - length = TclGetCharLength(valuePtr); + slength = Tcl_GetCharLength(valuePtr); DECACHE_STACK_INFO(); - if (TclGetIntForIndexM(interp, value2Ptr, length-1, &index)!=TCL_OK) { + if (TclGetIntForIndexM(interp, value2Ptr, slength-1, &index)!=TCL_OK) { CACHE_STACK_INFO(); TRACE_ERROR(interp); goto gotError; } CACHE_STACK_INFO(); - if ((index < 0) || (index >= length)) { + if (index >= slength) { TclNewObj(objResultPtr); } else if (TclIsPureByteArray(valuePtr)) { objResultPtr = Tcl_NewByteArrayObj( - TclGetByteArrayFromObj(valuePtr, NULL)+index, 1); - } else if (valuePtr->bytes && length == valuePtr->length) { + Tcl_GetByteArrayFromObj(valuePtr, (size_t *)NULL)+index, 1); + } else if (valuePtr->bytes && slength == valuePtr->length) { objResultPtr = Tcl_NewStringObj((const char *) valuePtr->bytes+index, 1); } else { char buf[4] = ""; - int ch = TclGetUniChar(valuePtr, index); + int ch = Tcl_GetUniChar(valuePtr, index); /* * This could be: Tcl_NewUnicodeObj((const Tcl_UniChar *)&ch, 1) @@ -5496,11 +5290,13 @@ TEBCresume( if (ch == -1) { TclNewObj(objResultPtr); } else { - length = Tcl_UniCharToUtf(ch, buf); - if ((ch >= 0xD800) && (length < 3)) { - length += Tcl_UniCharToUtf(-1, buf + length); + slength = Tcl_UniCharToUtf(ch, buf); +#if TCL_UTF_MAX < 4 + if ((ch >= 0xD800) && (slength < 3)) { + slength += Tcl_UniCharToUtf(-1, buf + slength); } - objResultPtr = Tcl_NewStringObj(buf, length); +#endif + objResultPtr = Tcl_NewStringObj(buf, slength); } } @@ -5510,16 +5306,16 @@ TEBCresume( case INST_STR_RANGE: TRACE(("\"%.20s\" %.20s %.20s =>", O2S(OBJ_AT_DEPTH(2)), O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS))); - length = TclGetCharLength(OBJ_AT_DEPTH(2)) - 1; + slength = Tcl_GetCharLength(OBJ_AT_DEPTH(2)) - 1; DECACHE_STACK_INFO(); - if (TclGetIntForIndexM(interp, OBJ_UNDER_TOS, length, + if (TclGetIntForIndexM(interp, OBJ_UNDER_TOS, slength, &fromIdx) != TCL_OK) { CACHE_STACK_INFO(); TRACE_ERROR(interp); goto gotError; } - if (TclGetIntForIndexM(interp, OBJ_AT_TOS, length, + if (TclGetIntForIndexM(interp, OBJ_AT_TOS, slength, &toIdx) != TCL_OK) { CACHE_STACK_INFO(); TRACE_ERROR(interp); @@ -5527,10 +5323,10 @@ TEBCresume( } CACHE_STACK_INFO(); - if (toIdx < 0) { + if (toIdx == TCL_INDEX_NONE) { TclNewObj(objResultPtr); } else { - objResultPtr = TclGetRange(OBJ_AT_DEPTH(2), fromIdx, toIdx); + objResultPtr = Tcl_GetRange(OBJ_AT_DEPTH(2), fromIdx, toIdx); } TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr))); NEXT_INST_V(1, 3, 1); @@ -5539,59 +5335,42 @@ TEBCresume( valuePtr = OBJ_AT_TOS; fromIdx = TclGetInt4AtPtr(pc+1); toIdx = TclGetInt4AtPtr(pc+5); - length = TclGetCharLength(valuePtr); - TRACE(("\"%.20s\" %d %d => ", O2S(valuePtr), fromIdx, toIdx)); + slength = Tcl_GetCharLength(valuePtr); + TRACE(("\"%.20s\" %d %d => ", O2S(valuePtr), (int)(fromIdx), (int)(toIdx))); /* Every range of an empty value is an empty value */ - if (length == 0) { + if (slength == 0) { TRACE_APPEND(("\n")); NEXT_INST_F(9, 0, 0); } /* Decode index operands. */ - /* - assert ( toIdx != TCL_INDEX_NONE ); - * - * Extra safety for legacy bytecodes: - */ + toIdx = TclIndexDecode(toIdx, slength - 1); + fromIdx = TclIndexDecode(fromIdx, slength - 1); if (toIdx == TCL_INDEX_NONE) { TclNewObj(objResultPtr); } else { - toIdx = TclIndexDecode(toIdx, length - 1); - /* - assert ( fromIdx != TCL_INDEX_NONE ); - * - * Extra safety for legacy bytecodes: - */ - if (fromIdx == TCL_INDEX_NONE) { - fromIdx = TCL_INDEX_START; - } - fromIdx = TclIndexDecode(fromIdx, length - 1); - if (toIdx < 0) { - TclNewObj(objResultPtr); - } else { - objResultPtr = TclGetRange(valuePtr, fromIdx, toIdx); - } + objResultPtr = Tcl_GetRange(valuePtr, fromIdx, toIdx); } TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); NEXT_INST_F(9, 1, 1); { Tcl_UniChar *ustring1, *ustring2, *ustring3, *end, *p; - int length3, endIdx; + size_t length3; Tcl_Obj *value3Ptr; case INST_STR_REPLACE: value3Ptr = POP_OBJECT(); valuePtr = OBJ_AT_DEPTH(2); - endIdx = TclGetCharLength(valuePtr) - 1; + slength = Tcl_GetCharLength(valuePtr) - 1; TRACE(("\"%.20s\" %s %s \"%.20s\" => ", O2S(valuePtr), O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), O2S(value3Ptr))); DECACHE_STACK_INFO(); - if (TclGetIntForIndexM(interp, OBJ_UNDER_TOS, endIdx, + if (TclGetIntForIndexM(interp, OBJ_UNDER_TOS, slength, &fromIdx) != TCL_OK - || TclGetIntForIndexM(interp, OBJ_AT_TOS, endIdx, + || TclGetIntForIndexM(interp, OBJ_AT_TOS, slength, &toIdx) != TCL_OK) { CACHE_STACK_INFO(); TclDecrRefCount(value3Ptr); @@ -5604,23 +5383,23 @@ TEBCresume( TclDecrRefCount(OBJ_AT_TOS); (void) POP_OBJECT(); - if ((toIdx < 0) || - (fromIdx > endIdx) || - (toIdx < fromIdx)) { + if ((toIdx == TCL_INDEX_NONE) || + (fromIdx + 1 > slength + 1) || + (toIdx + 1 < fromIdx + 1)) { TRACE_APPEND(("\"%.30s\"\n", O2S(valuePtr))); TclDecrRefCount(value3Ptr); NEXT_INST_F(1, 0, 0); } - if (fromIdx < 0) { - fromIdx = 0; + if (fromIdx == TCL_INDEX_NONE) { + fromIdx = TCL_INDEX_START; } - if (toIdx > endIdx) { - toIdx = endIdx; + if (toIdx + 1 > slength + 1) { + toIdx = slength; } - if (fromIdx == 0 && toIdx == endIdx) { + if ((fromIdx == TCL_INDEX_START) && (toIdx == slength)) { TclDecrRefCount(OBJ_AT_TOS); OBJ_AT_TOS = value3Ptr; TRACE_APPEND(("\"%.30s\"\n", O2S(value3Ptr))); @@ -5652,43 +5431,43 @@ TEBCresume( objResultPtr = value3Ptr; goto doneStringMap; } - ustring1 = TclGetUnicodeFromObj_(valuePtr, &length); - if (length == 0) { + ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &slength); + if (slength == 0) { objResultPtr = valuePtr; goto doneStringMap; } - ustring2 = TclGetUnicodeFromObj_(value2Ptr, &length2); - if (length2 > length || length2 == 0) { + ustring2 = Tcl_GetUnicodeFromObj(value2Ptr, &length2); + if (length2 > slength || length2 == 0) { objResultPtr = valuePtr; goto doneStringMap; - } else if (length2 == length) { - if (memcmp(ustring1, ustring2, sizeof(Tcl_UniChar) * length)) { + } else if (length2 == slength) { + if (memcmp(ustring1, ustring2, sizeof(Tcl_UniChar) * slength)) { objResultPtr = valuePtr; } else { objResultPtr = value3Ptr; } goto doneStringMap; } - ustring3 = TclGetUnicodeFromObj_(value3Ptr, &length3); + ustring3 = Tcl_GetUnicodeFromObj(value3Ptr, &length3); - objResultPtr = TclNewUnicodeObj(ustring1, 0); + objResultPtr = Tcl_NewUnicodeObj(ustring1, 0); p = ustring1; - end = ustring1 + length; + end = ustring1 + slength; for (; ustring1 < end; ustring1++) { if ((*ustring1 == *ustring2) && /* Fix bug [69218ab7b]: restrict max compare length. */ - (end-ustring1 >= length2) && (length2==1 || + ((size_t)(end-ustring1) >= length2) && (length2==1 || memcmp(ustring1, ustring2, sizeof(Tcl_UniChar) * length2) == 0)) { if (p != ustring1) { - TclAppendUnicodeToObj(objResultPtr, p, ustring1-p); + Tcl_AppendUnicodeToObj(objResultPtr, p, ustring1-p); p = ustring1 + length2; } else { p += length2; } ustring1 = p - 1; - TclAppendUnicodeToObj(objResultPtr, ustring3, length3); + Tcl_AppendUnicodeToObj(objResultPtr, ustring3, length3); } } if (p != ustring1) { @@ -5696,7 +5475,7 @@ TEBCresume( * Put the rest of the unmapped chars onto result. */ - TclAppendUnicodeToObj(objResultPtr, p, ustring1 - p); + Tcl_AppendUnicodeToObj(objResultPtr, p, ustring1 - p); } doneStringMap: TRACE_WITH_OBJ(("%.20s %.20s %.20s => ", @@ -5722,11 +5501,11 @@ TEBCresume( valuePtr = OBJ_AT_TOS; TRACE(("%s \"%.30s\" => ", tclStringClassTable[opnd].name, O2S(valuePtr))); - ustring1 = TclGetUnicodeFromObj_(valuePtr, &length); + ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &slength); match = 1; - if (length > 0) { + if (slength > 0) { int ch; - end = ustring1 + length; + end = ustring1 + slength; for (p=ustring1 ; p<end ; ) { p += TclUniCharToUCS4(p, &ch); if (!tclStringClassTable[opnd].comparator(ch)) { @@ -5749,20 +5528,21 @@ TEBCresume( * both. */ - if (TclHasInternalRep(valuePtr, &tclUniCharStringType) - || TclHasInternalRep(value2Ptr, &tclUniCharStringType)) { + if (TclHasInternalRep(valuePtr, &tclStringType) + || TclHasInternalRep(value2Ptr, &tclStringType)) { Tcl_UniChar *ustring1, *ustring2; - ustring1 = TclGetUnicodeFromObj_(valuePtr, &length); - ustring2 = TclGetUnicodeFromObj_(value2Ptr, &length2); - match = TclUniCharMatch(ustring1, length, ustring2, length2, + ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &slength); + ustring2 = Tcl_GetUnicodeFromObj(value2Ptr, &length2); + match = TclUniCharMatch(ustring1, slength, ustring2, length2, nocase); - } else if (TclIsPureByteArray(valuePtr) && !nocase) { + } else if (TclIsPureByteArray(valuePtr) && TclIsPureByteArray(value2Ptr) && !nocase) { unsigned char *bytes1, *bytes2; + size_t wlen1 = 0, wlen2 = 0; - bytes1 = Tcl_GetByteArrayFromObj(valuePtr, &length); - bytes2 = Tcl_GetByteArrayFromObj(value2Ptr, &length2); - match = TclByteArrayMatch(bytes1, length, bytes2, length2, 0); + bytes1 = Tcl_GetByteArrayFromObj(valuePtr, &wlen1); + bytes2 = Tcl_GetByteArrayFromObj(value2Ptr, &wlen2); + match = TclByteArrayMatch(bytes1, wlen1, bytes2, wlen2, 0); } else { match = Tcl_StringCaseMatch(TclGetString(valuePtr), TclGetString(value2Ptr), nocase); @@ -5783,30 +5563,30 @@ TEBCresume( { const char *string1, *string2; - int trim1, trim2; + size_t trim1, trim2; case INST_STR_TRIM_LEFT: valuePtr = OBJ_UNDER_TOS; /* String */ value2Ptr = OBJ_AT_TOS; /* TrimSet */ - string2 = TclGetStringFromObj(value2Ptr, &length2); - string1 = TclGetStringFromObj(valuePtr, &length); - trim1 = TclTrimLeft(string1, length, string2, length2); + string2 = Tcl_GetStringFromObj(value2Ptr, &length2); + string1 = Tcl_GetStringFromObj(valuePtr, &slength); + trim1 = TclTrimLeft(string1, slength, string2, length2); trim2 = 0; goto createTrimmedString; case INST_STR_TRIM_RIGHT: valuePtr = OBJ_UNDER_TOS; /* String */ value2Ptr = OBJ_AT_TOS; /* TrimSet */ - string2 = TclGetStringFromObj(value2Ptr, &length2); - string1 = TclGetStringFromObj(valuePtr, &length); - trim2 = TclTrimRight(string1, length, string2, length2); + string2 = Tcl_GetStringFromObj(value2Ptr, &length2); + string1 = Tcl_GetStringFromObj(valuePtr, &slength); + trim2 = TclTrimRight(string1, slength, string2, length2); trim1 = 0; goto createTrimmedString; case INST_STR_TRIM: valuePtr = OBJ_UNDER_TOS; /* String */ value2Ptr = OBJ_AT_TOS; /* TrimSet */ - string2 = TclGetStringFromObj(value2Ptr, &length2); - string1 = TclGetStringFromObj(valuePtr, &length); - trim1 = TclTrim(string1, length, string2, length2, &trim2); + string2 = Tcl_GetStringFromObj(value2Ptr, &length2); + string1 = Tcl_GetStringFromObj(valuePtr, &slength); + trim1 = TclTrim(string1, slength, string2, length2, &trim2); createTrimmedString: /* * Careful here; trim set often contains non-ASCII characters so we @@ -5829,7 +5609,7 @@ TEBCresume( #endif NEXT_INST_F(1, 1, 0); } else { - objResultPtr = Tcl_NewStringObj(string1+trim1, length-trim1-trim2); + objResultPtr = Tcl_NewStringObj(string1+trim1, slength-trim1-trim2); #ifdef TCL_COMPILE_DEBUG if (traceInstructions) { TclPrintObject(stdout, objResultPtr, 30); @@ -6591,177 +6371,11 @@ TEBCresume( { ForeachInfo *infoPtr; - Var *iterVarPtr, *listVarPtr; - Tcl_Obj *oldValuePtr, *listPtr, **elements; - ForeachVarList *varListPtr; - int numLists, listTmpIndex, listLen, numVars; - size_t iterNum; - int varIndex, valIndex, continueLoop, j, iterTmpIndex; - long i; - - case INST_FOREACH_START4: /* DEPRECATED */ - /* - * Initialize the temporary local var that holds the count of the - * number of iterations of the loop body to -1. - */ - - opnd = TclGetUInt4AtPtr(pc+1); - infoPtr = (ForeachInfo *)codePtr->auxDataArrayPtr[opnd].clientData; - iterTmpIndex = infoPtr->loopCtTemp; - iterVarPtr = LOCAL(iterTmpIndex); - oldValuePtr = iterVarPtr->value.objPtr; - - if (oldValuePtr == NULL) { - TclNewIntObj(iterVarPtr->value.objPtr, -1); - Tcl_IncrRefCount(iterVarPtr->value.objPtr); - } else { - TclSetIntObj(oldValuePtr, -1); - } - TRACE(("%u => loop iter count temp %d\n", opnd, iterTmpIndex)); - -#ifndef TCL_COMPILE_DEBUG - /* - * Remark that the compiler ALWAYS sets INST_FOREACH_STEP4 immediately - * after INST_FOREACH_START4 - let us just fall through instead of - * jumping back to the top. - */ - - pc += 5; - TCL_DTRACE_INST_NEXT(); -#else - NEXT_INST_F(5, 0, 0); -#endif - - case INST_FOREACH_STEP4: /* DEPRECATED */ - /* - * "Step" a foreach loop (i.e., begin its next iteration) by assigning - * the next value list element to each loop var. - */ - - opnd = TclGetUInt4AtPtr(pc+1); - TRACE(("%u => ", opnd)); - infoPtr = (ForeachInfo *)codePtr->auxDataArrayPtr[opnd].clientData; - numLists = infoPtr->numLists; - - /* - * Increment the temp holding the loop iteration number. - */ - - iterVarPtr = LOCAL(infoPtr->loopCtTemp); - valuePtr = iterVarPtr->value.objPtr; - iterNum = (size_t)valuePtr->internalRep.wideValue + 1; - TclSetIntObj(valuePtr, iterNum); - - /* - * Check whether all value lists are exhausted and we should stop the - * loop. - */ - - continueLoop = 0; - listTmpIndex = infoPtr->firstValueTemp; - for (i = 0; i < numLists; i++) { - varListPtr = infoPtr->varLists[i]; - numVars = varListPtr->numVars; - - listVarPtr = LOCAL(listTmpIndex); - listPtr = listVarPtr->value.objPtr; - if (TclListObjLengthM(interp, listPtr, &listLen) != TCL_OK) { - TRACE_APPEND(("ERROR converting list %ld, \"%.30s\": %s\n", - i, O2S(listPtr), O2S(Tcl_GetObjResult(interp)))); - goto gotError; - } - if ((size_t)listLen > iterNum * numVars) { - continueLoop = 1; - } - listTmpIndex++; - } - - /* - * If some var in some var list still has a remaining list element - * iterate one more time. Assign to var the next element from its - * value list. We already checked above that each list temp holds a - * valid list object (by calling Tcl_ListObjLength), but cannot rely - * on that check remaining valid: one list could have been shimmered - * as a side effect of setting a traced variable. - */ - - if (continueLoop) { - listTmpIndex = infoPtr->firstValueTemp; - for (i = 0; i < numLists; i++) { - varListPtr = infoPtr->varLists[i]; - numVars = varListPtr->numVars; - - listVarPtr = LOCAL(listTmpIndex); - listPtr = TclListObjCopy(NULL, listVarPtr->value.objPtr); - TclListObjGetElementsM(interp, listPtr, &listLen, &elements); - - valIndex = (iterNum * numVars); - for (j = 0; j < numVars; j++) { - if (valIndex >= listLen) { - TclNewObj(valuePtr); - } else { - valuePtr = elements[valIndex]; - } - - varIndex = varListPtr->varIndexes[j]; - varPtr = LOCAL(varIndex); - while (TclIsVarLink(varPtr)) { - varPtr = varPtr->value.linkPtr; - } - if (TclIsVarDirectWritable(varPtr)) { - value2Ptr = varPtr->value.objPtr; - if (valuePtr != value2Ptr) { - if (value2Ptr != NULL) { - TclDecrRefCount(value2Ptr); - } - varPtr->value.objPtr = valuePtr; - Tcl_IncrRefCount(valuePtr); - } - } else { - DECACHE_STACK_INFO(); - if (TclPtrSetVarIdx(interp, varPtr, NULL, NULL, NULL, - valuePtr, TCL_LEAVE_ERR_MSG, varIndex)==NULL){ - CACHE_STACK_INFO(); - TRACE_APPEND(( - "ERROR init. index temp %d: %s\n", - varIndex, O2S(Tcl_GetObjResult(interp)))); - TclDecrRefCount(listPtr); - goto gotError; - } - CACHE_STACK_INFO(); - } - valIndex++; - } - TclDecrRefCount(listPtr); - listTmpIndex++; - } - } - TRACE_APPEND(("%d lists, iter %" TCL_Z_MODIFIER "u, %s loop\n", - numLists, iterNum, (continueLoop? "continue" : "exit"))); - - /* - * Run-time peep-hole optimisation: the compiler ALWAYS follows - * INST_FOREACH_STEP4 with an INST_JUMP_FALSE. We just skip that - * instruction and jump direct from here. - */ - - pc += 5; - if (*pc == INST_JUMP_FALSE1) { - NEXT_INST_F((continueLoop? 2 : TclGetInt1AtPtr(pc+1)), 0, 0); - } else { - NEXT_INST_F((continueLoop? 5 : TclGetInt4AtPtr(pc+1)), 0, 0); - } - - } - { - ForeachInfo *infoPtr; Tcl_Obj *listPtr, **elements; ForeachVarList *varListPtr; - int numLists, listLen, numVars; - int listTmpDepth; + size_t numLists, listLen, numVars, listTmpDepth; size_t iterNum, iterMax, iterTmp; - int varIndex, valIndex, j; - long i; + size_t varIndex, valIndex, i, j; case INST_FOREACH_START: /* @@ -6785,7 +6399,7 @@ TEBCresume( numVars = varListPtr->numVars; listPtr = OBJ_AT_DEPTH(listTmpDepth); if (TclListObjLengthM(interp, listPtr, &listLen) != TCL_OK) { - TRACE_APPEND(("ERROR converting list %ld, \"%s\": %s", + TRACE_APPEND(("ERROR converting list %" TCL_Z_MODIFIER "d, \"%s\": %s", i, O2S(listPtr), O2S(Tcl_GetObjResult(interp)))); goto gotError; } @@ -6894,7 +6508,7 @@ TEBCresume( if (TclPtrSetVarIdx(interp, varPtr, NULL, NULL, NULL, valuePtr, TCL_LEAVE_ERR_MSG, varIndex)==NULL){ CACHE_STACK_INFO(); - TRACE_APPEND(("ERROR init. index temp %d: %.30s", + TRACE_APPEND(("ERROR init. index temp %" TCL_Z_MODIFIER "u: %.30s", varIndex, O2S(Tcl_GetObjResult(interp)))); goto gotError; } @@ -6941,7 +6555,7 @@ TEBCresume( tmpPtr = OBJ_AT_DEPTH(1); infoPtr = (ForeachInfo *)tmpPtr->internalRep.twoPtrValue.ptr1; numLists = infoPtr->numLists; - TRACE_APPEND(("=> appending to list at depth %d\n", 3 + numLists)); + TRACE_APPEND(("=> appending to list at depth %" TCL_Z_MODIFIER "u\n", 3 + numLists)); objPtr = OBJ_AT_DEPTH(3 + numLists); Tcl_ListObjAppendElement(NULL, objPtr, OBJ_AT_TOS); @@ -7024,22 +6638,24 @@ TEBCresume( { int opnd2, allocateDict, done, allocdict; - int i; + size_t i; Tcl_Obj *dictPtr, *statePtr, *keyPtr, *listPtr, *varNamePtr, *keysPtr; Tcl_Obj *emptyPtr, **keyPtrPtr; Tcl_DictSearch *searchPtr; DictUpdateInfo *duiPtr; - case INST_DICT_VERIFY: + case INST_DICT_VERIFY: { + size_t size; dictPtr = OBJ_AT_TOS; TRACE(("\"%.30s\" => ", O2S(dictPtr))); - if (Tcl_DictObjSize(interp, dictPtr, &done) != TCL_OK) { + if (Tcl_DictObjSize(interp, dictPtr, &size) != TCL_OK) { TRACE_APPEND(("ERROR verifying dictionary nature of \"%.30s\": %s\n", O2S(dictPtr), O2S(Tcl_GetObjResult(interp)))); goto gotError; } TRACE_APPEND(("OK\n")); NEXT_INST_F(1, 1, 0); + } break; case INST_DICT_EXISTS: { @@ -7387,7 +7003,7 @@ TEBCresume( opnd = TclGetUInt4AtPtr(pc+1); TRACE(("%u => ", opnd)); dictPtr = POP_OBJECT(); - searchPtr = (Tcl_DictSearch *)ckalloc(sizeof(Tcl_DictSearch)); + searchPtr = (Tcl_DictSearch *)Tcl_Alloc(sizeof(Tcl_DictSearch)); if (Tcl_DictObjFirst(interp, dictPtr, searchPtr, &keyPtr, &valuePtr, &done) != TCL_OK) { @@ -7398,7 +7014,7 @@ TEBCresume( */ Tcl_DecrRefCount(dictPtr); - ckfree(searchPtr); + Tcl_Free(searchPtr); TRACE_ERROR(interp); goto gotError; } @@ -7767,7 +7383,7 @@ TEBCresume( if (result == TCL_BREAK) { result = TCL_OK; pc = (codePtr->codeStart + rangePtr->breakOffset); - TRACE_APPEND(("%s, range at %d, new pc %d\n", + TRACE_APPEND(("%s, range at %" TCL_Z_MODIFIER "u, new pc %" TCL_Z_MODIFIER "u\n", StringForResultCode(result), rangePtr->codeOffset, rangePtr->breakOffset)); NEXT_INST_F(0, 0, 0); @@ -7779,7 +7395,7 @@ TEBCresume( } result = TCL_OK; pc = (codePtr->codeStart + rangePtr->continueOffset); - TRACE_APPEND(("%s, range at %d, new pc %d\n", + TRACE_APPEND(("%s, range at %" TCL_Z_MODIFIER "u, new pc %" TCL_Z_MODIFIER "u\n", StringForResultCode(result), rangePtr->codeOffset, rangePtr->continueOffset)); NEXT_INST_F(0, 0, 0); @@ -7852,11 +7468,12 @@ TEBCresume( } if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) { const unsigned char *pcBeg; + size_t xxx1length; - bytes = GetSrcInfoForPc(pc, codePtr, &length, &pcBeg, NULL); + bytes = GetSrcInfoForPc(pc, codePtr, &xxx1length, &pcBeg, NULL); DECACHE_STACK_INFO(); TclLogCommandInfo(interp, codePtr->source, bytes, - bytes ? length : 0, pcBeg, tosPtr); + bytes ? xxx1length : 0, pcBeg, tosPtr); CACHE_STACK_INFO(); } iPtr->flags &= ~ERR_ALREADY_LOGGED; @@ -7950,7 +7567,7 @@ TEBCresume( } #ifdef TCL_COMPILE_DEBUG if (traceInstructions) { - fprintf(stdout, " ... found catch at %d, catchTop=%" TCL_Z_MODIFIER "u, " + fprintf(stdout, " ... found catch at %" TCL_Z_MODIFIER "u, catchTop=%" TCL_Z_MODIFIER "u, " "unwound to %" TCL_Z_MODIFIER "u, new pc %" TCL_Z_MODIFIER "u\n", rangePtr->codeOffset, (size_t)(catchTop - initCatchTop - 1), PTR2UINT(*catchTop), (size_t)rangePtr->catchOffset); @@ -8018,8 +7635,9 @@ TEBCresume( instStartCmdFailed: { const char *bytes; + size_t xxx1length; - length = 0; + xxx1length = 0; if (TclInterpReady(interp) == TCL_ERROR) { goto gotError; @@ -8036,11 +7654,11 @@ TEBCresume( */ codePtr->flags |= TCL_BYTECODE_RECOMPILE; - bytes = GetSrcInfoForPc(pc, codePtr, &length, NULL, NULL); + bytes = GetSrcInfoForPc(pc, codePtr, &xxx1length, NULL, NULL); opnd = TclGetUInt4AtPtr(pc+1); pc += (opnd-1); assert(bytes); - PUSH_OBJECT(Tcl_NewStringObj(bytes, length)); + PUSH_OBJECT(Tcl_NewStringObj(bytes, xxx1length)); goto instEvalStk; } } @@ -9211,13 +8829,13 @@ PrintByteCodeInfo( Proc *procPtr = codePtr->procPtr; Interp *iPtr = (Interp *) *codePtr->interpHandle; - fprintf(stdout, "\nExecuting ByteCode 0x%p, refCt %" TCL_Z_MODIFIER "u, epoch %u, interp 0x%p (epoch %u)\n", - codePtr, (size_t)codePtr->refCount, codePtr->compileEpoch, iPtr, + fprintf(stdout, "\nExecuting ByteCode 0x%p, refCt %" TCL_Z_MODIFIER "u, epoch %" TCL_Z_MODIFIER "u, interp 0x%p (epoch %" TCL_Z_MODIFIER "u)\n", + codePtr, codePtr->refCount, codePtr->compileEpoch, iPtr, iPtr->compileEpoch); fprintf(stdout, " Source: "); TclPrintSource(stdout, codePtr->source, 60); - fprintf(stdout, "\n Cmds %d, src %d, inst %u, litObjs %u, aux %d, stkDepth %u, code/src %.2f\n", + fprintf(stdout, "\n Cmds %" TCL_Z_MODIFIER "u, src %" TCL_Z_MODIFIER "u, inst %" TCL_Z_MODIFIER "u, litObjs %" TCL_Z_MODIFIER "u, aux %" TCL_Z_MODIFIER "u, stkDepth %" TCL_Z_MODIFIER "u, code/src %.2f\n", codePtr->numCommands, codePtr->numSrcBytes, codePtr->numCodeBytes, codePtr->numLitObjects, codePtr->numAuxDataItems, codePtr->maxStackDepth, @@ -9228,8 +8846,9 @@ PrintByteCodeInfo( 0.0); #ifdef TCL_COMPILE_STATS - fprintf(stdout, " Code %lu = header %" TCL_Z_MODIFIER "u+inst %d+litObj %" TCL_Z_MODIFIER "u+exc %" TCL_Z_MODIFIER "u+aux %" TCL_Z_MODIFIER "u+cmdMap %d\n", - (unsigned long) codePtr->structureSize, + fprintf(stdout, " Code %" TCL_Z_MODIFIER "u = header %" TCL_Z_MODIFIER "u+inst %" TCL_Z_MODIFIER + "u+litObj %" TCL_Z_MODIFIER "u+exc %" TCL_Z_MODIFIER "u+aux %" TCL_Z_MODIFIER "u+cmdMap %" TCL_Z_MODIFIER "u\n", + codePtr->structureSize, offsetof(ByteCode, localCachePtr), codePtr->numCodeBytes, codePtr->numLitObjects * sizeof(Tcl_Obj *), @@ -9239,7 +8858,7 @@ PrintByteCodeInfo( #endif /* TCL_COMPILE_STATS */ if (procPtr != NULL) { fprintf(stdout, - " Proc 0x%p, refCt %d, args %d, compiled locals %d\n", + " Proc 0x%p, refCt %" TCL_Z_MODIFIER "u, args %" TCL_Z_MODIFIER "u, compiled locals %" TCL_Z_MODIFIER "u\n", procPtr, procPtr->refCount, procPtr->numArgs, procPtr->numCompiledLocals); } @@ -9291,14 +8910,14 @@ ValidatePcAndStackTop( pc); Tcl_Panic("TclNRExecuteByteCode execution failure: bad pc"); } - if ((unsigned) opCode > LAST_INST_OPCODE) { - fprintf(stderr, "\nBad opcode %d at pc %" TCL_Z_MODIFIER "u in TclNRExecuteByteCode\n", - (unsigned) opCode, relativePc); + if (opCode >= LAST_INST_OPCODE) { + fprintf(stderr, "\nBad opcode %u at pc %" TCL_Z_MODIFIER "u in TclNRExecuteByteCode\n", + opCode, relativePc); Tcl_Panic("TclNRExecuteByteCode execution failure: bad opcode"); } if (checkStack && (stackTop > stackUpperBound)) { - int numChars; + size_t numChars; const char *cmd = GetSrcInfoForPc(pc, codePtr, &numChars, NULL, NULL); fprintf(stderr, "\nBad stack top %" TCL_Z_MODIFIER "u at pc %" TCL_Z_MODIFIER "u in TclNRExecuteByteCode (min 0, max %" TCL_Z_MODIFIER "u)", @@ -9354,20 +8973,11 @@ IllegalExprOperandType( if (opcode == INST_EXPON) { op = "**"; } else if (opcode <= INST_LNOT) { - op = operatorStrings[opcode - INST_LOR]; + op = operatorStrings[opcode - INST_BITOR]; } if (GetNumberFromObj(NULL, opndPtr, &ptr, &type) != TCL_OK) { - int numBytes; - const char *bytes = TclGetStringFromObj(opndPtr, &numBytes); - - if (numBytes == 0) { - description = "empty string"; - } else if (TclCheckBadOctal(NULL, bytes)) { - description = "invalid octal number"; - } else { - description = "non-numeric string"; - } + description = "non-numeric string"; } else if (type == TCL_NUMBER_NAN) { description = "non-numeric floating-point value"; } else if (type == TCL_NUMBER_DOUBLE) { @@ -9456,7 +9066,7 @@ TclGetSrcInfoForPc( ExtCmdLoc *eclPtr; ECL *locPtr = NULL; - int srcOffset; + size_t srcOffset; int i; Interp *iPtr = (Interp *) *codePtr->interpHandle; Tcl_HashEntry *hePtr = @@ -9469,7 +9079,7 @@ TclGetSrcInfoForPc( srcOffset = cfPtr->cmd - codePtr->source; eclPtr = (ExtCmdLoc *)Tcl_GetHashValue(hePtr); - for (i=0; i < eclPtr->nuloc; i++) { + for (i=0; i < (int)eclPtr->nuloc; i++) { if (eclPtr->loc[i].srcOffset == srcOffset) { locPtr = eclPtr->loc+i; break; @@ -9503,7 +9113,7 @@ GetSrcInfoForPc( * in codePtr's code. */ ByteCode *codePtr, /* The bytecode sequence in which to look up * the command source for the pc. */ - int *lengthPtr, /* If non-NULL, the location where the length + size_t *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 @@ -9513,18 +9123,18 @@ GetSrcInfoForPc( * of the command containing the pc should * be stored. */ { - int pcOffset = (pc - codePtr->codeStart); - int numCmds = codePtr->numCommands; + size_t pcOffset = (size_t)(pc - codePtr->codeStart); + size_t numCmds = codePtr->numCommands; unsigned char *codeDeltaNext, *codeLengthNext; unsigned char *srcDeltaNext, *srcLengthNext; - int codeOffset, codeLen, codeEnd, srcOffset, srcLen, delta, i; + size_t 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. */ int bestCmdIdx = -1; /* The pc must point within the bytecode */ - assert ((pcOffset >= 0) && (pcOffset < codePtr->numCodeBytes)); + assert (pcOffset < codePtr->numCodeBytes); /* * Decode the code and source offset and length for each command. The @@ -9665,10 +9275,10 @@ GetExceptRangeForPc( * for the enclosing ExceptionRange. */ { ExceptionRange *rangeArrayPtr; - int numRanges = codePtr->numExceptRanges; + size_t numRanges = codePtr->numExceptRanges; ExceptionRange *rangePtr; - int pcOffset = pc - codePtr->codeStart; - int start; + size_t pcOffset = pc - codePtr->codeStart; + size_t start; if (numRanges == 0) { return NULL; @@ -9846,9 +9456,8 @@ EvalStatsCmd( double strBytesSharedMultX, strBytesSharedOnce; double numInstructions, currentHeaderBytes; size_t numCurrentByteCodes, numByteCodeLits; - size_t refCountSum, literalMgmtBytes, sum; + size_t refCountSum, literalMgmtBytes, sum, decadeHigh, length; size_t numSharedMultX, numSharedOnce, minSizeDecade, maxSizeDecade, i; - int decadeHigh, length; char *litTableStats; LiteralEntry *entryPtr; Tcl_Obj *objPtr; @@ -9990,7 +9599,7 @@ EvalStatsCmd( if (TclHasInternalRep(entryPtr->objPtr, &tclByteCodeType)) { numByteCodeLits++; } - (void) TclGetStringFromObj(entryPtr->objPtr, &length); + (void) Tcl_GetStringFromObj(entryPtr->objPtr, &length); refCountSum += entryPtr->refCount; objBytesIfUnshared += (entryPtr->refCount * sizeof(Tcl_Obj)); strBytesIfUnshared += (entryPtr->refCount * (length+1)); @@ -10013,7 +9622,7 @@ EvalStatsCmd( Tcl_AppendPrintfToObj(objPtr, "Total literal objects\t\t%" TCL_Z_MODIFIER "u\n", statsPtr->numLiteralsCreated); - Tcl_AppendPrintfToObj(objPtr, "\nCurrent literal objects\t\t%d (%0.1f%% of current objects)\n", + Tcl_AppendPrintfToObj(objPtr, "\nCurrent literal objects\t\t%" TCL_Z_MODIFIER "u (%0.1f%% of current objects)\n", globalTablePtr->numEntries, Percent(globalTablePtr->numEntries, tclObjsAlloced-tclObjsFreed)); Tcl_AppendPrintfToObj(objPtr, " ByteCode literals\t\t%" TCL_Z_MODIFIER "u (%0.1f%% of current literals)\n", @@ -10105,14 +9714,14 @@ EvalStatsCmd( for (i = 0; i <= maxSizeDecade; i++) { decadeHigh = (1 << (i+1)) - 1; sum += statsPtr->literalCount[i]; - Tcl_AppendPrintfToObj(objPtr, "\t%10d\t\t%8.0f%%\n", + Tcl_AppendPrintfToObj(objPtr, "\t%10" TCL_Z_MODIFIER "u\t\t%8.0f%%\n", decadeHigh, Percent(sum, statsPtr->numLiteralsCreated)); } litTableStats = TclLiteralStats(globalTablePtr); Tcl_AppendPrintfToObj(objPtr, "\nCurrent literal table statistics:\n%s\n", litTableStats); - ckfree(litTableStats); + Tcl_Free(litTableStats); /* * Source and ByteCode size distributions. @@ -10127,17 +9736,18 @@ EvalStatsCmd( break; } } - for (i = 31; i != (size_t)-1; i--) { + for (i = 31; i != TCL_INDEX_NONE; i--) { if (statsPtr->srcCount[i] > 0) { - maxSizeDecade = i; - break; + break; /* maxSizeDecade to consume 'i' value + * below... */ } } + maxSizeDecade = i; sum = 0; for (i = minSizeDecade; i <= maxSizeDecade; i++) { decadeHigh = (1 << (i+1)) - 1; sum += statsPtr->srcCount[i]; - Tcl_AppendPrintfToObj(objPtr, "\t%10d\t\t%8.0f%%\n", + Tcl_AppendPrintfToObj(objPtr, "\t%10" TCL_Z_MODIFIER "u\t\t%8.0f%%\n", decadeHigh, Percent(sum, statsPtr->numCompilations)); } @@ -10150,17 +9760,18 @@ EvalStatsCmd( break; } } - for (i = 31; i != (size_t)-1; i--) { + for (i = 31; i != TCL_INDEX_NONE; i--) { if (statsPtr->byteCodeCount[i] > 0) { - maxSizeDecade = i; - break; + break; /* maxSizeDecade to consume 'i' value + * below... */ } } + maxSizeDecade = i; sum = 0; for (i = minSizeDecade; i <= maxSizeDecade; i++) { decadeHigh = (1 << (i+1)) - 1; sum += statsPtr->byteCodeCount[i]; - Tcl_AppendPrintfToObj(objPtr, "\t%10d\t\t%8.0f%%\n", + Tcl_AppendPrintfToObj(objPtr, "\t%10" TCL_Z_MODIFIER "u\t\t%8.0f%%\n", decadeHigh, Percent(sum, statsPtr->numCompilations)); } @@ -10173,12 +9784,13 @@ EvalStatsCmd( break; } } - for (i = 31; i != (size_t)-1; i--) { + for (i = 31; i != TCL_INDEX_NONE; i--) { if (statsPtr->lifetimeCount[i] > 0) { - maxSizeDecade = i; - break; + break; /* maxSizeDecade to consume 'i' value + * below... */ } } + maxSizeDecade = i; sum = 0; for (i = minSizeDecade; i <= maxSizeDecade; i++) { decadeHigh = (1 << (i+1)) - 1; @@ -10192,7 +9804,7 @@ EvalStatsCmd( */ Tcl_AppendPrintfToObj(objPtr, "\nInstruction counts:\n"); - for (i = 0; i <= LAST_INST_OPCODE; i++) { + for (i = 0; i < LAST_INST_OPCODE; i++) { Tcl_AppendPrintfToObj(objPtr, "%20s %8" TCL_Z_MODIFIER "u ", tclInstructionTable[i].name, statsPtr->instructionCount[i]); if (statsPtr->instructionCount[i]) { @@ -10213,7 +9825,7 @@ EvalStatsCmd( Tcl_SetObjResult(interp, objPtr); } else { Tcl_Channel outChan; - char *str = TclGetStringFromObj(objv[1], &length); + char *str = Tcl_GetStringFromObj(objv[1], &length); if (length) { if (strcmp(str, "stdout") == 0) { diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c index 2d24207..89550d9 100644 --- a/generic/tclFCmd.c +++ b/generic/tclFCmd.c @@ -47,7 +47,7 @@ static int FileForceOption(Tcl_Interp *interp, int TclFileRenameCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Interp for error reporting or recursive * calls in the case of a tricky rename. */ int objc, /* Number of arguments. */ @@ -76,7 +76,7 @@ TclFileRenameCmd( int TclFileCopyCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Used for error reporting or recursive calls * in the case of a tricky copy. */ int objc, /* Number of arguments. */ @@ -214,13 +214,14 @@ FileCopyRename( int TclFileMakeDirsCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Used for error reporting. */ int objc, /* Number of arguments */ Tcl_Obj *const objv[]) /* Argument strings passed to Tcl_FileCmd. */ { Tcl_Obj *errfile = NULL; - int result, i, j, pobjc; + int result, i; + size_t j, pobjc; Tcl_Obj *split = NULL; Tcl_Obj *target = NULL; Tcl_StatBuf statBuf; @@ -338,7 +339,7 @@ TclFileMakeDirsCmd( int TclFileDeleteCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Used for error reporting */ int objc, /* Number of arguments */ Tcl_Obj *const objv[]) /* Argument strings passed to Tcl_FileCmd. */ @@ -870,10 +871,10 @@ FileForceOption( static Tcl_Obj * FileBasename( - Tcl_Interp *interp, /* Interp, for error return. */ + TCL_UNUSED(Tcl_Interp *), /* Interp, for error return. */ Tcl_Obj *pathPtr) /* Path whose basename to extract. */ { - int objc; + size_t objc; Tcl_Obj *splitPtr; Tcl_Obj *resultPtr = NULL; @@ -881,17 +882,8 @@ FileBasename( Tcl_IncrRefCount(splitPtr); if (objc != 0) { - if ((objc == 1) && (*TclGetString(pathPtr) == '~')) { - Tcl_DecrRefCount(splitPtr); - if (Tcl_FSConvertToPathType(interp, pathPtr) != TCL_OK) { - return NULL; - } - splitPtr = Tcl_FSSplitPath(pathPtr, &objc); - Tcl_IncrRefCount(splitPtr); - } - - /* - * Return the last component, unless it is the only component, and it + /* + * Return the last component, unless it is the only component, and it * is the root of an absolute path. */ @@ -946,7 +938,7 @@ FileBasename( int TclFileAttrsCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* The interpreter for error reporting. */ int objc, /* Number of command line arguments. */ Tcl_Obj *const objv[]) /* The command line objects. */ @@ -955,7 +947,7 @@ TclFileAttrsCmd( const char *const *attributeStrings; const char **attributeStringsAllocated = NULL; Tcl_Obj *objStrings = NULL; - int numObjStrings = -1; + size_t numObjStrings = TCL_INDEX_NONE; Tcl_Obj *filePtr; if (objc < 2) { @@ -979,7 +971,7 @@ TclFileAttrsCmd( attributeStrings = Tcl_FSFileAttrStrings(filePtr, &objStrings); if (attributeStrings == NULL) { - int index; + size_t index; Tcl_Obj *objPtr; if (objStrings == NULL) { @@ -1162,7 +1154,7 @@ TclFileAttrsCmd( int TclFileLinkCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) @@ -1313,7 +1305,7 @@ TclFileLinkCmd( int TclFileReadLinkCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) @@ -1364,7 +1356,7 @@ TclFileReadLinkCmd( int TclFileTemporaryCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) @@ -1389,9 +1381,9 @@ TclFileTemporaryCmd( TclNewObj(nameObj); } if (objc > 2) { - int length; + size_t length; Tcl_Obj *templateObj = objv[2]; - const char *string = TclGetStringFromObj(templateObj, &length); + const char *string = Tcl_GetStringFromObj(templateObj, &length); /* * Treat an empty string as if it wasn't there. @@ -1523,7 +1515,7 @@ TclFileTemporaryCmd( int TclFileTempDirCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) @@ -1543,7 +1535,7 @@ TclFileTempDirCmd( if (objc > 1) { int length; Tcl_Obj *templateObj = objv[1]; - const char *string = TclGetStringFromObj(templateObj, &length); + 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 3ca1ab5..168355a 100644 --- a/generic/tclFileName.c +++ b/generic/tclFileName.c @@ -26,8 +26,6 @@ TclPlatformType tclPlatform = TCL_PLATFORM_UNIX; * Prototypes for local procedures defined in this file: */ -static const char * DoTildeSubst(Tcl_Interp *interp, - const char *user, Tcl_DString *resultPtr); static const char * ExtractWinRoot(const char *path, Tcl_DString *resultPtr, int offset, Tcl_PathType *typePtr); @@ -43,11 +41,8 @@ static int TclGlob(Tcl_Interp *interp, char *pattern, /* Flag values used by TclGlob() */ -#ifdef TCL_NO_DEPRECATED -# define TCL_GLOBMODE_NO_COMPLAIN 1 -# define TCL_GLOBMODE_DIR 4 -# define TCL_GLOBMODE_TAILS 8 -#endif +#define TCL_GLOBMODE_DIR 4 +#define TCL_GLOBMODE_TAILS 8 /* * When there is no support for getting the block size of a file in a stat() @@ -373,12 +368,6 @@ Tcl_GetPathType( * file). The exported function Tcl_FSGetPathType should be used by * extensions. * - * Note that '~' paths are always considered TCL_PATH_ABSOLUTE, even - * though expanding the '~' could lead to any possible path type. This - * function should therefore be considered a low-level, string - * manipulation function only -- it doesn't actually do any expansion in - * making its determination. - * * Results: * Returns one of TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, or * TCL_PATH_VOLUME_RELATIVE. @@ -392,76 +381,60 @@ Tcl_GetPathType( Tcl_PathType TclpGetNativePathType( Tcl_Obj *pathPtr, /* Native path of interest */ - int *driveNameLengthPtr, /* Returns length of drive, if non-NULL and + size_t *driveNameLengthPtr, /* Returns length of drive, if non-NULL and * path was absolute */ Tcl_Obj **driveNameRef) { Tcl_PathType type = TCL_PATH_ABSOLUTE; - int pathLen; - const char *path = TclGetStringFromObj(pathPtr, &pathLen); - - if (path[0] == '~') { - /* - * This case is common to all platforms. Paths that begin with ~ are - * absolute. - */ - - if (driveNameLengthPtr != NULL) { - const char *end = path + 1; - while ((*end != '\0') && (*end != '/')) { - end++; - } - *driveNameLengthPtr = end - path; - } - } else { - switch (tclPlatform) { - case TCL_PLATFORM_UNIX: { - const char *origPath = path; - - /* - * Paths that begin with / are absolute. - */ - - if (path[0] == '/') { - ++path; - /* - * Check for "//" network path prefix - */ - if ((*path == '/') && path[1] && (path[1] != '/')) { - path += 2; - while (*path && *path != '/') { - ++path; - } - } - if (driveNameLengthPtr != NULL) { - /* - * We need this addition in case the "//" code was used. - */ + const char *path = TclGetString(pathPtr); - *driveNameLengthPtr = (path - origPath); - } - } else { - type = TCL_PATH_RELATIVE; - } - break; - } - case TCL_PLATFORM_WINDOWS: { - Tcl_DString ds; - const char *rootEnd; - - Tcl_DStringInit(&ds); - rootEnd = ExtractWinRoot(path, &ds, 0, &type); - if ((rootEnd != path) && (driveNameLengthPtr != NULL)) { - *driveNameLengthPtr = rootEnd - path; - if (driveNameRef != NULL) { - *driveNameRef = Tcl_DStringToObj(&ds); - Tcl_IncrRefCount(*driveNameRef); - } - } - Tcl_DStringFree(&ds); - break; - } - } + switch (tclPlatform) { + case TCL_PLATFORM_UNIX: { + const char *origPath = path; + + /* + * Paths that begin with / are absolute. + */ + + if (path[0] == '/') { + ++path; + /* + * Check for "//" network path prefix + */ + if ((*path == '/') && path[1] && (path[1] != '/')) { + path += 2; + while (*path && *path != '/') { + ++path; + } + } + if (driveNameLengthPtr != NULL) { + /* + * We need this addition in case the "//" code was used. + */ + + *driveNameLengthPtr = (path - origPath); + } + } else { + type = TCL_PATH_RELATIVE; + } + break; + } + case TCL_PLATFORM_WINDOWS: { + Tcl_DString ds; + const char *rootEnd; + + Tcl_DStringInit(&ds); + rootEnd = ExtractWinRoot(path, &ds, 0, &type); + if ((rootEnd != path) && (driveNameLengthPtr != NULL)) { + *driveNameLengthPtr = rootEnd - path; + if (driveNameRef != NULL) { + *driveNameRef = Tcl_DStringToObj(&ds); + Tcl_IncrRefCount(*driveNameRef); + } + } + Tcl_DStringFree(&ds); + break; + } } return type; } @@ -492,7 +465,7 @@ TclpGetNativePathType( Tcl_Obj * TclpNativeSplitPath( Tcl_Obj *pathPtr, /* Path to split. */ - int *lenPtr) /* int to store number of path elements. */ + size_t *lenPtr) /* int to store number of path elements. */ { Tcl_Obj *resultPtr = NULL; /* Needed only to prevent gcc warnings. */ @@ -502,11 +475,11 @@ TclpNativeSplitPath( switch (tclPlatform) { case TCL_PLATFORM_UNIX: - resultPtr = SplitUnixPath(Tcl_GetString(pathPtr)); + resultPtr = SplitUnixPath(TclGetString(pathPtr)); break; case TCL_PLATFORM_WINDOWS: - resultPtr = SplitWinPath(Tcl_GetString(pathPtr)); + resultPtr = SplitWinPath(TclGetString(pathPtr)); break; } @@ -535,7 +508,7 @@ TclpNativeSplitPath( * *argcPtr will get filled in with the number of valid elements in the * array. A single block of memory is dynamically allocated to hold both * the argv array and a copy of the path elements. The caller must - * eventually free this memory by calling ckfree() on *argvPtr. Note: + * eventually free this memory by calling Tcl_Free() on *argvPtr. Note: * *argvPtr and *argcPtr are only modified if the procedure returns * normally. * @@ -549,14 +522,14 @@ TclpNativeSplitPath( void Tcl_SplitPath( const char *path, /* Pointer to string containing a path. */ - int *argcPtr, /* Pointer to location to fill in with the + size_t *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; - int i, size, len; + size_t i, size, len; char *p; const char *str; @@ -577,7 +550,7 @@ Tcl_SplitPath( size = 1; for (i = 0; i < *argcPtr; i++) { Tcl_ListObjIndex(NULL, resultPtr, i, &eltPtr); - TclGetStringFromObj(eltPtr, &len); + (void)Tcl_GetStringFromObj(eltPtr, &len); size += len + 1; } @@ -586,7 +559,7 @@ Tcl_SplitPath( * plus the argv pointers and the terminating NULL pointer. */ - *argvPtr = (const char **)ckalloc( + *argvPtr = (const char **)Tcl_Alloc( ((((*argcPtr) + 1) * sizeof(char *)) + size)); /* @@ -597,7 +570,7 @@ Tcl_SplitPath( p = (char *) &(*argvPtr)[(*argcPtr) + 1]; for (i = 0; i < *argcPtr; i++) { Tcl_ListObjIndex(NULL, resultPtr, i, &eltPtr); - str = TclGetStringFromObj(eltPtr, &len); + str = Tcl_GetStringFromObj(eltPtr, &len); memcpy(p, str, len + 1); p += len+1; } @@ -642,7 +615,7 @@ static Tcl_Obj * SplitUnixPath( const char *path) /* Pointer to string containing a path. */ { - int length; + size_t length; const char *origPath = path, *elementStart; Tcl_Obj *result; @@ -671,8 +644,7 @@ SplitUnixPath( } /* - * Split on slashes. Embedded elements that start with tilde will be - * prefixed with "./" so they are not affected by tilde substitution. + * Split on slashes. */ for (;;) { @@ -683,13 +655,8 @@ SplitUnixPath( length = path - elementStart; if (length > 0) { Tcl_Obj *nextElt; - if ((elementStart[0] == '~') && (elementStart != origPath)) { - TclNewLiteralStringObj(nextElt, "./"); - Tcl_AppendToObj(nextElt, elementStart, length); - } else { - nextElt = Tcl_NewStringObj(elementStart, length); - } - Tcl_ListObjAppendElement(NULL, result, nextElt); + nextElt = Tcl_NewStringObj(elementStart, length); + Tcl_ListObjAppendElement(NULL, result, nextElt); } if (*path++ == '\0') { break; @@ -719,7 +686,7 @@ static Tcl_Obj * SplitWinPath( const char *path) /* Pointer to string containing a path. */ { - int length; + size_t length; const char *p, *elementStart; Tcl_PathType type = TCL_PATH_ABSOLUTE; Tcl_DString buf; @@ -739,9 +706,7 @@ SplitWinPath( Tcl_DStringFree(&buf); /* - * Split on slashes. Embedded elements that start with tilde or a drive - * letter will be prefixed with "./" so they are not affected by tilde - * substitution. + * Split on slashes. */ do { @@ -752,9 +717,9 @@ SplitWinPath( length = p - elementStart; if (length > 0) { Tcl_Obj *nextElt; - if ((elementStart != path) && ((elementStart[0] == '~') - || (isalpha(UCHAR(elementStart[0])) - && elementStart[1] == ':'))) { + if ((elementStart != path) && + isalpha(UCHAR(elementStart[0])) && + (elementStart[1] == ':')) { TclNewLiteralStringObj(nextElt, "./"); Tcl_AppendToObj(nextElt, elementStart, length); } else { @@ -793,7 +758,7 @@ SplitWinPath( Tcl_Obj * Tcl_FSJoinToPath( Tcl_Obj *pathPtr, /* Valid path or NULL. */ - int objc, /* Number of array elements to join */ + size_t objc, /* Number of array elements to join */ Tcl_Obj *const objv[]) /* Path elements to join. */ { if (pathPtr == NULL) { @@ -809,13 +774,13 @@ Tcl_FSJoinToPath( pair[1] = objv[0]; return TclJoinPath(2, pair, 0); } else { - int elemc = objc + 1; - Tcl_Obj *ret, **elemv = (Tcl_Obj**)ckalloc(elemc*sizeof(Tcl_Obj *)); + size_t elemc = objc + 1; + Tcl_Obj *ret, **elemv = (Tcl_Obj**)Tcl_Alloc(elemc*sizeof(Tcl_Obj *)); elemv[0] = pathPtr; memcpy(elemv+1, objv, objc*sizeof(Tcl_Obj *)); ret = TclJoinPath(elemc, elemv, 0); - ckfree(elemv); + Tcl_Free(elemv); return ret; } } @@ -841,24 +806,25 @@ TclpNativeJoinPath( Tcl_Obj *prefix, const char *joining) { - int length, needsSep; + int needsSep; + size_t length; char *dest; const char *p; const char *start; - start = TclGetStringFromObj(prefix, &length); + start = Tcl_GetStringFromObj(prefix, &length); /* - * Remove the ./ from tilde prefixed elements, and drive-letter prefixed + * Remove the ./ from drive-letter prefixed * elements on Windows, unless it is the first component. */ p = joining; if (length != 0) { - if ((p[0] == '.') && (p[1] == '/') && ((p[2] == '~') - || (tclPlatform==TCL_PLATFORM_WINDOWS && isalpha(UCHAR(p[2])) - && (p[3] == ':')))) { + if ((p[0] == '.') && (p[1] == '/') && + (tclPlatform==TCL_PLATFORM_WINDOWS) && isalpha(UCHAR(p[2])) + && (p[3] == ':')) { p += 2; } } @@ -874,7 +840,7 @@ TclpNativeJoinPath( if (length > 0 && (start[length-1] != '/')) { Tcl_AppendToObj(prefix, "/", 1); - TclGetStringFromObj(prefix, &length); + (void)Tcl_GetStringFromObj(prefix, &length); } needsSep = 0; @@ -884,7 +850,7 @@ TclpNativeJoinPath( Tcl_SetObjLength(prefix, length + (int) strlen(p)); - dest = Tcl_GetString(prefix) + length; + dest = TclGetString(prefix) + length; for (; *p != '\0'; p++) { if (*p == '/') { while (p[1] == '/') { @@ -898,7 +864,7 @@ TclpNativeJoinPath( needsSep = 1; } } - length = dest - Tcl_GetString(prefix); + length = dest - TclGetString(prefix); Tcl_SetObjLength(prefix, length); break; @@ -910,7 +876,7 @@ TclpNativeJoinPath( if ((length > 0) && (start[length-1] != '/') && (start[length-1] != ':')) { Tcl_AppendToObj(prefix, "/", 1); - TclGetStringFromObj(prefix, &length); + (void)Tcl_GetStringFromObj(prefix, &length); } needsSep = 0; @@ -919,7 +885,7 @@ TclpNativeJoinPath( */ Tcl_SetObjLength(prefix, length + (int) strlen(p)); - dest = Tcl_GetString(prefix) + length; + dest = TclGetString(prefix) + length; for (; *p != '\0'; p++) { if ((*p == '/') || (*p == '\\')) { while ((p[1] == '/') || (p[1] == '\\')) { @@ -933,7 +899,7 @@ TclpNativeJoinPath( needsSep = 1; } } - length = dest - Tcl_GetString(prefix); + length = dest - TclGetString(prefix); Tcl_SetObjLength(prefix, length); break; } @@ -961,11 +927,11 @@ TclpNativeJoinPath( char * Tcl_JoinPath( - int argc, + size_t argc, const char *const *argv, Tcl_DString *resultPtr) /* Pointer to previously initialized DString */ { - int i, len; + size_t i, len; Tcl_Obj *listObj; Tcl_Obj *resultObj; const char *resultStr; @@ -993,7 +959,7 @@ Tcl_JoinPath( * Store the result. */ - resultStr = TclGetStringFromObj(resultObj, &len); + resultStr = Tcl_GetStringFromObj(resultObj, &len); Tcl_DStringAppend(resultPtr, resultStr, len); Tcl_DecrRefCount(resultObj); @@ -1010,19 +976,15 @@ Tcl_JoinPath( * Tcl_TranslateFileName -- * * Converts a file name into a form usable by the native system - * interfaces. If the name starts with a tilde, it will produce a name - * where the tilde and following characters have been replaced by the - * home directory location for the named user. + * interfaces. * * Results: - * The return value is a pointer to a string containing the name after - * tilde substitution. If there was no tilde substitution, the return - * value is a pointer to a copy of the original string. If there was an + * The return value is a pointer to a string containing the name. + * This may either be the name pointer passed in or space allocated in + * bufferPtr. In all cases, if the return value is not NULL, the caller + * must call Tcl_DStringFree() to free the space. If there was an * error in processing the name, then an error message is left in the * interp's result (if interp was not NULL) and the return value is NULL. - * Space for the return value is allocated in bufferPtr; the caller must - * call Tcl_DStringFree() to free the space if the return value was not - * NULL. * * Side effects: * None. @@ -1039,7 +1001,7 @@ Tcl_TranslateFileName( * "~<user>" (to indicate any user's home * directory). */ Tcl_DString *bufferPtr) /* Uninitialized or free DString filled with - * name after tilde substitution. */ + * name. */ { Tcl_Obj *path = Tcl_NewStringObj(name, -1); Tcl_Obj *transPtr; @@ -1134,65 +1096,6 @@ TclGetExtension( /* *---------------------------------------------------------------------- * - * DoTildeSubst -- - * - * Given a string following a tilde, this routine returns the - * corresponding home directory. - * - * Results: - * The result is a pointer to a static string containing the home - * directory in native format. If there was an error in processing the - * substitution, then an error message is left in the interp's result and - * the return value is NULL. On success, the results are appended to - * resultPtr, and the contents of resultPtr are returned. - * - * Side effects: - * Information may be left in resultPtr. - * - *---------------------------------------------------------------------- - */ - -static const char * -DoTildeSubst( - Tcl_Interp *interp, /* Interpreter in which to store error message - * (if necessary). */ - const char *user, /* Name of user whose home directory should be - * substituted, or "" for current user. */ - Tcl_DString *resultPtr) /* Initialized DString filled with name after - * tilde substitution. */ -{ - const char *dir; - - if (*user == '\0') { - Tcl_DString dirString; - - dir = TclGetEnv("HOME", &dirString); - if (dir == NULL) { - if (interp) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "couldn't find HOME environment " - "variable to expand path", -1)); - Tcl_SetErrorCode(interp, "TCL", "FILENAME", "NO_HOME", NULL); - } - return NULL; - } - Tcl_JoinPath(1, &dir, resultPtr); - Tcl_DStringFree(&dirString); - } else if (TclpGetUserHome(user, resultPtr) == NULL) { - if (interp) { - Tcl_ResetResult(interp); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "user \"%s\" doesn't exist", user)); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "USER", user, NULL); - } - return NULL; - } - return Tcl_DStringValue(resultPtr); -} - -/* - *---------------------------------------------------------------------- - * * Tcl_GlobObjCmd -- * * This procedure is invoked to process the "glob" Tcl command. See the @@ -1209,12 +1112,13 @@ DoTildeSubst( int Tcl_GlobObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int index, i, globFlags, length, join, dir, result; + int i, globFlags, join, dir, result; + size_t length; char *string; const char *separators; Tcl_Obj *typePtr, *look; @@ -1227,7 +1131,7 @@ Tcl_GlobObjCmd( enum globOptionsEnum { GLOB_DIR, GLOB_JOIN, GLOB_NOCOMPLAIN, GLOB_PATH, GLOB_TAILS, GLOB_TYPE, GLOB_LAST - }; + } index; enum pathDirOptions {PATH_NONE = -1 , PATH_GENERAL = 0, PATH_DIR = 1}; Tcl_GlobTypeData *globTypes = NULL; @@ -1236,9 +1140,9 @@ Tcl_GlobObjCmd( dir = PATH_NONE; typePtr = NULL; for (i = 1; i < objc; i++) { - if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, - &index) != TCL_OK) { - string = TclGetStringFromObj(objv[i], &length); + if (Tcl_GetIndexFromObj(interp, objv[i], options, + "option", 0, &index) != TCL_OK) { + string = TclGetString(objv[i]); if (string[0] == '-') { /* * It looks like the command contains an option so signal an @@ -1257,9 +1161,12 @@ Tcl_GlobObjCmd( } } - switch ((enum globOptionsEnum) index) { + switch (index) { case GLOB_NOCOMPLAIN: /* -nocomplain */ - globFlags |= TCL_GLOBMODE_NO_COMPLAIN; + /* + * Do nothing; This is normal operations in Tcl 9. + * Keep accepting as a no-op option to accommodate old scripts. + */ break; case GLOB_DIR: /* -dir */ if (i == (objc-1)) { @@ -1350,9 +1257,9 @@ Tcl_GlobObjCmd( } if (dir == PATH_GENERAL) { - int pathlength; + size_t pathlength; const char *last; - const char *first = TclGetStringFromObj(pathOrDir,&pathlength); + const char *first = Tcl_GetStringFromObj(pathOrDir,&pathlength); /* * Find the last path separator in the path @@ -1402,7 +1309,7 @@ Tcl_GlobObjCmd( * there are none presently in the prefix. */ - if (strpbrk(Tcl_GetString(pathOrDir), "\\/") == NULL) { + if (strpbrk(TclGetString(pathOrDir), "\\/") == NULL) { Tcl_AppendToObj(pathOrDir, last-1, 1); } } @@ -1441,7 +1348,7 @@ Tcl_GlobObjCmd( */ TclListObjLengthM(interp, typePtr, &length); - if (length <= 0) { + if (length == 0) { goto skipTypes; } globTypes = (Tcl_GlobTypeData *)TclStackAlloc(interp, sizeof(Tcl_GlobTypeData)); @@ -1450,12 +1357,12 @@ Tcl_GlobObjCmd( globTypes->macType = NULL; globTypes->macCreator = NULL; - while (--length >= 0) { - int len; + while (length-- > 0) { + size_t len; const char *str; Tcl_ListObjIndex(interp, typePtr, length, &look); - str = TclGetStringFromObj(look, &len); + str = Tcl_GetStringFromObj(look, &len); if (strcmp("readonly", str) == 0) { globTypes->perm |= TCL_GLOB_PERM_RONLY; } else if (strcmp("hidden", str) == 0) { @@ -1509,13 +1416,14 @@ Tcl_GlobObjCmd( } else { Tcl_Obj *item; + size_t llen; - if ((TclListObjLengthM(NULL, look, &len) == TCL_OK) - && (len == 3)) { + if ((TclListObjLengthM(NULL, look, &llen) == TCL_OK) + && (llen == 3)) { Tcl_ListObjIndex(interp, look, 0, &item); - if (!strcmp("macintosh", Tcl_GetString(item))) { + if (!strcmp("macintosh", TclGetString(item))) { Tcl_ListObjIndex(interp, look, 1, &item); - if (!strcmp("type", Tcl_GetString(item))) { + if (!strcmp("type", TclGetString(item))) { Tcl_ListObjIndex(interp, look, 2, &item); if (globTypes->macType != NULL) { goto badMacTypesArg; @@ -1523,7 +1431,7 @@ Tcl_GlobObjCmd( globTypes->macType = item; Tcl_IncrRefCount(item); continue; - } else if (!strcmp("creator", Tcl_GetString(item))) { + } else if (!strcmp("creator", TclGetString(item))) { Tcl_ListObjIndex(interp, look, 2, &item); if (globTypes->macCreator != NULL) { goto badMacTypesArg; @@ -1543,7 +1451,7 @@ Tcl_GlobObjCmd( badTypesArg: Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad argument to \"-types\": %s", - Tcl_GetString(look))); + TclGetString(look))); Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "BAD", NULL); result = TCL_ERROR; join = 0; @@ -1607,7 +1515,7 @@ Tcl_GlobObjCmd( Tcl_DStringFree(&str); } else { for (i = 0; i < objc; i++) { - string = Tcl_GetString(objv[i]); + string = TclGetString(objv[i]); if (TclGlob(interp, string, pathOrDir, globFlags, globTypes) != TCL_OK) { result = TCL_ERROR; @@ -1616,41 +1524,6 @@ Tcl_GlobObjCmd( } } - if ((globFlags & TCL_GLOBMODE_NO_COMPLAIN) == 0) { - if (TclListObjLengthM(interp, Tcl_GetObjResult(interp), - &length) != TCL_OK) { - /* - * This should never happen. Maybe we should be more dramatic. - */ - - result = TCL_ERROR; - goto endOfGlob; - } - - if (length == 0) { - Tcl_Obj *errorMsg = - Tcl_ObjPrintf("no files matched glob pattern%s \"", - (join || (objc == 1)) ? "" : "s"); - - if (join) { - Tcl_AppendToObj(errorMsg, Tcl_DStringValue(&prefix), -1); - } else { - const char *sep = ""; - - for (i = 0; i < objc; i++) { - Tcl_AppendPrintfToObj(errorMsg, "%s%s", - sep, Tcl_GetString(objv[i])); - sep = " "; - } - } - Tcl_AppendToObj(errorMsg, "\"", -1); - Tcl_SetObjResult(interp, errorMsg); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "NOMATCH", - NULL); - result = TCL_ERROR; - } - } - endOfGlob: if (join || (dir == PATH_GENERAL)) { Tcl_DStringFree(&prefix); @@ -1675,8 +1548,7 @@ Tcl_GlobObjCmd( * * TclGlob -- * - * Sets the separator string based on the platform, performs tilde - * substitution, and calls DoGlob. + * Sets the separator string based on the platform and calls DoGlob. * * The interpreter's result, on entry to this function, must be a valid * Tcl list (e.g. it could be empty), since we will lappend any new @@ -1712,8 +1584,7 @@ TclGlob( * NULL. */ { const char *separators; - const char *head; - char *tail, *start; + char *tail; int result; Tcl_Obj *filenamesObj, *savedResultObj; @@ -1727,60 +1598,10 @@ TclGlob( break; } - if (pathPrefix == NULL) { - char c; - Tcl_DString buffer; - Tcl_DStringInit(&buffer); - - start = pattern; - - /* - * Perform tilde substitution, if needed. - */ - - if (start[0] == '~') { - /* - * Find the first path separator after the tilde. - */ - - for (tail = start; *tail != '\0'; tail++) { - if (*tail == '\\') { - if (strchr(separators, tail[1]) != NULL) { - break; - } - } else if (strchr(separators, *tail) != NULL) { - break; - } - } - - /* - * Determine the home directory for the specified user. - */ - - c = *tail; - *tail = '\0'; - head = DoTildeSubst(interp, start+1, &buffer); - *tail = c; - if (head == NULL) { - return TCL_ERROR; - } - if (head != Tcl_DStringValue(&buffer)) { - Tcl_DStringAppend(&buffer, head, -1); - } - pathPrefix = Tcl_DStringToObj(&buffer); - Tcl_IncrRefCount(pathPrefix); - globFlags |= TCL_GLOBMODE_DIR; - if (c != '\0') { - tail++; - } - Tcl_DStringFree(&buffer); - } else { - tail = pattern; - } - } else { + if (pathPrefix != NULL) { Tcl_IncrRefCount(pathPrefix); - tail = pattern; } + tail = pattern; /* * Handling empty path prefixes with glob patterns like 'C:' or @@ -1819,7 +1640,7 @@ TclGlob( Tcl_IncrRefCount(pathPrefix); } else if (pathPrefix == NULL && (tail[0] == '/' || (tail[0] == '\\' && tail[1] == '\\'))) { - int driveNameLen; + size_t driveNameLen; Tcl_Obj *driveName; Tcl_Obj *temp = Tcl_NewStringObj(tail, -1); Tcl_IncrRefCount(temp); @@ -1840,7 +1661,7 @@ TclGlob( Tcl_DecrRefCount(temp); return TCL_ERROR; } - pathPrefix = Tcl_NewStringObj(Tcl_GetString(cwd), 3); + pathPrefix = Tcl_NewStringObj(TclGetString(cwd), 3); Tcl_DecrRefCount(cwd); if (tail[0] == '/') { tail++; @@ -1887,9 +1708,9 @@ TclGlob( */ if (pathPrefix == NULL) { - int driveNameLen; + size_t driveNameLen; Tcl_Obj *driveName; - if (TclFSNonnativePathType(tail, (int) strlen(tail), NULL, + if (TclFSNonnativePathType(tail, strlen(tail), NULL, &driveNameLen, &driveName) == TCL_PATH_ABSOLUTE) { pathPrefix = driveName; tail += driveNameLen; @@ -1972,9 +1793,9 @@ TclGlob( */ if (globFlags & TCL_GLOBMODE_TAILS) { - int objc, i; + size_t objc, i; Tcl_Obj **objv; - int prefixLen; + size_t prefixLen; const char *pre; /* @@ -1985,7 +1806,7 @@ TclGlob( Tcl_Panic("Called TclGlob with TCL_GLOBMODE_TAILS and pathPrefix==NULL"); } - pre = TclGetStringFromObj(pathPrefix, &prefixLen); + pre = Tcl_GetStringFromObj(pathPrefix, &prefixLen); if (prefixLen > 0 && (strchr(separators, pre[prefixLen-1]) == NULL)) { /* @@ -2002,8 +1823,8 @@ TclGlob( TclListObjGetElementsM(NULL, filenamesObj, &objc, &objv); for (i = 0; i< objc; i++) { - int len; - const char *oldStr = TclGetStringFromObj(objv[i], &len); + size_t len; + const char *oldStr = Tcl_GetStringFromObj(objv[i], &len); Tcl_Obj *elem; if (len == prefixLen) { @@ -2326,7 +2147,7 @@ DoGlob( pattern, &dirOnly); *p = save; if (result == TCL_OK) { - int subdirc, i, repair = -1; + size_t i, subdirc, repair = TCL_INDEX_NONE; Tcl_Obj **subdirv; result = TclListObjGetElementsM(interp, subdirsPtr, @@ -2334,34 +2155,27 @@ DoGlob( for (i=0; result==TCL_OK && i<subdirc; i++) { Tcl_Obj *copy = NULL; - if (pathPtr == NULL && Tcl_GetString(subdirv[i])[0] == '~') { - TclListObjLengthM(NULL, matchesObj, &repair); - copy = subdirv[i]; - subdirv[i] = Tcl_NewStringObj("./", 2); - Tcl_AppendObjToObj(subdirv[i], copy); - Tcl_IncrRefCount(subdirv[i]); - } result = DoGlob(interp, matchesObj, separators, subdirv[i], 1, p+1, types); if (copy) { - int end; + size_t end; Tcl_DecrRefCount(subdirv[i]); subdirv[i] = copy; TclListObjLengthM(NULL, matchesObj, &end); - while (repair < end) { + while (repair + 1 <= end) { const char *bytes; - int numBytes; + size_t numBytes; Tcl_Obj *fixme, *newObj; Tcl_ListObjIndex(NULL, matchesObj, repair, &fixme); - bytes = TclGetStringFromObj(fixme, &numBytes); + bytes = Tcl_GetStringFromObj(fixme, &numBytes); newObj = Tcl_NewStringObj(bytes+2, numBytes-2); Tcl_ListObjReplace(NULL, matchesObj, repair, 1, 1, &newObj); repair++; } - repair = -1; + repair = TCL_INDEX_NONE; } } } @@ -2374,7 +2188,7 @@ DoGlob( */ if (*p == '\0') { - int length; + size_t length; Tcl_DString append; /* @@ -2393,7 +2207,7 @@ DoGlob( Tcl_DStringAppend(&append, pattern, p-pattern); if (pathPtr != NULL) { - (void) TclGetStringFromObj(pathPtr, &length); + (void) Tcl_GetStringFromObj(pathPtr, &length); } else { length = 0; } @@ -2438,8 +2252,8 @@ DoGlob( * The current prefix must end in a separator. */ - int len; - const char *joined = TclGetStringFromObj(joinedPtr,&len); + size_t len; + const char *joined = Tcl_GetStringFromObj(joinedPtr,&len); if ((len > 0) && (strchr(separators, joined[len-1]) == NULL)) { Tcl_AppendToObj(joinedPtr, "/", 1); @@ -2475,8 +2289,8 @@ DoGlob( * This behaviour is not currently tested for in the test suite. */ - int len; - const char *joined = TclGetStringFromObj(joinedPtr,&len); + size_t len; + const char *joined = Tcl_GetStringFromObj(joinedPtr,&len); if ((len > 0) && (strchr(separators, joined[len-1]) == NULL)) { if (Tcl_FSGetPathType(pathPtr) != TCL_PATH_VOLUME_RELATIVE) { @@ -2505,7 +2319,7 @@ DoGlob( * * Results: * A pointer to a Tcl_StatBuf which may be deallocated by being passed to - * ckfree(). + * Tcl_Free(). * * Side effects: * None. @@ -2516,7 +2330,7 @@ DoGlob( Tcl_StatBuf * Tcl_AllocStatBuf(void) { - return (Tcl_StatBuf *)ckalloc(sizeof(Tcl_StatBuf)); + return (Tcl_StatBuf *)Tcl_Alloc(sizeof(Tcl_StatBuf)); } /* diff --git a/generic/tclFileSystem.h b/generic/tclFileSystem.h index 503b204..852bbbd 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, - int *driveNameLengthPtr); + size_t *driveNameLengthPtr); MODULE_SCOPE Tcl_PathType TclFSNonnativePathType(const char *pathPtr, - int pathLen, const Tcl_Filesystem **filesystemPtrPtr, - int *driveNameLengthPtr, Tcl_Obj **driveNameRef); + size_t pathLen, const Tcl_Filesystem **filesystemPtrPtr, + size_t *driveNameLengthPtr, Tcl_Obj **driveNameRef); MODULE_SCOPE Tcl_PathType TclGetPathType(Tcl_Obj *pathPtr, const Tcl_Filesystem **filesystemPtrPtr, - int *driveNameLengthPtr, Tcl_Obj **driveNameRef); + size_t *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/tclGetDate.y b/generic/tclGetDate.y index e85184b..e282c9b 100644 --- a/generic/tclGetDate.y +++ b/generic/tclGetDate.y @@ -97,8 +97,8 @@ typedef struct DateInfo { int dateDigitCount; } DateInfo; -#define YYMALLOC ckalloc -#define YYFREE(x) (ckfree((void*) (x))) +#define YYMALLOC Tcl_Alloc +#define YYFREE(x) (Tcl_Free((void*) (x))) #define yyDSTmode (info->dateDSTmode) #define yyDayOrdinal (info->dateDayOrdinal) @@ -976,7 +976,7 @@ TclClockOldscanObjCmd( return TCL_ERROR; } - yyInput = Tcl_GetString( objv[1] ); + yyInput = TclGetString(objv[1]); dateInfo.dateStart = yyInput; yyHaveDate = 0; @@ -1063,16 +1063,16 @@ TclClockOldscanObjCmd( TclNewObj(resultElement); if (yyHaveDate) { Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj((int) yyYear)); + Tcl_NewIntObj(yyYear)); Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj((int) yyMonth)); + Tcl_NewIntObj(yyMonth)); Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj((int) yyDay)); + Tcl_NewIntObj(yyDay)); } Tcl_ListObjAppendElement(interp, result, resultElement); if (yyHaveTime) { - Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj((int) + Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj( ToSeconds(yyHour, yyMinutes, yySeconds, (MERIDIAN)yyMeridian))); } else { Tcl_ListObjAppendElement(interp, result, Tcl_NewObj()); @@ -1081,7 +1081,7 @@ TclClockOldscanObjCmd( TclNewObj(resultElement); if (yyHaveZone) { Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj((int) -yyTimezone)); + Tcl_NewIntObj(-yyTimezone)); Tcl_ListObjAppendElement(interp, resultElement, Tcl_NewIntObj(1 - yyDSTmode)); } @@ -1090,29 +1090,29 @@ TclClockOldscanObjCmd( TclNewObj(resultElement); if (yyHaveRel) { Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj((int) yyRelMonth)); + Tcl_NewIntObj(yyRelMonth)); Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj((int) yyRelDay)); + Tcl_NewIntObj(yyRelDay)); Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj((int) yyRelSeconds)); + Tcl_NewIntObj(yyRelSeconds)); } Tcl_ListObjAppendElement(interp, result, resultElement); TcNewObj(resultElement); if (yyHaveDay && !yyHaveDate) { Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj((int) yyDayOrdinal)); + Tcl_NewIntObj(yyDayOrdinal)); Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj((int) yyDayNumber)); + Tcl_NewIntObj(yyDayNumber)); } Tcl_ListObjAppendElement(interp, result, resultElement); TclNewObj(resultElement); if (yyHaveOrdinalMonth) { Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj((int) yyMonthOrdinal)); + Tcl_NewIntObj(yyMonthOrdinal)); Tcl_ListObjAppendElement(interp, resultElement, - Tcl_NewIntObj((int) yyMonth)); + Tcl_NewIntObj(yyMonth)); } Tcl_ListObjAppendElement(interp, result, resultElement); diff --git a/generic/tclHash.c b/generic/tclHash.c index 37e45e7..5cfc63c 100644 --- a/generic/tclHash.c +++ b/generic/tclHash.c @@ -14,13 +14,6 @@ #include "tclInt.h" /* - * Prevent macros from clashing with function definitions. - */ - -#undef Tcl_FindHashEntry -#undef Tcl_CreateHashEntry - -/* * When there are this many entries per bucket, on average, rebuild the hash * table to make it larger. */ @@ -35,7 +28,7 @@ */ #define RANDOM_INDEX(tablePtr, i) \ - ((((i)*1103515245UL) >> (tablePtr)->downShift) & (tablePtr)->mask) + ((((i)*(size_t)1103515245) >> (tablePtr)->downShift) & (tablePtr)->mask) /* * Prototypes for the array hash key methods. @@ -200,7 +193,7 @@ Tcl_InitCustomHashTable( /* *---------------------------------------------------------------------- * - * Tcl_FindHashEntry -- + * FindHashEntry -- * * Given a hash table find the entry with a matching key. * @@ -214,14 +207,6 @@ Tcl_InitCustomHashTable( *---------------------------------------------------------------------- */ -Tcl_HashEntry * -Tcl_FindHashEntry( - Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */ - const void *key) /* Key to use to find matching entry. */ -{ - return (*((tablePtr)->findProc))(tablePtr, (const char *)key); -} - static Tcl_HashEntry * FindHashEntry( Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */ @@ -234,7 +219,7 @@ FindHashEntry( /* *---------------------------------------------------------------------- * - * Tcl_CreateHashEntry -- + * CreateHashEntry -- * * Given a hash table with string keys, and a string key, find the entry * with a matching key. If there is no matching entry, then create a new @@ -252,17 +237,6 @@ FindHashEntry( *---------------------------------------------------------------------- */ -Tcl_HashEntry * -Tcl_CreateHashEntry( - Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */ - const void *key, /* Key to use to find or create matching - * entry. */ - int *newPtr) /* Store info here telling whether a new entry - * was created. */ -{ - return (*((tablePtr)->createProc))(tablePtr, (const char *)key, newPtr); -} - static Tcl_HashEntry * CreateHashEntry( Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */ @@ -307,7 +281,7 @@ CreateHashEntry( for (hPtr = tablePtr->buckets[index]; hPtr != NULL; hPtr = hPtr->nextPtr) { - if (hash != PTR2UINT(hPtr->hash)) { + if (hash != hPtr->hash) { continue; } /* if keys pointers or values are equal */ @@ -323,7 +297,7 @@ CreateHashEntry( } else { for (hPtr = tablePtr->buckets[index]; hPtr != NULL; hPtr = hPtr->nextPtr) { - if (hash != PTR2UINT(hPtr->hash)) { + if (hash != hPtr->hash) { continue; } if (key == hPtr->key.oneWordValue) { @@ -347,13 +321,13 @@ CreateHashEntry( if (typePtr->allocEntryProc) { hPtr = typePtr->allocEntryProc(tablePtr, (void *) key); } else { - hPtr = (Tcl_HashEntry *)ckalloc(sizeof(Tcl_HashEntry)); + hPtr = (Tcl_HashEntry *)Tcl_Alloc(sizeof(Tcl_HashEntry)); hPtr->key.oneWordValue = (char *) key; Tcl_SetHashValue(hPtr, NULL); } hPtr->tablePtr = tablePtr; - hPtr->hash = UINT2PTR(hash); + hPtr->hash = hash; hPtr->nextPtr = tablePtr->buckets[index]; tablePtr->buckets[index] = hPtr; tablePtr->numEntries++; @@ -412,9 +386,9 @@ Tcl_DeleteHashEntry( if (typePtr->hashKeyProc == NULL || typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) { - index = RANDOM_INDEX(tablePtr, PTR2UINT(entryPtr->hash)); + index = RANDOM_INDEX(tablePtr, entryPtr->hash); } else { - index = PTR2UINT(entryPtr->hash) & tablePtr->mask; + index = entryPtr->hash & tablePtr->mask; } bucketPtr = &tablePtr->buckets[index]; @@ -437,7 +411,7 @@ Tcl_DeleteHashEntry( if (typePtr->freeEntryProc) { typePtr->freeEntryProc(entryPtr); } else { - ckfree(entryPtr); + Tcl_Free(entryPtr); } } @@ -464,7 +438,7 @@ Tcl_DeleteHashTable( { Tcl_HashEntry *hPtr, *nextPtr; const Tcl_HashKeyType *typePtr; - int i; + size_t i; if (tablePtr->keyType == TCL_STRING_KEYS) { typePtr = &tclStringHashKeyType; @@ -488,7 +462,7 @@ Tcl_DeleteHashTable( if (typePtr->freeEntryProc) { typePtr->freeEntryProc(hPtr); } else { - ckfree(hPtr); + Tcl_Free(hPtr); } hPtr = nextPtr; } @@ -502,7 +476,7 @@ Tcl_DeleteHashTable( if (typePtr->flags & TCL_HASH_KEY_SYSTEM_HASH) { TclpSysFree((char *) tablePtr->buckets); } else { - ckfree(tablePtr->buckets); + Tcl_Free(tablePtr->buckets); } } @@ -613,7 +587,7 @@ Tcl_HashStats( Tcl_HashTable *tablePtr) /* Table for which to produce stats. */ { #define NUM_COUNTERS 10 - int i; + size_t i; TCL_HASH_TYPE count[NUM_COUNTERS], overflow, j; double average, tmp; Tcl_HashEntry *hPtr; @@ -648,16 +622,16 @@ Tcl_HashStats( * Print out the histogram and a few other pieces of information. */ - result = (char *)ckalloc((NUM_COUNTERS * 60) + 300); - sprintf(result, "%u entries in table, %u buckets\n", + result = (char *)Tcl_Alloc((NUM_COUNTERS * 60) + 300); + sprintf(result, "%" 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 %u entries: %u\n", + sprintf(p, "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 %u or more entries: %u\n", + sprintf(p, "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); @@ -692,7 +666,7 @@ AllocArrayEntry( if (size < sizeof(Tcl_HashEntry)) { size = sizeof(Tcl_HashEntry); } - hPtr = (Tcl_HashEntry *)ckalloc(size); + hPtr = (Tcl_HashEntry *)Tcl_Alloc(size); memcpy(hPtr->key.string, keyPtr, count); Tcl_SetHashValue(hPtr, NULL); @@ -790,7 +764,7 @@ AllocStringEntry( if (size < sizeof(hPtr->key)) { allocsize = sizeof(hPtr->key); } - hPtr = (Tcl_HashEntry *)ckalloc(offsetof(Tcl_HashEntry, key) + allocsize); + hPtr = (Tcl_HashEntry *)Tcl_Alloc(offsetof(Tcl_HashEntry, key) + allocsize); memset(hPtr, 0, offsetof(Tcl_HashEntry, key) + allocsize); memcpy(hPtr->key.string, string, size); Tcl_SetHashValue(hPtr, NULL); @@ -994,10 +968,10 @@ RebuildTable( tablePtr->numBuckets *= 4; if (typePtr->flags & TCL_HASH_KEY_SYSTEM_HASH) { tablePtr->buckets = (Tcl_HashEntry **)TclpSysAlloc( - tablePtr->numBuckets * sizeof(Tcl_HashEntry *), 0); + tablePtr->numBuckets * sizeof(Tcl_HashEntry *)); } else { tablePtr->buckets = - (Tcl_HashEntry **)ckalloc(tablePtr->numBuckets * sizeof(Tcl_HashEntry *)); + (Tcl_HashEntry **)Tcl_Alloc(tablePtr->numBuckets * sizeof(Tcl_HashEntry *)); } for (count = tablePtr->numBuckets, newChainPtr = tablePtr->buckets; count > 0; count--, newChainPtr++) { @@ -1018,9 +992,9 @@ RebuildTable( *oldChainPtr = hPtr->nextPtr; if (typePtr->hashKeyProc == NULL || typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) { - index = RANDOM_INDEX(tablePtr, PTR2UINT(hPtr->hash)); + index = RANDOM_INDEX(tablePtr, hPtr->hash); } else { - index = PTR2UINT(hPtr->hash) & tablePtr->mask; + index = hPtr->hash & tablePtr->mask; } hPtr->nextPtr = tablePtr->buckets[index]; tablePtr->buckets[index] = hPtr; @@ -1035,7 +1009,7 @@ RebuildTable( if (typePtr->flags & TCL_HASH_KEY_SYSTEM_HASH) { TclpSysFree((char *) oldBuckets); } else { - ckfree(oldBuckets); + Tcl_Free(oldBuckets); } } } diff --git a/generic/tclHistory.c b/generic/tclHistory.c index 02e15a0..dc5a67d 100644 --- a/generic/tclHistory.c +++ b/generic/tclHistory.c @@ -74,13 +74,6 @@ Tcl_RecordAndEval( result = Tcl_RecordAndEvalObj(interp, cmdPtr, flags); /* - * Move the interpreter's object result to the string result, then - * reset the object result. - */ - - (void) Tcl_GetStringResult(interp); - - /* * Discard the Tcl object created to hold the command. */ @@ -137,7 +130,7 @@ Tcl_RecordAndEvalObj( */ if (histObjsPtr == NULL) { - histObjsPtr = (HistoryObjs *)ckalloc(sizeof(HistoryObjs)); + histObjsPtr = (HistoryObjs *)Tcl_Alloc(sizeof(HistoryObjs)); TclNewLiteralStringObj(histObjsPtr->historyObj, "::history"); TclNewLiteralStringObj(histObjsPtr->addObj, "add"); Tcl_IncrRefCount(histObjsPtr->historyObj); @@ -210,14 +203,14 @@ Tcl_RecordAndEvalObj( static void DeleteHistoryObjs( - ClientData clientData, + void *clientData, TCL_UNUSED(Tcl_Interp *)) { HistoryObjs *histObjsPtr = (HistoryObjs *)clientData; TclDecrRefCount(histObjsPtr->historyObj); TclDecrRefCount(histObjsPtr->addObj); - ckfree(histObjsPtr); + Tcl_Free(histObjsPtr); } /* diff --git a/generic/tclIO.c b/generic/tclIO.c index 8e4ecee..64b309d 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -102,7 +102,7 @@ typedef struct CopyState { Tcl_WideInt total; /* Total bytes transferred (written). */ Tcl_Interp *interp; /* Interp that started the copy. */ Tcl_Obj *cmdPtr; /* Command to be invoked at completion. */ - int bufSize; /* Size of appended buffer. */ + size_t bufSize; /* Size of appended buffer. */ char buffer[TCLFLEXARRAY]; /* Copy buffer, this must be the last * field. */ } CopyState; @@ -151,7 +151,7 @@ typedef struct CloseCallback { * Static functions in this file: */ -static ChannelBuffer * AllocChannelBuffer(int length); +static ChannelBuffer * AllocChannelBuffer(size_t length); static void PreserveChannelBuffer(ChannelBuffer *bufPtr); static void ReleaseChannelBuffer(ChannelBuffer *bufPtr); static int IsShared(ChannelBuffer *bufPtr); @@ -191,9 +191,9 @@ static int DetachChannel(Tcl_Interp *interp, Tcl_Channel chan); static void DiscardInputQueued(ChannelState *statePtr, int discardSavedBuffers); static void DiscardOutputQueued(ChannelState *chanPtr); -static int DoRead(Channel *chanPtr, char *dst, int bytesToRead, +static int DoRead(Channel *chanPtr, char *dst, size_t bytesToRead, int allowShortReads); -static int DoReadChars(Channel *chan, Tcl_Obj *objPtr, int toRead, +static int DoReadChars(Channel *chan, Tcl_Obj *objPtr, size_t toRead, int appendFlag); static int FilterInputBytes(Channel *chanPtr, GetsState *statePtr); @@ -237,7 +237,7 @@ static int WillRead(Channel *chanPtr); * short description of what the macro does. * * -------------------------------------------------------------------------- - * int BytesLeft(ChannelBuffer *bufPtr) + * size_t BytesLeft(ChannelBuffer *bufPtr) * * Returns the number of bytes of data remaining in the buffer. * @@ -332,7 +332,8 @@ static const Tcl_ObjType chanObjType = { FreeChannelInternalRep, /* freeIntRepProc */ DupChannelInternalRep, /* dupIntRepProc */ NULL, /* updateStringProc */ - NULL /* setFromAnyProc */ + NULL, /* setFromAnyProc */ + TCL_OBJTYPE_V0 }; #define ChanSetInternalRep(objPtr, resPtr) \ @@ -374,11 +375,6 @@ ChanClose( Channel *chanPtr, Tcl_Interp *interp) { -#ifndef TCL_NO_DEPRECATED - if ((chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) && (chanPtr->typePtr->closeProc != NULL)) { - return chanPtr->typePtr->closeProc(chanPtr->instanceData, interp); - } -#endif return chanPtr->typePtr->close2Proc(chanPtr->instanceData, interp, 0); } @@ -393,7 +389,7 @@ ChanClose( * Results: * The return value of the driver inputProc, * - number of bytes stored at dst, ot - * - TCL_INDEX_NONE on error, with a Posix error code available to the caller by + * - -1 on error, with a Posix error code available to the caller by * calling Tcl_GetErrno(). * * Side effects: @@ -430,8 +426,8 @@ ChanRead( } ResetFlag(chanPtr->state, CHANNEL_BLOCKED | CHANNEL_EOF); chanPtr->state->inputEncodingFlags &= ~TCL_ENCODING_END; - if (WillRead(chanPtr) < 0) { - return TCL_INDEX_NONE; + if (WillRead(chanPtr) == -1) { + return -1; } bytesRead = chanPtr->typePtr->inputProc(chanPtr->instanceData, @@ -446,7 +442,7 @@ ChanRead( } ResetFlag(chanPtr->state, CHANNEL_BLOCKED | CHANNEL_EOF); chanPtr->state->inputEncodingFlags &= ~TCL_ENCODING_END; - if (bytesRead < 0) { + if (bytesRead == -1) { if ((result == EWOULDBLOCK) || (result == EAGAIN)) { SetFlag(chanPtr->state, CHANNEL_BLOCKED); result = EAGAIN; @@ -483,18 +479,8 @@ ChanSeek( */ if (Tcl_ChannelWideSeekProc(chanPtr->typePtr) == NULL) { -#ifndef TCL_NO_DEPRECATED - if (offset<LONG_MIN || offset>LONG_MAX) { - *errnoPtr = EOVERFLOW; - return TCL_INDEX_NONE; - } - - return Tcl_ChannelSeekProc(chanPtr->typePtr)(chanPtr->instanceData, - offset, mode, errnoPtr); -#else *errnoPtr = EINVAL; return TCL_INDEX_NONE; -#endif } return Tcl_ChannelWideSeekProc(chanPtr->typePtr)(chanPtr->instanceData, @@ -666,14 +652,14 @@ TclFinalizeIOSubsystem(void) statePtr->refCount--; } - if (statePtr->refCount <= 0) { + if (statePtr->refCount + 1 <= 1) { /* * Close it only if the refcount indicates that the channel is * not referenced from any interpreter. If it is, that * interpreter will close the channel when it gets destroyed. */ - (void) Tcl_Close(NULL, (Tcl_Channel) chanPtr); + (void) Tcl_CloseEx(NULL, (Tcl_Channel) chanPtr, 0); } else { /* * The refcount is greater than zero, so flush the channel. @@ -853,7 +839,7 @@ Tcl_CreateCloseHandler( ChannelState *statePtr = ((Channel *) chan)->state; CloseCallback *cbPtr; - cbPtr = (CloseCallback *)ckalloc(sizeof(CloseCallback)); + cbPtr = (CloseCallback *)Tcl_Alloc(sizeof(CloseCallback)); cbPtr->proc = proc; cbPtr->clientData = clientData; @@ -899,7 +885,7 @@ Tcl_DeleteCloseHandler( } else { cbPrevPtr->nextPtr = cbPtr->nextPtr; } - ckfree(cbPtr); + Tcl_Free(cbPtr); break; } cbPrevPtr = cbPtr; @@ -934,7 +920,7 @@ GetChannelTable( hTblPtr = (Tcl_HashTable *)Tcl_GetAssocData(interp, "tclIO", NULL); if (hTblPtr == NULL) { - hTblPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable)); + hTblPtr = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(hTblPtr, TCL_STRING_KEYS); Tcl_SetAssocData(interp, "tclIO", (Tcl_InterpDeleteProc *) DeleteChannelTable, hTblPtr); @@ -1026,7 +1012,7 @@ DeleteChannelTable( TclChannelEventScriptInvoker, sPtr); TclDecrRefCount(sPtr->scriptPtr); - ckfree(sPtr); + Tcl_Free(sPtr); } else { prevPtr = sPtr; } @@ -1043,13 +1029,13 @@ DeleteChannelTable( statePtr->epoch++; if (statePtr->refCount-- <= 1) { if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) { - (void) Tcl_Close(interp, (Tcl_Channel) chanPtr); + (void) Tcl_CloseEx(interp, (Tcl_Channel) chanPtr, 0); } } } Tcl_DeleteHashTable(hTblPtr); - ckfree(hTblPtr); + Tcl_Free(hTblPtr); } /* @@ -1084,7 +1070,7 @@ CheckForStdChannelsBeingClosed( if (tsdPtr->stdinInitialized == 1 && tsdPtr->stdinChannel != NULL && statePtr == ((Channel *)tsdPtr->stdinChannel)->state) { - if (statePtr->refCount < 2) { + if (statePtr->refCount + 1 < 3) { statePtr->refCount = 0; tsdPtr->stdinChannel = NULL; return; @@ -1092,7 +1078,7 @@ CheckForStdChannelsBeingClosed( } else if (tsdPtr->stdoutInitialized == 1 && tsdPtr->stdoutChannel != NULL && statePtr == ((Channel *)tsdPtr->stdoutChannel)->state) { - if (statePtr->refCount < 2) { + if (statePtr->refCount + 1 < 3) { statePtr->refCount = 0; tsdPtr->stdoutChannel = NULL; return; @@ -1100,7 +1086,7 @@ CheckForStdChannelsBeingClosed( } else if (tsdPtr->stderrInitialized == 1 && tsdPtr->stderrChannel != NULL && statePtr == ((Channel *)tsdPtr->stderrChannel)->state) { - if (statePtr->refCount < 2) { + if (statePtr->refCount + 1 < 3) { statePtr->refCount = 0; tsdPtr->stderrChannel = NULL; return; @@ -1262,15 +1248,15 @@ Tcl_UnregisterChannel( * If the refCount reached zero, close the actual channel. */ - if (statePtr->refCount <= 0) { + if (statePtr->refCount + 1 <= 1) { Tcl_Preserve(statePtr); if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) { /* - * We don't want to re-enter Tcl_Close(). + * We don't want to re-enter Tcl_CloseEx(). */ if (!GotFlag(statePtr, CHANNEL_CLOSED)) { - if (Tcl_Close(interp, chan) != TCL_OK) { + if (Tcl_CloseEx(interp, chan, 0) != TCL_OK) { SetFlag(statePtr, CHANNEL_CLOSED); Tcl_Release(statePtr); return TCL_ERROR; @@ -1556,15 +1542,15 @@ TclGetChannelFromObj( * Re-use the ResolvedCmdName struct. */ - Tcl_Release((void *) resPtr->statePtr); + Tcl_Release(resPtr->statePtr); } else { - resPtr = (ResolvedChanName *) ckalloc(sizeof(ResolvedChanName)); + resPtr = (ResolvedChanName *) Tcl_Alloc(sizeof(ResolvedChanName)); resPtr->refCount = 0; ChanSetInternalRep(objPtr, resPtr); /* Overwrites, if needed */ } statePtr = ((Channel *)chan)->state; resPtr->statePtr = statePtr; - Tcl_Preserve((void *) statePtr); + Tcl_Preserve(statePtr); resPtr->interp = interp; resPtr->epoch = statePtr->epoch; @@ -1621,18 +1607,12 @@ Tcl_CreateChannel( assert(sizeof(Tcl_ChannelTypeVersion) == sizeof(Tcl_DriverBlockModeProc *)); assert(typePtr->typeName != NULL); -#ifndef TCL_NO_DEPRECATED - if (((NULL == typePtr->closeProc) || (TCL_CLOSE2PROC == typePtr->closeProc)) && (typePtr->close2Proc == NULL)) { - Tcl_Panic("channel type %s must define closeProc or close2Proc", typePtr->typeName); - } -#else - if (Tcl_ChannelVersion(typePtr) < TCL_CHANNEL_VERSION_5) { + if (Tcl_ChannelVersion(typePtr) != TCL_CHANNEL_VERSION_5) { Tcl_Panic("channel type %s must be version TCL_CHANNEL_VERSION_5", typePtr->typeName); } if (typePtr->close2Proc == NULL) { Tcl_Panic("channel type %s must define close2Proc", typePtr->typeName); } -#endif if ((TCL_READABLE & mask) && (NULL == typePtr->inputProc)) { Tcl_Panic("channel type %s must define inputProc when used for reader channel", typePtr->typeName); } @@ -1642,19 +1622,14 @@ Tcl_CreateChannel( if (NULL == typePtr->watchProc) { Tcl_Panic("channel type %s must define watchProc", typePtr->typeName); } -#ifndef TCL_NO_DEPRECATED - if ((NULL != typePtr->wideSeekProc) && (NULL == typePtr->seekProc)) { - Tcl_Panic("channel type %s must define seekProc if defining wideSeekProc", typePtr->typeName); - } -#endif /* * JH: We could subsequently memset these to 0 to avoid the numerous * assignments to 0/NULL below. */ - chanPtr = (Channel *)ckalloc(sizeof(Channel)); - statePtr = (ChannelState *)ckalloc(sizeof(ChannelState)); + chanPtr = (Channel *)Tcl_Alloc(sizeof(Channel)); + statePtr = (ChannelState *)Tcl_Alloc(sizeof(ChannelState)); chanPtr->state = statePtr; chanPtr->instanceData = instanceData; @@ -1673,10 +1648,10 @@ Tcl_CreateChannel( * later. */ - tmp = (char *)ckalloc((len < 7) ? 7 : len); + tmp = (char *)Tcl_Alloc((len < 7) ? 7 : len); strcpy(tmp, chanName); } else { - tmp = (char *)ckalloc(7); + tmp = (char *)Tcl_Alloc(7); tmp[0] = '\0'; } statePtr->channelName = tmp; @@ -1714,7 +1689,6 @@ Tcl_CreateChannel( statePtr->inputTranslation = TCL_TRANSLATE_AUTO; statePtr->outputTranslation = TCL_PLATFORM_TRANSLATION; statePtr->inEofChar = 0; - statePtr->outEofChar = 0; statePtr->unreportedError = 0; statePtr->refCount = 0; @@ -1950,7 +1924,7 @@ Tcl_StackChannel( statePtr->inQueueTail = NULL; } - chanPtr = (Channel *)ckalloc(sizeof(Channel)); + chanPtr = (Channel *)Tcl_Alloc(sizeof(Channel)); /* * Save some of the current state into the new structure, reinitialize the @@ -2012,7 +1986,7 @@ TclChannelRelease( return; } if (chanPtr->typePtr == NULL) { - ckfree(chanPtr); + Tcl_Free(chanPtr); } } @@ -2020,8 +1994,8 @@ static void ChannelFree( Channel *chanPtr) { - if (chanPtr->refCount == 0) { - ckfree(chanPtr); + if (!chanPtr->refCount) { + Tcl_Free(chanPtr); return; } chanPtr->typePtr = NULL; @@ -2195,8 +2169,8 @@ Tcl_UnstackChannel( * necessary. */ - if (statePtr->refCount <= 0) { - if (Tcl_Close(interp, chan) != TCL_OK) { + if (statePtr->refCount + 1 <= 1) { + if (Tcl_CloseEx(interp, chan, 0) != TCL_OK) { /* * TIP #219, Tcl Channel Reflection API. * "TclChanCaughtErrorBypass" is not required here, it was @@ -2524,13 +2498,13 @@ Tcl_RemoveChannelMode( static ChannelBuffer * AllocChannelBuffer( - int length) /* Desired length of channel buffer. */ + size_t length) /* Desired length of channel buffer. */ { ChannelBuffer *bufPtr; - int n; + size_t n; n = length + CHANNELBUFFER_HEADER_SIZE + BUFFER_PADDING + BUFFER_PADDING; - bufPtr = (ChannelBuffer *)ckalloc(n); + bufPtr = (ChannelBuffer *)Tcl_Alloc(n); bufPtr->nextAdded = BUFFER_PADDING; bufPtr->nextRemoved = BUFFER_PADDING; bufPtr->bufLength = length + BUFFER_PADDING; @@ -2556,14 +2530,14 @@ ReleaseChannelBuffer( if (--bufPtr->refCount) { return; } - ckfree(bufPtr); + Tcl_Free(bufPtr); } static int IsShared( ChannelBuffer *bufPtr) { - return bufPtr->refCount > 1; + return bufPtr->refCount + 1 > 2; } /* @@ -3012,7 +2986,7 @@ FlushChannel( * current output buffer. */ - if (GotFlag(statePtr, CHANNEL_CLOSED) && (statePtr->refCount <= 0) && + if (GotFlag(statePtr, CHANNEL_CLOSED) && (statePtr->refCount + 1 <= 1) && (statePtr->outQueueHead == NULL) && ((statePtr->curOutPtr == NULL) || IsBufferEmpty(statePtr->curOutPtr))) { @@ -3103,18 +3077,6 @@ CloseChannel( } /* - * If the EOF character is set in the channel, append that to the output - * device. - */ - - if ((statePtr->outEofChar != 0) && GotFlag(statePtr, TCL_WRITABLE)) { - int dummy; - char c = (char) statePtr->outEofChar; - - (void) ChanWrite(chanPtr, &c, 1, &dummy); - } - - /* * TIP #219, Tcl Channel Reflection API. * Move a leftover error message in the channel bypass into the * interpreter bypass. Just clear it if there is no interpreter. @@ -3148,7 +3110,7 @@ CloseChannel( if (chanPtr == statePtr->bottomChanPtr) { if (statePtr->channelName != NULL) { - ckfree(statePtr->channelName); + Tcl_Free(statePtr->channelName); statePtr->channelName = NULL; } @@ -3205,7 +3167,7 @@ CloseChannel( ChannelFree(chanPtr); - return Tcl_Close(interp, (Tcl_Channel) downChanPtr); + return Tcl_CloseEx(interp, (Tcl_Channel) downChanPtr, 0); } /* @@ -3449,7 +3411,7 @@ Tcl_SpliceChannel( */ int -Tcl_Close( +TclClose( Tcl_Interp *interp, /* Interpreter for errors. */ Tcl_Channel chan) /* The channel being closed. Must not be * referenced in any interpreter. May be NULL, @@ -3485,7 +3447,7 @@ Tcl_Close( statePtr = chanPtr->state; chanPtr = statePtr->topChanPtr; - if (statePtr->refCount > 0) { + if (statePtr->refCount + 1 > 1) { Tcl_Panic("called Tcl_Close on channel with refCount > 0"); } @@ -3550,7 +3512,7 @@ Tcl_Close( cbPtr = statePtr->closeCbPtr; statePtr->closeCbPtr = cbPtr->nextPtr; cbPtr->proc(cbPtr->clientData); - ckfree(cbPtr); + Tcl_Free(cbPtr); } ResetFlag(statePtr, CHANNEL_INCLOSE); @@ -3560,20 +3522,10 @@ Tcl_Close( * it anymore and this will help avoid deadlocks on some channel types. */ -#ifndef TCL_NO_DEPRECATED - if ((chanPtr->typePtr->closeProc == TCL_CLOSE2PROC) || (chanPtr->typePtr->closeProc == NULL)) { - /* If this half-close gives a EINVAL or ENOTCONN, just continue the full close */ - result = chanPtr->typePtr->close2Proc(chanPtr->instanceData, interp, TCL_CLOSE_READ); - if ((result == EINVAL) || result == ENOTCONN) { - result = 0; - } - } -#else result = chanPtr->typePtr->close2Proc(chanPtr->instanceData, interp, TCL_CLOSE_READ); if ((result == EINVAL) || result == ENOTCONN) { result = 0; } -#endif /* * The call to FlushChannel will flush any queued output and invoke the @@ -3621,7 +3573,7 @@ Tcl_Close( result = flushcode; } if ((result != 0) && (result != TCL_ERROR) && (interp != NULL) - && 0 == TclGetCharLength(Tcl_GetObjResult(interp))) { + && 0 == Tcl_GetCharLength(Tcl_GetObjResult(interp))) { Tcl_SetErrno(result); Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_PosixError(interp), TCL_INDEX_NONE)); @@ -3670,7 +3622,7 @@ Tcl_CloseEx( statePtr = chanPtr->state; if ((flags & (TCL_READABLE | TCL_WRITABLE)) == 0) { - return Tcl_Close(interp, chan); + return TclClose(interp, chan); } if ((flags & (TCL_READABLE | TCL_WRITABLE)) == (TCL_READABLE | TCL_WRITABLE)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( @@ -3889,18 +3841,6 @@ CloseChannelPart( } /* - * If the EOF character is set in the channel, append that to the - * output device. - */ - - if ((statePtr->outEofChar != 0) && GotFlag(statePtr, TCL_WRITABLE)) { - int dummy; - char c = (char) statePtr->outEofChar; - - (void) ChanWrite(chanPtr, &c, 1, &dummy); - } - - /* * TIP #219, Tcl Channel Reflection API. * Move a leftover error message in the channel bypass into the * interpreter bypass. Just clear it if there is no interpreter. @@ -4037,7 +3977,7 @@ Tcl_ClearChannelHandlers( for (chPtr = statePtr->chPtr; chPtr != NULL; chPtr = chNext) { chNext = chPtr->nextPtr; - ckfree(chPtr); + Tcl_Free(chPtr); } statePtr->chPtr = NULL; @@ -4064,7 +4004,7 @@ Tcl_ClearChannelHandlers( for (ePtr = statePtr->scriptRecordPtr; ePtr != NULL; ePtr = eNextPtr) { eNextPtr = ePtr->nextPtr; TclDecrRefCount(ePtr->scriptPtr); - ckfree(ePtr); + Tcl_Free(ePtr); } statePtr->scriptRecordPtr = NULL; } @@ -4093,11 +4033,11 @@ Tcl_ClearChannelHandlers( *---------------------------------------------------------------------- */ -int +size_t Tcl_Write( Tcl_Channel chan, /* The channel to buffer output for. */ const char *src, /* Data to queue in output buffer. */ - int srcLen) /* Length of data in bytes, or < 0 for + size_t srcLen) /* Length of data in bytes, or -1 for * strlen(). */ { /* @@ -4114,10 +4054,10 @@ Tcl_Write( return TCL_INDEX_NONE; } - if (srcLen < 0) { + if (srcLen == TCL_INDEX_NONE) { srcLen = strlen(src); } - if (WriteBytes(chanPtr, src, srcLen) < 0) { + if (WriteBytes(chanPtr, src, srcLen) == -1) { return TCL_INDEX_NONE; } return srcLen; @@ -4147,23 +4087,24 @@ Tcl_Write( *---------------------------------------------------------------------- */ -int +size_t Tcl_WriteRaw( Tcl_Channel chan, /* The channel to buffer output for. */ const char *src, /* Data to queue in output buffer. */ - int srcLen) /* Length of data in bytes, or < 0 for + size_t srcLen) /* Length of data in bytes, or -1 for * strlen(). */ { Channel *chanPtr = ((Channel *) chan); ChannelState *statePtr = chanPtr->state; /* State info for channel */ - int errorCode, written; + int errorCode; + size_t written; if (CheckChannelErrors(statePtr, TCL_WRITABLE | CHANNEL_RAW_MODE) != 0) { return TCL_INDEX_NONE; } - if (srcLen < 0) { + if (srcLen == TCL_INDEX_NONE) { srcLen = strlen(src); } @@ -4173,7 +4114,7 @@ Tcl_WriteRaw( */ written = ChanWrite(chanPtr, src, srcLen, &errorCode); - if (written < 0) { + if (written == TCL_INDEX_NONE) { Tcl_SetErrno(errorCode); } @@ -4203,17 +4144,17 @@ Tcl_WriteRaw( *---------------------------------------------------------------------- */ -int +size_t Tcl_WriteChars( Tcl_Channel chan, /* The channel to buffer output for. */ const char *src, /* UTF-8 characters to queue in output * buffer. */ - int len) /* Length of string in bytes, or TCL_INDEX_NONE for + size_t len) /* Length of string in bytes, or TCL_INDEX_NONE for * strlen(). */ { Channel *chanPtr = (Channel *) chan; ChannelState *statePtr = chanPtr->state; /* State info for channel */ - int result; + size_t result; Tcl_Obj *objPtr; if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) { @@ -4222,7 +4163,7 @@ Tcl_WriteChars( chanPtr = statePtr->topChanPtr; - if (len < 0) { + if (len == TCL_INDEX_NONE) { len = strlen(src); } if (statePtr->encoding) { @@ -4241,8 +4182,14 @@ Tcl_WriteChars( } objPtr = Tcl_NewStringObj(src, len); + Tcl_IncrRefCount(objPtr); src = (char *) Tcl_GetByteArrayFromObj(objPtr, &len); - result = WriteBytes(chanPtr, src, len); + if (src == NULL) { + Tcl_SetErrno(EILSEQ); + result = TCL_INDEX_NONE; + } else { + result = WriteBytes(chanPtr, src, len); + } TclDecrRefCount(objPtr); return result; } @@ -4272,7 +4219,7 @@ Tcl_WriteChars( *---------------------------------------------------------------------- */ -int +size_t Tcl_WriteObj( Tcl_Channel chan, /* The channel to buffer output for. */ Tcl_Obj *objPtr) /* The object to write. */ @@ -4284,7 +4231,7 @@ Tcl_WriteObj( Channel *chanPtr; ChannelState *statePtr; /* State info for channel */ const char *src; - int srcLen; + size_t srcLen = 0; statePtr = ((Channel *) chan)->state; chanPtr = statePtr->topChanPtr; @@ -4293,10 +4240,18 @@ Tcl_WriteObj( return TCL_INDEX_NONE; } if (statePtr->encoding == NULL) { + size_t result; + src = (char *) Tcl_GetByteArrayFromObj(objPtr, &srcLen); - return WriteBytes(chanPtr, src, srcLen); + if (src == NULL) { + Tcl_SetErrno(EILSEQ); + result = TCL_INDEX_NONE; + } else { + result = WriteBytes(chanPtr, src, srcLen); + } + return result; } else { - src = TclGetStringFromObj(objPtr, &srcLen); + src = Tcl_GetStringFromObj(objPtr, &srcLen); return WriteChars(chanPtr, src, srcLen); } } @@ -4308,9 +4263,6 @@ WillWrite( int inputBuffered; if (((Tcl_ChannelWideSeekProc(chanPtr->typePtr) != NULL) -#ifndef TCL_NO_DEPRECATED - || (Tcl_ChannelSeekProc(chanPtr->typePtr) != NULL) -#endif ) && ((inputBuffered = Tcl_InputBuffered((Tcl_Channel) chanPtr)) > 0)){ int ignore; @@ -4330,12 +4282,9 @@ WillRead( DiscardInputQueued(chanPtr->state, 0); Tcl_SetErrno(EINVAL); - return TCL_INDEX_NONE; + return -1; } if (((Tcl_ChannelWideSeekProc(chanPtr->typePtr) != NULL) -#ifndef TCL_NO_DEPRECATED - || (Tcl_ChannelSeekProc(chanPtr->typePtr) != NULL) -#endif ) && (Tcl_OutputBuffered((Tcl_Channel) chanPtr) > 0)) { /* * CAVEAT - The assumption here is that FlushChannel() will push out @@ -4348,7 +4297,7 @@ WillRead( */ if (FlushChannel(NULL, chanPtr, 0) != 0) { - return TCL_INDEX_NONE; + return -1; } } return 0; @@ -4397,13 +4346,13 @@ Write( * Transfer encoding nocomplain/strict option to the encoding flags */ + if (GotFlag(statePtr, CHANNEL_ENCODING_NOCOMPLAIN)) { + statePtr->outputEncodingFlags |= TCL_ENCODING_NOCOMPLAIN; + } else { + statePtr->outputEncodingFlags &= ~TCL_ENCODING_NOCOMPLAIN; + } if (GotFlag(statePtr, CHANNEL_ENCODING_STRICT)) { statePtr->outputEncodingFlags |= TCL_ENCODING_STRICT; -#ifdef TCL_NO_DEPRECATED - } else if (GotFlag(statePtr, CHANNEL_ENCODING_NOCOMPLAIN)) { - statePtr->outputEncodingFlags &= ~TCL_ENCODING_STRICT; - statePtr->outputEncodingFlags |= TCL_ENCODING_NOCOMPLAIN; -#endif } else { statePtr->outputEncodingFlags &= ~TCL_ENCODING_STRICT; } @@ -4535,7 +4484,7 @@ Write( * beginning of the next buffer. */ - saved = -SpaceLeft(bufPtr); + saved = 1 + ~SpaceLeft(bufPtr); memcpy(safe, dst + dstLen, saved); bufPtr->nextAdded = bufPtr->bufLength; } @@ -4546,7 +4495,7 @@ Write( if (IsBufferFull(bufPtr)) { if (FlushChannel(NULL, chanPtr, 0) != 0) { - return TCL_INDEX_NONE; + return -1; } flushed += statePtr->bufSize; @@ -4569,7 +4518,7 @@ Write( if (((flushed < total) && GotFlag(statePtr, CHANNEL_UNBUFFERED)) || (needNlFlush && GotFlag(statePtr, CHANNEL_LINEBUFFERED))) { if (FlushChannel(NULL, chanPtr, 0) != 0) { - return TCL_INDEX_NONE; + return -1; } } @@ -4577,7 +4526,7 @@ Write( if (encodingError) { Tcl_SetErrno(EILSEQ); - return TCL_INDEX_NONE; + return -1; } return total; } @@ -4601,7 +4550,7 @@ Write( *--------------------------------------------------------------------------- */ -int +size_t Tcl_Gets( Tcl_Channel chan, /* Channel from which to read. */ Tcl_DString *lineRead) /* The line read will be appended to this @@ -4610,11 +4559,11 @@ Tcl_Gets( * for managing the storage. */ { Tcl_Obj *objPtr; - int charsStored; + size_t charsStored; TclNewObj(objPtr); charsStored = Tcl_GetsObj(chan, objPtr); - if (charsStored > 0) { + if (charsStored + 1 > 1) { TclDStringAppendObj(lineRead, objPtr); } TclDecrRefCount(objPtr); @@ -4644,7 +4593,7 @@ Tcl_Gets( *--------------------------------------------------------------------------- */ -int +size_t Tcl_GetsObj( Tcl_Channel chan, /* Channel from which to read. */ Tcl_Obj *objPtr) /* The line read will be appended to this @@ -4656,7 +4605,7 @@ Tcl_GetsObj( /* State info for channel */ ChannelBuffer *bufPtr; int inEofChar, skip, copiedTotal, oldFlags, oldRemoved; - int oldLength; + size_t oldLength; Tcl_Encoding encoding; char *dst, *dstEnd, *eol, *eof; Tcl_EncodingState oldState; @@ -4694,7 +4643,8 @@ Tcl_GetsObj( if ((statePtr->encoding == NULL) && ((statePtr->inputTranslation == TCL_TRANSLATE_LF) - || (statePtr->inputTranslation == TCL_TRANSLATE_CR))) { + || (statePtr->inputTranslation == TCL_TRANSLATE_CR)) + && Tcl_GetByteArrayFromObj(objPtr, (size_t *)NULL) != NULL) { return TclGetsObjBinary(chan, objPtr); } @@ -4713,7 +4663,7 @@ Tcl_GetsObj( * newline in the available input. */ - TclGetStringFromObj(objPtr, &oldLength); + (void)Tcl_GetStringFromObj(objPtr, &oldLength); oldFlags = statePtr->inputEncodingFlags; oldState = statePtr->inputEncodingState; oldRemoved = BUFFER_PADDING; @@ -4734,13 +4684,13 @@ Tcl_GetsObj( * Transfer encoding nocomplain/strict option to the encoding flags */ + if (GotFlag(statePtr, CHANNEL_ENCODING_NOCOMPLAIN)) { + statePtr->inputEncodingFlags |= TCL_ENCODING_NOCOMPLAIN; + } else { + statePtr->inputEncodingFlags &= ~TCL_ENCODING_NOCOMPLAIN; + } if (GotFlag(statePtr, CHANNEL_ENCODING_STRICT)) { statePtr->inputEncodingFlags |= TCL_ENCODING_STRICT; -#ifdef TCL_NO_DEPRECATED - } else if (GotFlag(statePtr, CHANNEL_ENCODING_NOCOMPLAIN)) { - statePtr->inputEncodingFlags &= ~TCL_ENCODING_STRICT; - statePtr->inputEncodingFlags |= TCL_ENCODING_NOCOMPLAIN; -#endif } else { statePtr->inputEncodingFlags &= ~TCL_ENCODING_STRICT; } @@ -4825,7 +4775,7 @@ Tcl_GetsObj( */ if (eol >= dstEnd) { - int offset; + size_t offset; if (eol != eof) { offset = eol - objPtr->bytes; @@ -5095,7 +5045,7 @@ TclGetsObjBinary( /* State info for channel */ ChannelBuffer *bufPtr; int inEofChar, skip, copiedTotal, oldFlags, oldRemoved; - int rawLen, byteLen, oldLength; + size_t rawLen, byteLen = 0, oldLength; int eolChar; unsigned char *dst, *dstEnd, *eol, *eof, *byteArray; @@ -5114,6 +5064,10 @@ TclGetsObjBinary( */ byteArray = Tcl_GetByteArrayFromObj(objPtr, &byteLen); + if (byteArray == NULL) { + Tcl_SetErrno(EILSEQ); + return -1; + } oldFlags = statePtr->inputEncodingFlags; oldRemoved = BUFFER_PADDING; oldLength = byteLen; @@ -5225,7 +5179,7 @@ TclGetsObjBinary( byteArray = Tcl_SetByteArrayLength(objPtr, oldLength); CommonGetsCleanup(chanPtr); - copiedTotal = TCL_INDEX_NONE; + copiedTotal = -1; ResetFlag(statePtr, CHANNEL_BLOCKED); goto done; } @@ -5314,7 +5268,7 @@ TclGetsObjBinary( */ SetFlag(statePtr, CHANNEL_NEED_MORE_DATA); - copiedTotal = TCL_INDEX_NONE; + copiedTotal = -1; /* * Update the notifier state so we don't block while there is still data @@ -5359,7 +5313,7 @@ FreeBinaryEncoding( } static Tcl_Encoding -GetBinaryEncoding(void) +GetBinaryEncoding() { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -5508,13 +5462,13 @@ FilterInputBytes( * Transfer encoding nocomplain/strict option to the encoding flags */ + if (GotFlag(statePtr, CHANNEL_ENCODING_NOCOMPLAIN)) { + statePtr->inputEncodingFlags |= TCL_ENCODING_NOCOMPLAIN; + } else { + statePtr->inputEncodingFlags &= ~TCL_ENCODING_NOCOMPLAIN; + } if (GotFlag(statePtr, CHANNEL_ENCODING_STRICT)) { statePtr->inputEncodingFlags |= TCL_ENCODING_STRICT; -#ifdef TCL_NO_DEPRECATED - } else if (GotFlag(statePtr, CHANNEL_ENCODING_NOCOMPLAIN)) { - statePtr->inputEncodingFlags &= ~TCL_ENCODING_STRICT; - statePtr->inputEncodingFlags |= TCL_ENCODING_NOCOMPLAIN; -#endif } else { statePtr->inputEncodingFlags &= ~TCL_ENCODING_STRICT; } @@ -5577,7 +5531,7 @@ FilterInputBytes( } extra = rawLen - gsPtr->rawRead; memcpy(nextPtr->buf + (BUFFER_PADDING - extra), - raw + gsPtr->rawRead, (size_t) extra); + raw + gsPtr->rawRead, extra); nextPtr->nextRemoved -= extra; bufPtr->nextAdded -= extra; } @@ -5757,11 +5711,11 @@ CommonGetsCleanup( *---------------------------------------------------------------------- */ -int +size_t Tcl_Read( Tcl_Channel chan, /* The channel from which to read. */ char *dst, /* Where to store input read. */ - int bytesToRead) /* Maximum number of bytes to read. */ + size_t bytesToRead) /* Maximum number of bytes to read. */ { Channel *chanPtr = (Channel *) chan; ChannelState *statePtr = chanPtr->state; @@ -5802,11 +5756,11 @@ Tcl_Read( *---------------------------------------------------------------------- */ -int +size_t Tcl_ReadRaw( Tcl_Channel chan, /* The channel from which to read. */ char *readBuf, /* Where to store input read. */ - int bytesToRead) /* Maximum number of bytes to read. */ + size_t bytesToRead) /* Maximum number of bytes to read. */ { Channel *chanPtr = (Channel *) chan; ChannelState *statePtr = chanPtr->state; @@ -5825,8 +5779,8 @@ Tcl_ReadRaw( while (chanPtr->inQueueHead && bytesToRead > 0) { ChannelBuffer *bufPtr = chanPtr->inQueueHead; int bytesInBuffer = BytesLeft(bufPtr); - int toCopy = (bytesInBuffer < bytesToRead) ? bytesInBuffer - : bytesToRead; + int toCopy = (bytesInBuffer < (int)bytesToRead) ? bytesInBuffer + : (int)bytesToRead; /* * Copy the current chunk into the read buffer. @@ -5869,7 +5823,7 @@ Tcl_ReadRaw( if (bytesToRead > 0) { int nread = ChanRead(chanPtr, readBuf, bytesToRead); - if (nread < 0) { + if (nread == -1) { /* * An error signaled. If CHANNEL_BLOCKED, then the error is not * real, but an indication of blocked state. In that case, retain @@ -5881,12 +5835,12 @@ Tcl_ReadRaw( */ if (!GotFlag(statePtr, CHANNEL_BLOCKED) || copied == 0) { - copied = TCL_INDEX_NONE; + copied = -1; } } else if (nread > 0) { /* - * Successful read (short is OK) - add to bytes copied. - */ + * Successful read (short is OK) - add to bytes copied. + */ copied += nread; } else { @@ -5920,11 +5874,11 @@ Tcl_ReadRaw( *--------------------------------------------------------------------------- */ -int +size_t Tcl_ReadChars( Tcl_Channel chan, /* The channel to read. */ Tcl_Obj *objPtr, /* Input data is stored in this object. */ - int toRead, /* Maximum number of characters to store, or + size_t toRead, /* Maximum number of characters to store, or * TCL_INDEX_NONE to read all available data (up to EOF or * when channel blocks). */ int appendFlag) /* If non-zero, data read from the channel @@ -5980,7 +5934,7 @@ static int DoReadChars( Channel *chanPtr, /* The channel to read. */ Tcl_Obj *objPtr, /* Input data is stored in this object. */ - int toRead, /* Maximum number of characters to store, or + size_t toRead, /* Maximum number of characters to store, or * TCL_INDEX_NONE to read all available data (up to EOF or * when channel blocks). */ int appendFlag) /* If non-zero, data read from the channel @@ -6002,7 +5956,7 @@ DoReadChars( && (statePtr->inEofChar == '\0'); if (appendFlag) { - if (binaryMode && (NULL == TclGetBytesFromObj(NULL, objPtr, NULL))) { + if (binaryMode && (NULL == Tcl_GetByteArrayFromObj(objPtr, (size_t *)NULL))) { binaryMode = 0; } } else { @@ -6076,8 +6030,8 @@ DoReadChars( } ResetFlag(statePtr, CHANNEL_BLOCKED|CHANNEL_EOF); statePtr->inputEncodingFlags &= ~TCL_ENCODING_END; - for (copied = 0; (unsigned) toRead > 0; ) { - copiedNow = TCL_INDEX_NONE; + for (copied = 0; toRead > 0; ) { + copiedNow = -1; if (statePtr->inQueueHead != NULL) { if (binaryMode) { copiedNow = ReadBytes(statePtr, objPtr, toRead); @@ -6117,7 +6071,7 @@ DoReadChars( } if (result != 0) { if (!GotFlag(statePtr, CHANNEL_BLOCKED)) { - copied = TCL_INDEX_NONE; + copied = -1; } break; } @@ -6195,7 +6149,7 @@ ReadBytes( * been allocated to hold data, not how many * bytes of data have been stored in the * object. */ - int bytesToRead) /* Maximum number of bytes to store, or < 0 to + int bytesToRead) /* Maximum number of bytes to store, or -1 to * get all available bytes. Bytes are obtained * from the first buffer in the queue - even * if this number is larger than the number of @@ -6272,7 +6226,7 @@ ReadChars( int savedIEFlags = statePtr->inputEncodingFlags; int savedFlags = statePtr->flags; char *dst, *src = RemovePoint(bufPtr); - int numBytes; + size_t numBytes; int srcLen = BytesLeft(bufPtr); /* @@ -6293,10 +6247,10 @@ ReadChars( int factor = *factorPtr; int dstLimit = TCL_UTF_MAX - 1 + toRead * factor / UTF_EXPANSION_FACTOR; - (void) TclGetStringFromObj(objPtr, &numBytes); + (void) Tcl_GetStringFromObj(objPtr, &numBytes); Tcl_AppendToObj(objPtr, NULL, dstLimit); if (toRead == srcLen) { - unsigned int size; + size_t size; dst = TclGetStringStorage(objPtr, &size) + numBytes; dstLimit = size - numBytes; @@ -6308,13 +6262,13 @@ ReadChars( * Transfer encoding nocomplain/strict option to the encoding flags */ + if (GotFlag(statePtr, CHANNEL_ENCODING_NOCOMPLAIN)) { + statePtr->inputEncodingFlags |= TCL_ENCODING_NOCOMPLAIN; + } else { + statePtr->inputEncodingFlags &= ~TCL_ENCODING_NOCOMPLAIN; + } if (GotFlag(statePtr, CHANNEL_ENCODING_STRICT)) { statePtr->inputEncodingFlags |= TCL_ENCODING_STRICT; -#ifdef TCL_NO_DEPRECATED - } else if (GotFlag(statePtr, CHANNEL_ENCODING_NOCOMPLAIN)) { - statePtr->inputEncodingFlags &= ~TCL_ENCODING_STRICT; - statePtr->inputEncodingFlags |= TCL_ENCODING_NOCOMPLAIN; -#endif } else { statePtr->inputEncodingFlags &= ~TCL_ENCODING_STRICT; } @@ -6416,7 +6370,7 @@ ReadChars( */ Tcl_SetObjLength(objPtr, numBytes); - return TCL_INDEX_NONE; + return -1; } { @@ -6544,7 +6498,7 @@ ReadChars( * bytes demanded by the Tcl_ExternalToUtf() call! */ - dstLimit = TclUtfAtIndex(dst, charsToRead) - dst + (TCL_UTF_MAX - 1); + dstLimit = Tcl_UtfAtIndex(dst, charsToRead) - dst + (TCL_UTF_MAX - 1); statePtr->flags = savedFlags; statePtr->inputEncodingFlags = savedIEFlags; statePtr->inputEncodingState = savedState; @@ -6591,7 +6545,7 @@ ReadChars( SetFlag(statePtr, CHANNEL_NEED_MORE_DATA); } Tcl_SetObjLength(objPtr, numBytes); - return TCL_INDEX_NONE; + return -1; } /* @@ -6607,7 +6561,7 @@ ReadChars( * precautions. */ - if (nextPtr->nextRemoved - srcLen < 0) { + if (nextPtr->nextRemoved < (size_t)srcLen) { Tcl_Panic("Buffer Underflow, BUFFER_PADDING not enough"); } @@ -6830,11 +6784,11 @@ TranslateInputEOL( *---------------------------------------------------------------------- */ -int +size_t Tcl_Ungets( Tcl_Channel chan, /* The channel for which to add the input. */ const char *str, /* The input itself. */ - int len, /* The length of the input. */ + size_t len, /* The length of the input. */ int atEnd) /* If non-zero, add at end of queue; otherwise * add at head of queue. */ { @@ -7112,7 +7066,7 @@ GetInput( bufPtr->nextPtr = NULL; toRead = SpaceLeft(bufPtr); - assert(toRead == statePtr->bufSize); + assert((size_t)toRead == statePtr->bufSize); if (statePtr->inQueueTail == NULL) { statePtr->inQueueHead = bufPtr; @@ -7203,9 +7157,6 @@ Tcl_Seek( */ if ((Tcl_ChannelWideSeekProc(chanPtr->typePtr) == NULL) -#ifndef TCL_NO_DEPRECATED - && (Tcl_ChannelSeekProc(chanPtr->typePtr) == NULL) -#endif ) { Tcl_SetErrno(EINVAL); return -1; @@ -7371,9 +7322,6 @@ Tcl_Tell( */ if ((Tcl_ChannelWideSeekProc(chanPtr->typePtr) == NULL) -#ifndef TCL_NO_DEPRECATED - && (Tcl_ChannelSeekProc(chanPtr->typePtr) == NULL) -#endif ) { Tcl_SetErrno(EINVAL); return -1; @@ -7460,7 +7408,7 @@ Tcl_TruncateChannel( WillWrite(chanPtr); - if (WillRead(chanPtr) < 0) { + if (WillRead(chanPtr) == -1) { return TCL_ERROR; } @@ -7758,7 +7706,7 @@ Tcl_ChannelBuffered( void Tcl_SetChannelBufferSize( Tcl_Channel chan, /* The channel whose buffer size to set. */ - int sz) /* The size to set. */ + size_t sz) /* The size to set. */ { ChannelState *statePtr; /* State of real channel structure. */ @@ -7766,7 +7714,7 @@ Tcl_SetChannelBufferSize( * Clip the buffer size to force it into the [1,1M] range */ - if (sz < 1) { + if (sz < 1 || sz > (TCL_INDEX_NONE>>1)) { sz = 1; } else if (sz > MAX_CHANNEL_BUFFER_SIZE) { sz = MAX_CHANNEL_BUFFER_SIZE; @@ -7812,7 +7760,7 @@ Tcl_SetChannelBufferSize( *---------------------------------------------------------------------- */ -int +size_t Tcl_GetChannelBufferSize( Tcl_Channel chan) /* The channel for which to find the buffer * size. */ @@ -7864,7 +7812,7 @@ Tcl_BadChannelOption( const char *genericopt = "blocking buffering buffersize encoding eofchar translation"; const char **argv; - int argc, i; + size_t argc, i; Tcl_DString ds; Tcl_Obj *errObj; @@ -7888,7 +7836,7 @@ Tcl_BadChannelOption( Tcl_AppendPrintfToObj(errObj, "or -%s", argv[i]); Tcl_SetObjResult(interp, errObj); Tcl_DStringFree(&ds); - ckfree(argv); + Tcl_Free((void *)argv); } Tcl_SetErrno(EINVAL); return TCL_ERROR; @@ -8018,59 +7966,25 @@ Tcl_GetChannelOption( } } if (len == 0 || HaveOpt(2, "-eofchar")) { + char buf[4] = ""; if (len == 0) { Tcl_DStringAppendElement(dsPtr, "-eofchar"); } - if (((flags & (TCL_READABLE|TCL_WRITABLE)) == - (TCL_READABLE|TCL_WRITABLE)) && (len == 0)) { - Tcl_DStringStartSublist(dsPtr); - } - if (flags & TCL_READABLE) { - if (statePtr->inEofChar == 0) { - Tcl_DStringAppendElement(dsPtr, ""); - } else { - char buf[4]; - - sprintf(buf, "%c", statePtr->inEofChar); - Tcl_DStringAppendElement(dsPtr, buf); - } - } - if (flags & TCL_WRITABLE) { - if (statePtr->outEofChar == 0) { - Tcl_DStringAppendElement(dsPtr, ""); - } else { - char buf[4]; - - sprintf(buf, "%c", statePtr->outEofChar); - Tcl_DStringAppendElement(dsPtr, buf); - } - } - if (!(flags & (TCL_READABLE|TCL_WRITABLE))) { - /* - * Not readable or writable (e.g. server socket) - */ - - Tcl_DStringAppendElement(dsPtr, ""); - } - if (((flags & (TCL_READABLE|TCL_WRITABLE)) == - (TCL_READABLE|TCL_WRITABLE)) && (len == 0)) { - Tcl_DStringEndSublist(dsPtr); + if ((flags & TCL_READABLE) && (statePtr->inEofChar != 0)) { + sprintf(buf, "%c", statePtr->inEofChar); } if (len > 0) { + Tcl_DStringAppend(dsPtr, buf, TCL_INDEX_NONE); return TCL_OK; } + Tcl_DStringAppendElement(dsPtr, buf); } if (len == 0 || HaveOpt(1, "-nocomplainencoding")) { if (len == 0) { Tcl_DStringAppendElement(dsPtr, "-nocomplainencoding"); } -#ifdef TCL_NO_DEPRECATED Tcl_DStringAppendElement(dsPtr, (flags & CHANNEL_ENCODING_NOCOMPLAIN) ? "1" : "0"); -#else - Tcl_DStringAppendElement(dsPtr, - (flags & CHANNEL_ENCODING_STRICT) ? "0" : "1"); -#endif if (len > 0) { return TCL_OK; } @@ -8180,7 +8094,7 @@ Tcl_SetChannelOption( ChannelState *statePtr = chanPtr->state; /* State info for channel */ size_t len; /* Length of optionName string. */ - int argc; + size_t argc; const char **argv = NULL; /* @@ -8247,9 +8161,19 @@ Tcl_SetChannelOption( } return TCL_OK; } else if (HaveOpt(7, "-buffersize")) { - int newBufferSize; + Tcl_WideInt newBufferSize; + Tcl_Obj obj; + int code; + + obj.refCount = 1; + obj.bytes = (char *)newValue; + obj.length = strlen(newValue); + obj.typePtr = NULL; + + code = Tcl_GetWideIntFromObj(interp, &obj, &newBufferSize); + TclFreeInternalRep(&obj); - if (Tcl_GetInt(interp, newValue, &newBufferSize) == TCL_ERROR) { + if (code == TCL_ERROR) { return TCL_ERROR; } Tcl_SetChannelBufferSize(chan, newBufferSize); @@ -8287,46 +8211,25 @@ Tcl_SetChannelOption( UpdateInterest(chanPtr); return TCL_OK; } else if (HaveOpt(2, "-eofchar")) { - if (!newValue[0] || (!(newValue[0] & 0x80) && !newValue[1])) { + if (!newValue[0] || (!(newValue[0] & 0x80) && (!newValue[1] +#ifndef TCL_NO_DEPRECATED + || !strcmp(newValue+1, " {}") +#endif + ))) { if (GotFlag(statePtr, TCL_READABLE)) { statePtr->inEofChar = newValue[0]; } - statePtr->outEofChar = 0; - } else if (Tcl_SplitList(interp, newValue, &argc, &argv) == TCL_ERROR) { - return TCL_ERROR; - } else if (argc == 0) { - statePtr->inEofChar = 0; - statePtr->outEofChar = 0; - } else if (argc == 1 || argc == 2) { - int inValue = (int) argv[0][0]; - int outValue = (argc == 2) ? (int) argv[1][0] : 0; - - if (inValue & 0x80 || outValue & 0x80) { - if (interp) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "bad value for -eofchar: must be non-NUL ASCII" - " character", TCL_INDEX_NONE)); - } - ckfree(argv); - return TCL_ERROR; - } - if (GotFlag(statePtr, TCL_READABLE)) { - statePtr->inEofChar = inValue; - } - if (GotFlag(statePtr, TCL_WRITABLE)) { - statePtr->outEofChar = outValue; - } } else { if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "bad value for -eofchar: should be a list of zero," - " one, or two elements", TCL_INDEX_NONE)); + "bad value for -eofchar: must be non-NUL ASCII" + " character", TCL_INDEX_NONE)); } - ckfree(argv); + Tcl_Free((void *)argv); return TCL_ERROR; } if (argv != NULL) { - ckfree(argv); + Tcl_Free((void *)argv); } /* @@ -8351,18 +8254,7 @@ Tcl_SetChannelOption( ResetFlag(statePtr, CHANNEL_ENCODING_STRICT); SetFlag(statePtr, CHANNEL_ENCODING_NOCOMPLAIN); } else { -#ifdef TCL_NO_DEPRECATED ResetFlag(statePtr, CHANNEL_ENCODING_NOCOMPLAIN); -#else - if (SetFlag(statePtr, CHANNEL_ENCODING_STRICT)) { - if (interp) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "bad value for -nocomplainencoding: only true allowed", - TCL_INDEX_NONE)); - } - return TCL_ERROR; - } -#endif } return TCL_OK; } else if (HaveOpt(1, "-strictencoding")) { @@ -8397,7 +8289,7 @@ Tcl_SetChannelOption( "bad value for -translation: must be a one or two" " element list", TCL_INDEX_NONE)); } - ckfree(argv); + Tcl_Free((void *)argv); return TCL_ERROR; } @@ -8427,7 +8319,7 @@ Tcl_SetChannelOption( "bad value for -translation: must be one of " "auto, binary, cr, lf, crlf, or platform", TCL_INDEX_NONE)); } - ckfree(argv); + Tcl_Free((void *)argv); return TCL_ERROR; } @@ -8459,7 +8351,6 @@ Tcl_SetChannelOption( statePtr->outputTranslation = TCL_PLATFORM_TRANSLATION; } } else if (strcmp(writeMode, "binary") == 0) { - statePtr->outEofChar = 0; statePtr->outputTranslation = TCL_TRANSLATE_LF; Tcl_FreeEncoding(statePtr->encoding); statePtr->encoding = NULL; @@ -8477,11 +8368,11 @@ Tcl_SetChannelOption( "bad value for -translation: must be one of " "auto, binary, cr, lf, crlf, or platform", TCL_INDEX_NONE)); } - ckfree(argv); + Tcl_Free((void *)argv); return TCL_ERROR; } } - ckfree(argv); + Tcl_Free((void *)argv); return TCL_OK; } else if (chanPtr->typePtr->setOptionProc != NULL) { return chanPtr->typePtr->setOptionProc(chanPtr->instanceData, interp, @@ -8540,7 +8431,7 @@ CleanupChannelHandlers( TclChannelEventScriptInvoker, sPtr); TclDecrRefCount(sPtr->scriptPtr); - ckfree(sPtr); + Tcl_Free(sPtr); } else { prevPtr = sPtr; } @@ -8933,7 +8824,7 @@ Tcl_CreateChannelHandler( } } if (chPtr == NULL) { - chPtr = (ChannelHandler *)ckalloc(sizeof(ChannelHandler)); + chPtr = (ChannelHandler *)Tcl_Alloc(sizeof(ChannelHandler)); chPtr->mask = 0; chPtr->proc = proc; chPtr->clientData = clientData; @@ -9037,7 +8928,7 @@ Tcl_DeleteChannelHandler( } else { prevChPtr->nextPtr = chPtr->nextPtr; } - ckfree(chPtr); + Tcl_Free(chPtr); /* * Recompute the interest list for the channel, so that infinite loops @@ -9096,7 +8987,7 @@ DeleteScriptRecord( TclChannelEventScriptInvoker, esPtr); TclDecrRefCount(esPtr->scriptPtr); - ckfree(esPtr); + Tcl_Free(esPtr); break; } @@ -9145,7 +9036,7 @@ CreateScriptRecord( makeCH = (esPtr == NULL); if (makeCH) { - esPtr = (EventScriptRecord *)ckalloc(sizeof(EventScriptRecord)); + esPtr = (EventScriptRecord *)Tcl_Alloc(sizeof(EventScriptRecord)); } /* @@ -9382,20 +9273,6 @@ ZeroTransferTimerProc( *---------------------------------------------------------------------- */ -#if !defined(TCL_NO_DEPRECATED) -int -TclCopyChannelOld( - Tcl_Interp *interp, /* Current interpreter. */ - Tcl_Channel inChan, /* Channel to read from. */ - Tcl_Channel outChan, /* Channel to write to. */ - int toRead, /* Amount of data to copy, or -1 for all. */ - Tcl_Obj *cmdPtr) /* Pointer to script to execute or NULL. */ -{ - return TclCopyChannel(interp, inChan, outChan, (Tcl_WideInt) toRead, - cmdPtr); -} -#endif - int TclCopyChannel( Tcl_Interp *interp, /* Current interpreter. */ @@ -9478,7 +9355,7 @@ TclCopyChannel( * completed. */ - csPtr = (CopyState *)ckalloc(offsetof(CopyState, buffer) + 1U + !moveBytes * inStatePtr->bufSize); + csPtr = (CopyState *)Tcl_Alloc(offsetof(CopyState, buffer) + 1U + !moveBytes * inStatePtr->bufSize); csPtr->bufSize = !moveBytes * inStatePtr->bufSize; csPtr->readPtr = inPtr; csPtr->writePtr = outPtr; @@ -9773,7 +9650,7 @@ CopyData( Tcl_Channel inChan, outChan; ChannelState *inStatePtr, *outStatePtr; int result = TCL_OK, size; - int sizeb; + size_t sizeb; Tcl_WideInt total; const char *buffer; int inBinary, outBinary, sameEncoding; @@ -9839,7 +9716,7 @@ CopyData( || (csPtr->toRead > (Tcl_WideInt) csPtr->bufSize)) { sizeb = csPtr->bufSize; } else { - sizeb = (int) csPtr->toRead; + sizeb = csPtr->toRead; } if (inBinary || sameEncoding) { @@ -9849,7 +9726,7 @@ CopyData( size = DoReadChars(inStatePtr->topChanPtr, bufObj, sizeb, 0 /* No append */); } - underflow = (size >= 0) && (size < sizeb); /* Input underflow */ + underflow = (size >= 0) && ((size_t)size < sizeb); /* Input underflow */ } if (size < 0) { @@ -9912,7 +9789,7 @@ CopyData( buffer = csPtr->buffer; sizeb = size; } else { - buffer = TclGetStringFromObj(bufObj, &sizeb); + buffer = Tcl_GetStringFromObj(bufObj, &sizeb); } if (outBinary || sameEncoding) { @@ -9933,7 +9810,7 @@ CopyData( * unsuitable for updating totals and toRead. */ - if (sizeb < 0) { + if (sizeb == TCL_INDEX_NONE) { writeError: if (interp) { TclNewObj(errObj); @@ -10101,14 +9978,12 @@ static int DoRead( Channel *chanPtr, /* The channel from which to read. */ char *dst, /* Where to store input read. */ - int bytesToRead, /* Maximum number of bytes to read. */ + size_t bytesToRead, /* Maximum number of bytes to read. */ int allowShortReads) /* Allow half-blocking (pipes,sockets) */ { ChannelState *statePtr = chanPtr->state; char *p = dst; - assert(bytesToRead >= 0); - /* * Early out when we know a read will get the eofchar. * @@ -10167,7 +10042,7 @@ DoRead( while (!bufPtr || /* We got no buffer! OR */ (!IsBufferFull(bufPtr) && /* Our buffer has room AND */ - (BytesLeft(bufPtr) < bytesToRead))) { + ((size_t)BytesLeft(bufPtr) < bytesToRead))) { /* Not enough bytes in it yet * to fill the dst */ int code; @@ -10193,7 +10068,7 @@ DoRead( UpdateInterest(chanPtr); TclChannelRelease((Tcl_Channel)chanPtr); - return TCL_INDEX_NONE; + return -1; } assert(IsBufferFull(bufPtr)); @@ -10412,7 +10287,7 @@ StopCopy( } inStatePtr->csPtrR = NULL; outStatePtr->csPtrW = NULL; - ckfree(csPtr); + Tcl_Free(csPtr); } /* @@ -10714,7 +10589,7 @@ Tcl_IsChannelShared( ChannelState *statePtr = ((Channel *) chan)->state; /* State of real channel structure. */ - return ((statePtr->refCount > 1) ? 1 : 0); + return ((statePtr->refCount + 1 > 2) ? 1 : 0); } /* @@ -10810,16 +10685,6 @@ Tcl_ChannelVersion( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { -#ifndef TCL_NO_DEPRECATED - if ((chanTypePtr->version < TCL_CHANNEL_VERSION_2) - || (chanTypePtr->version > TCL_CHANNEL_VERSION_5)) { - /* - * In <v2 channel versions, the version field is occupied by the - * Tcl_DriverBlockModeProc - */ - return TCL_CHANNEL_VERSION_1; - } -#endif return chanTypePtr->version; } @@ -10843,46 +10708,12 @@ Tcl_ChannelBlockModeProc( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { -#ifndef TCL_NO_DEPRECATED - if (Tcl_ChannelVersion(chanTypePtr) < TCL_CHANNEL_VERSION_2) { - /* - * The v1 structure had the blockModeProc in a different place. - */ - return (Tcl_DriverBlockModeProc *) chanTypePtr->version; - } -#endif return chanTypePtr->blockModeProc; } /* *---------------------------------------------------------------------- * - * Tcl_ChannelCloseProc -- - * - * Return the Tcl_DriverCloseProc of the channel type. - * - * Results: - * A pointer to the proc. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -#ifndef TCL_NO_DEPRECATED -Tcl_DriverCloseProc * -Tcl_ChannelCloseProc( - const Tcl_ChannelType *chanTypePtr) - /* Pointer to channel type. */ -{ - return chanTypePtr->closeProc; -} -#endif - -/* - *---------------------------------------------------------------------- - * * Tcl_ChannelClose2Proc -- * * Return the Tcl_DriverClose2Proc of the channel type. @@ -10955,32 +10786,6 @@ Tcl_ChannelOutputProc( /* *---------------------------------------------------------------------- * - * Tcl_ChannelSeekProc -- - * - * Return the Tcl_DriverSeekProc of the channel type. - * - * Results: - * A pointer to the proc. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -#ifndef TCL_NO_DEPRECATED -Tcl_DriverSeekProc * -Tcl_ChannelSeekProc( - const Tcl_ChannelType *chanTypePtr) - /* Pointer to channel type. */ -{ - return chanTypePtr->seekProc; -} -#endif - -/* - *---------------------------------------------------------------------- - * * Tcl_ChannelSetOptionProc -- * * Return the Tcl_DriverSetOptionProc of the channel type. @@ -11095,11 +10900,6 @@ Tcl_ChannelFlushProc( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { -#ifndef TCL_NO_DEPRECATED - if (Tcl_ChannelVersion(chanTypePtr) < TCL_CHANNEL_VERSION_2) { - return NULL; - } -#endif return chanTypePtr->flushProc; } @@ -11124,11 +10924,6 @@ Tcl_ChannelHandlerProc( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { -#ifndef TCL_NO_DEPRECATED - if (Tcl_ChannelVersion(chanTypePtr) < TCL_CHANNEL_VERSION_2) { - return NULL; - } -#endif return chanTypePtr->handlerProc; } @@ -11153,11 +10948,6 @@ Tcl_ChannelWideSeekProc( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { -#ifndef TCL_NO_DEPRECATED - if (Tcl_ChannelVersion(chanTypePtr) < TCL_CHANNEL_VERSION_3) { - return NULL; - } -#endif return chanTypePtr->wideSeekProc; } @@ -11183,11 +10973,6 @@ Tcl_ChannelThreadActionProc( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { -#ifndef TCL_NO_DEPRECATED - if (Tcl_ChannelVersion(chanTypePtr) < TCL_CHANNEL_VERSION_4) { - return NULL; - } -#endif return chanTypePtr->threadActionProc; } @@ -11291,7 +11076,7 @@ FixLevelCode( Tcl_Obj *msg) { int explicitResult, numOptions, lcn; - int lc; + size_t lc; Tcl_Obj **lv, **lvn; int res, i, j, val, lignore, cignore; int newlevel = -1, newcode = -1; @@ -11370,7 +11155,7 @@ FixLevelCode( lcn += 2; } - lvn = (Tcl_Obj **)ckalloc(lcn * sizeof(Tcl_Obj *)); + lvn = (Tcl_Obj **)Tcl_Alloc(lcn * sizeof(Tcl_Obj *)); /* * New level/code information is spliced into the first occurence of @@ -11423,7 +11208,7 @@ FixLevelCode( msg = Tcl_NewListObj(j, lvn); - ckfree(lvn); + Tcl_Free(lvn); return msg; } @@ -11505,9 +11290,6 @@ Tcl_ChannelTruncateProc( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { - if (Tcl_ChannelVersion(chanTypePtr) < TCL_CHANNEL_VERSION_5) { - return NULL; - } return chanTypePtr->truncateProc; } @@ -11571,7 +11353,7 @@ FreeChannelInternalRep( return; } Tcl_Release(resPtr->statePtr); - ckfree(resPtr); + Tcl_Free(resPtr); } #if 0 diff --git a/generic/tclIO.h b/generic/tclIO.h index fbd01ee..fe34414 100644 --- a/generic/tclIO.h +++ b/generic/tclIO.h @@ -36,12 +36,12 @@ */ typedef struct ChannelBuffer { - Tcl_Size refCount; /* Current uses count */ - Tcl_Size nextAdded; /* The next position into which a character + size_t refCount; /* Current uses count */ + size_t nextAdded; /* The next position into which a character * will be put in the buffer. */ - Tcl_Size nextRemoved; /* Position of next byte to be removed from + size_t nextRemoved; /* Position of next byte to be removed from * the buffer. */ - Tcl_Size bufLength; /* How big is the buffer? */ + size_t bufLength; /* How big is the buffer? */ struct ChannelBuffer *nextPtr; /* Next buffer in chain. */ char buf[TCLFLEXARRAY]; /* Placeholder for real buffer. The real @@ -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. */ - Tcl_Size refCount; + size_t refCount; } Channel; /* @@ -158,12 +158,14 @@ typedef struct ChannelState { * of line sequences in output? */ int inEofChar; /* If nonzero, use this as a signal of EOF on * input. */ +#if TCL_MAJOR_VERSION < 9 int outEofChar; /* If nonzero, append this to the channel when - * it is closed if it is open for writing. */ + * it is closed if it is open for writing. For Tcl 8.x only */ +#endif int unreportedError; /* Non-zero if an error report was deferred * because it happened in the background. The * value is the POSIX error code. */ - Tcl_Size refCount; /* How many interpreters hold references to + size_t refCount; /* How many interpreters hold references to * this IO channel? */ struct CloseCallback *closeCbPtr; /* Callbacks registered to be called when the @@ -186,7 +188,7 @@ typedef struct ChannelState { EventScriptRecord *scriptRecordPtr; /* Chain of all scripts registered for event * handlers ("fileevent") on this channel. */ - Tcl_Size bufSize; /* What size buffers to allocate? */ + size_t bufSize; /* What size buffers to allocate? */ Tcl_TimerToken timer; /* Handle to wakeup timer for this channel. */ struct CopyState *csPtrR; /* State of background copy for which channel * is input, or NULL. */ diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c index e8a534f..4ce27bb 100644 --- a/generic/tclIOCmd.c +++ b/generic/tclIOCmd.c @@ -44,7 +44,7 @@ static void RegisterTcpServerInterpCleanup( Tcl_Interp *interp, AcceptCallback *acceptCallbackPtr); static Tcl_InterpDeleteProc TcpAcceptCallbacksDeleteProc; -static void TcpServerCloseProc(void *callbackData); +static void TcpServerCloseProc(ClientData callbackData); static void UnregisterTcpServerInterpCleanupProc( Tcl_Interp *interp, AcceptCallback *acceptCallbackPtr); @@ -132,19 +132,6 @@ Tcl_PutsObjCmd( chanObjPtr = objv[2]; string = objv[3]; break; -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 - } else if (strcmp(TclGetString(objv[3]), "nonewline") == 0) { - /* - * The code below provides backwards compatibility with an old - * form of the command that is no longer recommended or - * documented. See also [Bug #3151675]. Will be removed in Tcl 9, - * maybe even earlier. - */ - - chanObjPtr = objv[1]; - string = objv[2]; - break; -#endif } /* Fall through */ default: /* [puts] or @@ -176,12 +163,12 @@ Tcl_PutsObjCmd( TclChannelPreserve(chan); result = Tcl_WriteObj(chan, string); - if (result < 0) { + if (result == -1) { goto error; } if (newline != 0) { result = Tcl_WriteChars(chan, "\n", 1); - if (result < 0) { + if (result == -1) { goto error; } } @@ -293,7 +280,7 @@ Tcl_GetsObjCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Channel chan; /* The channel to read from. */ - int lineLen; /* Length of line just read. */ + size_t lineLen; /* Length of line just read. */ int mode; /* Mode in which channel is opened. */ Tcl_Obj *linePtr, *chanObjPtr; int code = TCL_OK; @@ -316,7 +303,7 @@ Tcl_GetsObjCmd( TclChannelPreserve(chan); TclNewObj(linePtr); lineLen = Tcl_GetsObj(chan, linePtr); - if (lineLen < 0) { + if (lineLen == TCL_IO_FAILURE) { if (!Tcl_Eof(chan) && !Tcl_InputBlocked(chan)) { Tcl_DecrRefCount(linePtr); @@ -335,7 +322,7 @@ Tcl_GetsObjCmd( code = TCL_ERROR; goto done; } - lineLen = TCL_INDEX_NONE; + lineLen = TCL_IO_FAILURE; } if (objc == 3) { if (Tcl_ObjSetVar2(interp, objv[2], NULL, linePtr, @@ -343,7 +330,7 @@ Tcl_GetsObjCmd( code = TCL_ERROR; goto done; } - Tcl_SetObjResult(interp, Tcl_NewWideIntObj(lineLen)); + Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt)((Tcl_WideUInt)(lineLen + 1U)) - 1)); } else { Tcl_SetObjResult(interp, linePtr); } @@ -378,8 +365,8 @@ Tcl_ReadObjCmd( { Tcl_Channel chan; /* The channel to read from. */ int newline, i; /* Discard newline at end? */ - int toRead; /* How many bytes to read? */ - int charactersRead; /* How many characters were read? */ + Tcl_WideInt toRead; /* How many bytes to read? */ + size_t charactersRead; /* How many characters were read? */ int mode; /* Mode in which channel is opened. */ Tcl_Obj *resultPtr, *chanObjPtr; @@ -429,27 +416,13 @@ Tcl_ReadObjCmd( toRead = -1; if (i < objc) { - if ((TclGetIntFromObj(interp, objv[i], &toRead) != TCL_OK) + if ((TclGetWideIntFromObj(NULL, objv[i], &toRead) != TCL_OK) || (toRead < 0)) { -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 - /* - * The code below provides backwards compatibility with an old - * form of the command that is no longer recommended or - * documented. See also [Bug #3151675]. Will be removed in Tcl 9, - * maybe even earlier. - */ - - if (strcmp(TclGetString(objv[i]), "nonewline") != 0) { -#endif Tcl_SetObjResult(interp, Tcl_ObjPrintf( "expected non-negative integer but got \"%s\"", TclGetString(objv[i]))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "NUMBER", NULL); return TCL_ERROR; -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 - } - newline = 1; -#endif } } @@ -457,7 +430,7 @@ Tcl_ReadObjCmd( Tcl_IncrRefCount(resultPtr); TclChannelPreserve(chan); charactersRead = Tcl_ReadChars(chan, resultPtr, toRead, 0); - if (charactersRead < 0) { + if (charactersRead == TCL_IO_FAILURE) { /* * TIP #219. * Capture error messages put by the driver into the bypass area and @@ -481,9 +454,9 @@ Tcl_ReadObjCmd( if ((charactersRead > 0) && (newline != 0)) { const char *result; - int length; + size_t length; - result = TclGetStringFromObj(resultPtr, &length); + result = Tcl_GetStringFromObj(resultPtr, &length); if (result[length - 1] == '\n') { Tcl_SetObjLength(resultPtr, length - 1); } @@ -724,13 +697,13 @@ Tcl_CloseObjCmd( Tcl_Obj *resultPtr = Tcl_GetObjResult(interp); const char *string; - int len; + size_t len; if (Tcl_IsShared(resultPtr)) { resultPtr = Tcl_DuplicateObj(resultPtr); Tcl_SetObjResult(interp, resultPtr); } - string = TclGetStringFromObj(resultPtr, &len); + string = Tcl_GetStringFromObj(resultPtr, &len); if ((len > 0) && (string[len - 1] == '\n')) { Tcl_SetObjLength(resultPtr, len - 1); } @@ -884,7 +857,7 @@ Tcl_ExecObjCmd( const char *string; Tcl_Channel chan; int argc, background, i, index, keepNewline, result, skip, ignoreStderr; - int length; + size_t length; static const char *const options[] = { "-ignorestderr", "-keepnewline", "--", NULL }; @@ -969,7 +942,7 @@ Tcl_ExecObjCmd( */ TclGetAndDetachPids(interp, chan); - if (Tcl_Close(interp, chan) != TCL_OK) { + if (Tcl_CloseEx(interp, chan, 0) != TCL_OK) { return TCL_ERROR; } return TCL_OK; @@ -1001,7 +974,7 @@ Tcl_ExecObjCmd( * string. */ - result = Tcl_Close(interp, chan); + result = Tcl_CloseEx(interp, chan, 0); Tcl_AppendObjToObj(resultPtr, Tcl_GetObjResult(interp)); /* @@ -1010,7 +983,7 @@ Tcl_ExecObjCmd( */ if (keepNewline == 0) { - string = TclGetStringFromObj(resultPtr, &length); + string = Tcl_GetStringFromObj(resultPtr, &length); if ((length > 0) && (string[length - 1] == '\n')) { Tcl_SetObjLength(resultPtr, length - 1); } @@ -1145,7 +1118,7 @@ Tcl_OpenObjCmd( chan = Tcl_FSOpenFileChannel(interp, objv[1], modeString, prot); } else { int mode, seekFlag, binary; - int cmdObjc; + size_t cmdObjc; const char **cmdArgv; if (Tcl_SplitList(interp, what+1, &cmdObjc, &cmdArgv) != TCL_OK) { @@ -1177,7 +1150,7 @@ Tcl_OpenObjCmd( Tcl_SetChannelOption(interp, chan, "-translation", "binary"); } } - ckfree(cmdArgv); + Tcl_Free((void *)cmdArgv); } if (chan == NULL) { return TCL_ERROR; @@ -1210,7 +1183,7 @@ Tcl_OpenObjCmd( static void TcpAcceptCallbacksDeleteProc( - void *clientData, /* Data which was passed when the assocdata + ClientData clientData, /* Data which was passed when the assocdata * was registered. */ TCL_UNUSED(Tcl_Interp *)) { @@ -1225,7 +1198,7 @@ TcpAcceptCallbacksDeleteProc( acceptCallbackPtr->interp = NULL; } Tcl_DeleteHashTable(hTblPtr); - ckfree(hTblPtr); + Tcl_Free(hTblPtr); } /* @@ -1265,7 +1238,7 @@ RegisterTcpServerInterpCleanup( hTblPtr = (Tcl_HashTable *)Tcl_GetAssocData(interp, "tclTCPAcceptCallbacks", NULL); if (hTblPtr == NULL) { - hTblPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable)); + hTblPtr = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(hTblPtr, TCL_ONE_WORD_KEYS); Tcl_SetAssocData(interp, "tclTCPAcceptCallbacks", TcpAcceptCallbacksDeleteProc, hTblPtr); @@ -1313,7 +1286,7 @@ UnregisterTcpServerInterpCleanupProc( return; } - hPtr = Tcl_FindHashEntry(hTblPtr, (char *) acceptCallbackPtr); + hPtr = Tcl_FindHashEntry(hTblPtr, acceptCallbackPtr); if (hPtr != NULL) { Tcl_DeleteHashEntry(hPtr); } @@ -1338,7 +1311,7 @@ UnregisterTcpServerInterpCleanupProc( static void AcceptCallbackProc( - void *callbackData, /* The data stored when the callback was + ClientData callbackData, /* The data stored when the callback was * created in the call to * Tcl_OpenTcpServer. */ Tcl_Channel chan, /* Channel for the newly accepted @@ -1402,7 +1375,7 @@ AcceptCallbackProc( * the client socket - just close it. */ - Tcl_Close(NULL, chan); + Tcl_CloseEx(NULL, chan, 0); } } @@ -1429,7 +1402,7 @@ AcceptCallbackProc( static void TcpServerCloseProc( - void *callbackData) /* The data passed in the call to + ClientData callbackData) /* The data passed in the call to * Tcl_CreateCloseHandler. */ { AcceptCallback *acceptCallbackPtr = (AcceptCallback *)callbackData; @@ -1440,7 +1413,7 @@ TcpServerCloseProc( acceptCallbackPtr); } Tcl_DecrRefCount(acceptCallbackPtr->script); - ckfree(acceptCallbackPtr); + Tcl_Free(acceptCallbackPtr); } /* @@ -1474,8 +1447,8 @@ Tcl_SocketObjCmd( enum socketOptionsEnum { SKT_ASYNC, SKT_BACKLOG, SKT_MYADDR, SKT_MYPORT, SKT_REUSEADDR, SKT_REUSEPORT, SKT_SERVER - }; - int optionIndex, a, server = 0, myport = 0, async = 0, reusep = -1, + } optionIndex; + int a, server = 0, myport = 0, async = 0, reusep = -1, reusea = -1, backlog = -1; unsigned int flags = 0; const char *host, *port, *myaddr = NULL; @@ -1485,7 +1458,7 @@ Tcl_SocketObjCmd( TclInitSockets(); for (a = 1; a < objc; a++) { - const char *arg = Tcl_GetString(objv[a]); + const char *arg = TclGetString(objv[a]); if (arg[0] != '-') { break; @@ -1494,7 +1467,7 @@ Tcl_SocketObjCmd( TCL_EXACT, &optionIndex) != TCL_OK) { return TCL_ERROR; } - switch ((enum socketOptionsEnum) optionIndex) { + switch (optionIndex) { case SKT_ASYNC: if (server == 1) { Tcl_SetObjResult(interp, Tcl_NewStringObj( @@ -1645,7 +1618,7 @@ Tcl_SocketObjCmd( port = TclGetString(objv[a]); if (server) { - AcceptCallback *acceptCallbackPtr = (AcceptCallback *)ckalloc(sizeof(AcceptCallback)); + AcceptCallback *acceptCallbackPtr = (AcceptCallback *)Tcl_Alloc(sizeof(AcceptCallback)); Tcl_IncrRefCount(script); acceptCallbackPtr->script = script; @@ -1655,7 +1628,7 @@ Tcl_SocketObjCmd( AcceptCallbackProc, acceptCallbackPtr); if (chan == NULL) { Tcl_DecrRefCount(script); - ckfree(acceptCallbackPtr); + Tcl_Free(acceptCallbackPtr); return TCL_ERROR; } @@ -1814,9 +1787,9 @@ ChanPendingObjCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Channel chan; - int index, mode; + int mode; static const char *const options[] = {"input", "output", NULL}; - enum pendingOptionsEnum {PENDING_INPUT, PENDING_OUTPUT}; + enum pendingOptionsEnum {PENDING_INPUT, PENDING_OUTPUT} index; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "mode channelId"); @@ -1832,7 +1805,7 @@ ChanPendingObjCmd( return TCL_ERROR; } - switch ((enum pendingOptionsEnum) index) { + switch (index) { case PENDING_INPUT: if (!(mode & TCL_READABLE)) { Tcl_SetObjResult(interp, Tcl_NewWideIntObj(-1)); diff --git a/generic/tclIOGT.c b/generic/tclIOGT.c index 0e15280..868791a 100644 --- a/generic/tclIOGT.c +++ b/generic/tclIOGT.c @@ -27,10 +27,6 @@ static int TransformInputProc(ClientData instanceData, char *buf, int toRead, int *errorCodePtr); static int TransformOutputProc(ClientData instanceData, const char *buf, int toWrite, int *errorCodePtr); -#ifndef TCL_NO_DEPRECATED -static int TransformSeekProc(ClientData instanceData, long offset, - int mode, int *errorCodePtr); -#endif static int TransformSetOptionProc(ClientData instanceData, Tcl_Interp *interp, const char *optionName, const char *value); @@ -121,14 +117,10 @@ static inline void ResultAdd(ResultBuffer *r, unsigned char *buf, static const Tcl_ChannelType transformChannelType = { "transform", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ - TCL_CLOSE2PROC, /* Close proc. */ + NULL, /* Close proc. */ TransformInputProc, /* Input proc. */ TransformOutputProc, /* Output proc. */ -#ifndef TCL_NO_DEPRECATED - TransformSeekProc, /* Seek proc. */ -#else NULL, /* Seek proc. */ -#endif TransformSetOptionProc, /* Set option proc. */ TransformGetOptionProc, /* Get option proc. */ TransformWatchProc, /* Initialize notifier. */ @@ -236,7 +228,7 @@ ReleaseData( } ResultClear(&dataPtr->result); Tcl_DecrRefCount(dataPtr->command); - ckfree(dataPtr); + Tcl_Free(dataPtr); } /* @@ -266,7 +258,7 @@ TclChannelTransform( Channel *chanPtr; /* The actual channel. */ ChannelState *statePtr; /* State info for channel. */ int mode; /* Read/write mode of the channel. */ - int objc; + size_t objc; TransformChannelData *dataPtr; Tcl_DString ds; @@ -292,7 +284,7 @@ TclChannelTransform( * regime of the underlying channel and to use the same for us too. */ - dataPtr = (TransformChannelData *)ckalloc(sizeof(TransformChannelData)); + dataPtr = (TransformChannelData *)Tcl_Alloc(sizeof(TransformChannelData)); dataPtr->refCount = 1; Tcl_DStringInit(&ds); @@ -383,7 +375,7 @@ ExecuteCallback( * interpreters. */ { Tcl_Obj *resObj; /* See below, switch (transmit). */ - int resLen; + size_t resLen = 0; unsigned char *resBuf; Tcl_InterpState state = NULL; int res = TCL_OK; @@ -449,9 +441,12 @@ ExecuteCallback( } resObj = Tcl_GetObjResult(eval); resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen); - Tcl_WriteRaw(Tcl_GetStackedChannel(dataPtr->self), (char *) resBuf, - resLen); - break; + if (resBuf) { + Tcl_WriteRaw(Tcl_GetStackedChannel(dataPtr->self), + (char *) resBuf, resLen); + break; + } + goto nonBytes; case TRANSMIT_SELF: if (dataPtr->self == NULL) { @@ -459,14 +454,24 @@ ExecuteCallback( } resObj = Tcl_GetObjResult(eval); resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen); - Tcl_WriteRaw(dataPtr->self, (char *) resBuf, resLen); - break; + if (resBuf) { + Tcl_WriteRaw(dataPtr->self, (char *) resBuf, resLen); + break; + } + goto nonBytes; case TRANSMIT_IBUF: resObj = Tcl_GetObjResult(eval); resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen); - ResultAdd(&dataPtr->result, resBuf, resLen); - break; + if (resBuf) { + ResultAdd(&dataPtr->result, resBuf, resLen); + break; + } + nonBytes: + Tcl_AppendResult(interp, "chan transform callback received non-bytes", + NULL); + Tcl_Release(eval); + return TCL_ERROR; case TRANSMIT_NUM: /* @@ -821,75 +826,6 @@ TransformOutputProc( /* *---------------------------------------------------------------------- * - * TransformSeekProc -- - * - * This procedure is called by the generic IO level to move the access - * point in a channel. - * - * Side effects: - * Moves the location at which the channel will be accessed in future - * operations. Flushes all transformation buffers, then forwards it to - * the underlying channel. - * - * Result: - * -1 if failed, the new position if successful. An output argument - * contains the POSIX error code if an error occurred, or zero. - * - *---------------------------------------------------------------------- - */ - -#ifndef TCL_NO_DEPRECATED -static int -TransformSeekProc( - ClientData instanceData, /* The channel to manipulate. */ - long offset, /* Size of movement. */ - int mode, /* How to move. */ - int *errorCodePtr) /* Location of error flag. */ -{ - TransformChannelData *dataPtr = (TransformChannelData *)instanceData; - Tcl_Channel parent = Tcl_GetStackedChannel(dataPtr->self); - const Tcl_ChannelType *parentType = Tcl_GetChannelType(parent); - Tcl_DriverSeekProc *parentSeekProc = Tcl_ChannelSeekProc(parentType); - - if ((offset == 0) && (mode == SEEK_CUR)) { - /* - * This is no seek but a request to tell the caller the current - * location. Simply pass the request down. - */ - - return parentSeekProc(Tcl_GetChannelInstanceData(parent), offset, - mode, errorCodePtr); - } - - /* - * It is a real request to change the position. Flush all data waiting for - * output and discard everything in the input buffers. Then pass the - * request down, unchanged. - */ - - PreserveData(dataPtr); - if (dataPtr->mode & TCL_WRITABLE) { - ExecuteCallback(dataPtr, NULL, A_FLUSH_WRITE, NULL, 0, TRANSMIT_DOWN, - P_NO_PRESERVE); - } - - if (dataPtr->mode & TCL_READABLE) { - ExecuteCallback(dataPtr, NULL, A_CLEAR_READ, NULL, 0, TRANSMIT_DONT, - P_NO_PRESERVE); - ResultClear(&dataPtr->result); - dataPtr->readIsFlushed = 0; - dataPtr->eofPending = 0; - } - ReleaseData(dataPtr); - - return parentSeekProc(Tcl_GetChannelInstanceData(parent), offset, mode, - errorCodePtr); -} -#endif - -/* - *---------------------------------------------------------------------- - * * TransformWideSeekProc -- * * This procedure is called by the generic IO level to move the access @@ -917,9 +853,6 @@ TransformWideSeekProc( TransformChannelData *dataPtr = (TransformChannelData *)instanceData; Tcl_Channel parent = Tcl_GetStackedChannel(dataPtr->self); const Tcl_ChannelType *parentType = Tcl_GetChannelType(parent); -#ifndef TCL_NO_DEPRECATED - Tcl_DriverSeekProc *parentSeekProc = Tcl_ChannelSeekProc(parentType); -#endif Tcl_DriverWideSeekProc *parentWideSeekProc = Tcl_ChannelWideSeekProc(parentType); void *parentData = Tcl_GetChannelInstanceData(parent); @@ -932,10 +865,6 @@ TransformWideSeekProc( if (parentWideSeekProc != NULL) { return parentWideSeekProc(parentData, offset, mode, errorCodePtr); -#ifndef TCL_NO_DEPRECATED - } else if (parentSeekProc) { - return parentSeekProc(parentData, 0, mode, errorCodePtr); -#endif } else { *errorCodePtr = EINVAL; return -1; @@ -968,26 +897,8 @@ TransformWideSeekProc( */ if (parentWideSeekProc == NULL) { - /* - * We're transferring to narrow seeks at this point; this is a bit complex - * because we have to check whether the seek is possible first (i.e. - * whether we are losing information in truncating the bits of the - * offset). Luckily, there's a defined error for what happens when trying - * to go out of the representable range. - */ - -#ifndef TCL_NO_DEPRECATED - if (offset<LONG_MIN || offset>LONG_MAX) { - *errorCodePtr = EOVERFLOW; - return -1; - } - - return parentSeekProc(parentData, offset, - mode, errorCodePtr); -#else *errorCodePtr = EINVAL; return -1; -#endif } return parentWideSeekProc(parentData, offset, mode, errorCodePtr); } @@ -1294,7 +1205,7 @@ ResultClear( r->used = 0; if (r->allocated) { - ckfree(r->buf); + Tcl_Free(r->buf); r->buf = NULL; r->allocated = 0; } @@ -1438,10 +1349,10 @@ ResultAdd( if (r->allocated == 0) { r->allocated = toWrite + INCREMENT; - r->buf = (unsigned char *)ckalloc(r->allocated); + r->buf = (unsigned char *)Tcl_Alloc(r->allocated); } else { r->allocated += toWrite + INCREMENT; - r->buf = (unsigned char *)ckrealloc(r->buf, r->allocated); + r->buf = (unsigned char *)Tcl_Realloc(r->buf, r->allocated); } } diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c index ec82fc5..5bf7ea4 100644 --- a/generic/tclIORChan.c +++ b/generic/tclIORChan.c @@ -46,10 +46,6 @@ static int ReflectEventDelete(Tcl_Event *ev, void *cd); #endif static long long ReflectSeekWide(void *clientData, long long offset, int mode, int *errorCodePtr); -#ifndef TCL_NO_DEPRECATED -static int ReflectSeek(void *clientData, long offset, - int mode, int *errorCodePtr); -#endif static int ReflectGetOption(void *clientData, Tcl_Interp *interp, const char *optionName, Tcl_DString *dsPtr); @@ -68,14 +64,10 @@ static void TimerRunWrite(void *clientData); static const Tcl_ChannelType tclRChannelType = { "tclrchannel", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ - TCL_CLOSE2PROC, /* Close channel, clean instance data */ + NULL, /* Close channel, clean instance data */ ReflectInput, /* Handle read request */ ReflectOutput, /* Handle write request */ -#ifndef TCL_NO_DEPRECATED - ReflectSeek, /* Move location of access point. NULL'able */ -#else NULL, -#endif ReflectSetOption, /* Set options. NULL'able */ ReflectGetOption, /* Get options. NULL'able */ ReflectWatch, /* Initialize notifier */ @@ -274,7 +266,7 @@ typedef struct { struct ForwardParamInput { ForwardParamBase base; /* "Supertype". MUST COME FIRST. */ char *buf; /* O: Where to store the read bytes */ - int toRead; /* I: #bytes to read, + size_t toRead; /* I: #bytes to read, * O: #bytes actually read */ }; struct ForwardParamOutput { @@ -412,7 +404,7 @@ static void SrcExitProc(void *clientData); #define FreeReceivedError(p) \ if ((p)->base.mustFree) { \ - ckfree((p)->base.msgStr); \ + Tcl_Free((p)->base.msgStr); \ } #define PassReceivedErrorInterp(i,p) \ if ((i) != NULL) { \ @@ -474,6 +466,7 @@ static void MarkDead(ReflectedChannel *rcPtr); */ static const char *msg_read_toomuch = "{read delivered more than requested}"; +static const char *msg_read_nonbyte = "{read delivered nonbyte result}"; static const char *msg_write_toomuch = "{write wrote more than requested}"; static const char *msg_write_nothing = "{write wrote nothing}"; static const char *msg_seek_beforestart = "{Tried to seek before origin}"; @@ -520,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 */ - int listc; /* Result of 'initialize', and of */ + size_t 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' */ @@ -696,7 +689,7 @@ TclChanCreateObjCmd( * as the actual channel type. */ - Tcl_ChannelType *clonePtr = (Tcl_ChannelType *)ckalloc(sizeof(Tcl_ChannelType)); + Tcl_ChannelType *clonePtr = (Tcl_ChannelType *)Tcl_Alloc(sizeof(Tcl_ChannelType)); memcpy(clonePtr, &tclRChannelType, sizeof(Tcl_ChannelType)); @@ -711,9 +704,6 @@ TclChanCreateObjCmd( clonePtr->blockModeProc = NULL; } if (!(methods & FLAG(METH_SEEK))) { -#ifndef TCL_NO_DEPRECATED - clonePtr->seekProc = NULL; -#endif clonePtr->wideSeekProc = NULL; } if (!(methods & FLAG(METH_TRUNCATE))) { @@ -756,7 +746,7 @@ TclChanCreateObjCmd( Tcl_DecrRefCount(rcPtr->name); Tcl_DecrRefCount(rcPtr->methods); Tcl_DecrRefCount(rcPtr->cmd); - ckfree(rcPtr); + Tcl_Free(rcPtr); return TCL_ERROR; #undef MODE @@ -965,7 +955,7 @@ TclChanPostEventObjCmd( } #if TCL_THREADS } else { - ReflectEvent *ev = (ReflectEvent *)ckalloc(sizeof(ReflectEvent)); + ReflectEvent *ev = (ReflectEvent *)Tcl_Alloc(sizeof(ReflectEvent)); ev->header.proc = ReflectEventRun; ev->events = events; @@ -1057,10 +1047,10 @@ UnmarshallErrorResult( Tcl_Interp *interp, Tcl_Obj *msgObj) { - int lc; + size_t lc; Tcl_Obj **lv; int explicitResult; - int numOptions; + size_t numOptions; /* * Process the caught message. @@ -1223,7 +1213,7 @@ ReflectClose( tctPtr = ((Channel *)rcPtr->chan)->typePtr; if (tctPtr && tctPtr != &tclRChannelType) { - ckfree(tctPtr); + Tcl_Free((void *)tctPtr); ((Channel *)rcPtr->chan)->typePtr = NULL; } if (rcPtr->readTimer != NULL) { @@ -1298,7 +1288,7 @@ ReflectClose( #endif tctPtr = ((Channel *)rcPtr->chan)->typePtr; if (tctPtr && tctPtr != &tclRChannelType) { - ckfree(tctPtr); + Tcl_Free((void *)tctPtr); ((Channel *)rcPtr->chan)->typePtr = NULL; } if (rcPtr->readTimer != NULL) { @@ -1336,7 +1326,7 @@ ReflectInput( { ReflectedChannel *rcPtr = (ReflectedChannel *)clientData; Tcl_Obj *toReadObj; - int bytec; /* Number of returned bytes */ + size_t bytec = 0; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ Tcl_Obj *resObj; /* Result data for 'read' */ @@ -1364,7 +1354,7 @@ ReflectInput( PassReceivedError(rcPtr->chan, &p); *errorCodePtr = EINVAL; } - p.input.toRead = -1; + p.input.toRead = TCL_INDEX_NONE; } else { *errorCodePtr = EOK; } @@ -1395,14 +1385,17 @@ ReflectInput( bytev = Tcl_GetByteArrayFromObj(resObj, &bytec); - if (toRead < bytec) { + if (bytev == NULL) { + SetChannelErrorStr(rcPtr->chan, msg_read_nonbyte); + goto invalid; + } else if ((size_t)toRead < bytec) { SetChannelErrorStr(rcPtr->chan, msg_read_toomuch); - goto invalid; + goto invalid; } *errorCodePtr = EOK; - if (bytec > 0) { + if (bytec + 1 > 1) { memcpy(buf, bytev, bytec); } @@ -1638,26 +1631,6 @@ ReflectSeekWide( newLoc = -1; goto stop; } - -#ifndef TCL_NO_DEPRECATED -static int -ReflectSeek( - void *clientData, - long offset, - int seekMode, - int *errorCodePtr) -{ - /* - * This function can be invoked from a transformation which is based on - * standard seeking, i.e. non-wide. Because of this we have to implement - * it, a dummy is not enough. We simply delegate the call to the wide - * routine. - */ - - return ReflectSeekWide(clientData, offset, seekMode, - errorCodePtr); -} -#endif /* *---------------------------------------------------------------------- @@ -1939,7 +1912,8 @@ ReflectGetOption( ReflectedChannel *rcPtr = (ReflectedChannel *)clientData; Tcl_Obj *optionObj; Tcl_Obj *resObj; /* Result data for 'configure' */ - int listc, result = TCL_OK; + size_t listc; + int result = TCL_OK; Tcl_Obj **listv; MethodName method; @@ -2032,12 +2006,12 @@ ReflectGetOption( Tcl_ResetResult(interp); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "Expected list with even number of " - "elements, got %d element%s instead", listc, + "elements, got %" TCL_Z_MODIFIER "u element%s instead", listc, (listc == 1 ? "" : "s"))); goto error; } else { - int len; - const char *str = TclGetStringFromObj(resObj, &len); + size_t len; + const char *str = Tcl_GetStringFromObj(resObj, &len); if (len) { TclDStringAppendLiteral(dsPtr, " "); @@ -2161,7 +2135,7 @@ EncodeEventMask( int *mask) { int events; /* Mask of events to post */ - int listc; /* #elements in eventspec list */ + size_t listc; /* #elements in eventspec list */ Tcl_Obj **listv; /* Elements of eventspec list */ int evIndex; /* Id of event for an element of the eventspec * list. */ @@ -2270,7 +2244,7 @@ NewReflectedChannel( ReflectedChannel *rcPtr; int mn = 0; - rcPtr = (ReflectedChannel *)ckalloc(sizeof(ReflectedChannel)); + rcPtr = (ReflectedChannel *)Tcl_Alloc(sizeof(ReflectedChannel)); /* rcPtr->chan: Assigned by caller. Dummy data here. */ @@ -2357,7 +2331,7 @@ FreeReflectedChannel( if (rcPtr->cmd) { Tcl_DecrRefCount(rcPtr->cmd); } - ckfree(rcPtr); + Tcl_Free(rcPtr); } /* @@ -2478,8 +2452,8 @@ InvokeTclMethod( */ if (result != TCL_ERROR) { - int cmdLen; - const char *cmdString = TclGetStringFromObj(cmd, &cmdLen); + size_t cmdLen; + const char *cmdString = Tcl_GetStringFromObj(cmd, &cmdLen); Tcl_IncrRefCount(cmd); Tcl_ResetResult(rcPtr->interp); @@ -2593,7 +2567,7 @@ GetReflectedChannelMap( ReflectedChannelMap *rcmPtr = (ReflectedChannelMap *)Tcl_GetAssocData(interp, RCMKEY, NULL); if (rcmPtr == NULL) { - rcmPtr = (ReflectedChannelMap *)ckalloc(sizeof(ReflectedChannelMap)); + rcmPtr = (ReflectedChannelMap *)Tcl_Alloc(sizeof(ReflectedChannelMap)); Tcl_InitHashTable(&rcmPtr->map, TCL_STRING_KEYS); Tcl_SetAssocData(interp, RCMKEY, DeleteReflectedChannelMap, rcmPtr); } @@ -2681,7 +2655,7 @@ DeleteReflectedChannelMap( Tcl_DeleteHashEntry(hPtr); } Tcl_DeleteHashTable(&rcmPtr->map); - ckfree(&rcmPtr->map); + Tcl_Free(&rcmPtr->map); #if TCL_THREADS /* @@ -2795,7 +2769,7 @@ GetThreadReflectedChannelMap(void) ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (!tsdPtr->rcmPtr) { - tsdPtr->rcmPtr = (ReflectedChannelMap *)ckalloc(sizeof(ReflectedChannelMap)); + tsdPtr->rcmPtr = (ReflectedChannelMap *)Tcl_Alloc(sizeof(ReflectedChannelMap)); Tcl_InitHashTable(&tsdPtr->rcmPtr->map, TCL_STRING_KEYS); Tcl_CreateThreadExitHandler(DeleteThreadReflectedChannelMap, NULL); } @@ -2918,7 +2892,7 @@ DeleteThreadReflectedChannelMap( MarkDead(rcPtr); Tcl_DeleteHashEntry(hPtr); } - ckfree(rcmPtr); + Tcl_Free(rcmPtr); } static void @@ -2958,8 +2932,8 @@ ForwardOpToHandlerThread( * Create and initialize the event and data structures. */ - evPtr = (ForwardingEvent *)ckalloc(sizeof(ForwardingEvent)); - resultPtr = (ForwardingResult *)ckalloc(sizeof(ForwardingResult)); + evPtr = (ForwardingEvent *)Tcl_Alloc(sizeof(ForwardingEvent)); + resultPtr = (ForwardingResult *)Tcl_Alloc(sizeof(ForwardingResult)); evPtr->event.proc = ForwardProc; evPtr->resultPtr = resultPtr; @@ -3041,7 +3015,7 @@ ForwardOpToHandlerThread( Tcl_DeleteThreadExitHandler(SrcExitProc, evPtr); - ckfree(resultPtr); + Tcl_Free(resultPtr); } static int @@ -3143,22 +3117,25 @@ ForwardProc( } else { ForwardSetObjError(paramPtr, resObj); } - paramPtr->input.toRead = -1; + paramPtr->input.toRead = TCL_IO_FAILURE; } else { /* * Process a regular result. */ - int bytec; /* Number of returned bytes */ + size_t bytec = 0; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ bytev = Tcl_GetByteArrayFromObj(resObj, &bytec); - if (paramPtr->input.toRead < bytec) { - ForwardSetStaticError(paramPtr, msg_read_toomuch); + if (bytev == NULL) { + ForwardSetStaticError(paramPtr, msg_read_nonbyte); paramPtr->input.toRead = -1; + } else if (paramPtr->input.toRead < bytec) { + ForwardSetStaticError(paramPtr, msg_read_toomuch); + paramPtr->input.toRead = TCL_IO_FAILURE; } else { - if (bytec > 0) { + if (bytec + 1 > 1) { memcpy(paramPtr->input.buf, bytev, bytec); } paramPtr->input.toRead = bytec; @@ -3328,7 +3305,7 @@ ForwardProc( * NOTE (4) as well. */ - int listc; + size_t listc; Tcl_Obj **listv; if (TclListObjGetElementsM(interp, resObj, &listc, @@ -3341,15 +3318,15 @@ ForwardProc( * Odd number of elements is wrong. [x]. */ - char *buf = (char *)ckalloc(200); + char *buf = (char *)Tcl_Alloc(200); sprintf(buf, - "{Expected list with even number of elements, got %d %s instead}", + "{Expected list with even number of elements, got %" TCL_Z_MODIFIER "u %s instead}", listc, (listc == 1 ? "element" : "elements")); ForwardSetDynamicError(paramPtr, buf); } else { - int len; - const char *str = TclGetStringFromObj(resObj, &len); + size_t len; + const char *str = Tcl_GetStringFromObj(resObj, &len); if (len) { TclDStringAppendLiteral(paramPtr->getOpt.value, " "); @@ -3460,11 +3437,11 @@ ForwardSetObjError( ForwardParam *paramPtr, Tcl_Obj *obj) { - int len; - const char *msgStr = TclGetStringFromObj(obj, &len); + size_t len; + const char *msgStr = Tcl_GetStringFromObj(obj, &len); len++; - ForwardSetDynamicError(paramPtr, ckalloc(len)); + ForwardSetDynamicError(paramPtr, Tcl_Alloc(len)); memcpy(paramPtr->base.msgStr, msgStr, len); } #endif diff --git a/generic/tclIORTrans.c b/generic/tclIORTrans.c index 3fe2585..ebaa840 100644 --- a/generic/tclIORTrans.c +++ b/generic/tclIORTrans.c @@ -41,10 +41,6 @@ static void ReflectWatch(void *clientData, int mask); static int ReflectBlock(void *clientData, int mode); static long long ReflectSeekWide(void *clientData, long long offset, int mode, int *errorCodePtr); -#ifndef TCL_NO_DEPRECATED -static int ReflectSeek(void *clientData, long offset, - int mode, int *errorCodePtr); -#endif static int ReflectGetOption(void *clientData, Tcl_Interp *interp, const char *optionName, Tcl_DString *dsPtr); @@ -62,14 +58,10 @@ static int ReflectNotify(void *clientData, int mask); static const Tcl_ChannelType tclRTransformType = { "tclrtransform", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel. */ - TCL_CLOSE2PROC, /* Close channel, clean instance data. */ + NULL, /* Close channel, clean instance data. */ ReflectInput, /* Handle read request. */ ReflectOutput, /* Handle write request. */ -#ifndef TCL_NO_DEPRECATED - ReflectSeek, /* Move location of access point. */ -#else NULL, /* Move location of access point. */ -#endif ReflectSetOption, /* Set options. */ ReflectGetOption, /* Get options. */ ReflectWatch, /* Initialize notifier. */ @@ -272,7 +264,7 @@ struct ForwardParamTransform { ForwardParamBase base; /* "Supertype". MUST COME FIRST. */ char *buf; /* I: Bytes to transform, * O: Bytes in transform result */ - int size; /* I: #bytes to transform, + size_t size; /* I: #bytes to transform, * O: #bytes in the transform result */ }; struct ForwardParamLimit { @@ -368,7 +360,7 @@ static void SrcExitProc(void *clientData); #define FreeReceivedError(p) \ do { \ if ((p)->base.mustFree) { \ - ckfree((p)->base.msgStr); \ + Tcl_Free((p)->base.msgStr); \ } \ } while (0) #define PassReceivedErrorInterp(i,p) \ @@ -519,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 */ - int listc; /* Result of 'initialize', and of */ + size_t 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' */ @@ -622,7 +614,7 @@ TclChanPushObjCmd( Tcl_SetObjResult(interp, Tcl_ObjPrintf( "chan handler \"%s initialize\" returned %s", TclGetString(cmdObj), - Tcl_GetString(Tcl_GetObjResult(interp)))); + Tcl_GetStringResult(interp))); Tcl_DecrRefCount(resObj); goto error; } @@ -828,10 +820,10 @@ UnmarshallErrorResult( Tcl_Interp *interp, Tcl_Obj *msgObj) { - int lc; + size_t lc; Tcl_Obj **lv; int explicitResult; - int numOptions; + size_t numOptions; /* * Process the caught message. @@ -1021,7 +1013,7 @@ ReflectClose( if (!rtPtr->dead) { rtmPtr = GetReflectedTransformMap(rtPtr->interp); - hPtr = Tcl_FindHashEntry(&rtmPtr->map, Tcl_GetString(rtPtr->handle)); + hPtr = Tcl_FindHashEntry(&rtmPtr->map, TclGetString(rtPtr->handle)); if (hPtr) { Tcl_DeleteHashEntry(hPtr); } @@ -1382,19 +1374,8 @@ ReflectSeekWide( */ if (Tcl_ChannelWideSeekProc(parent->typePtr) == NULL) { -#ifndef TCL_NO_DEPRECATED - if (offset < LONG_MIN || offset > LONG_MAX) { - *errorCodePtr = EOVERFLOW; - curPos = -1; - } else { - curPos = Tcl_ChannelSeekProc(parent->typePtr)( - parent->instanceData, offset, seekMode, - errorCodePtr); - } -#else *errorCodePtr = EINVAL; curPos = -1; -#endif } else { curPos = Tcl_ChannelWideSeekProc(parent->typePtr)(parent->instanceData, offset, seekMode, errorCodePtr); @@ -1407,26 +1388,6 @@ ReflectSeekWide( Tcl_Release(rtPtr); return curPos; } - -#ifndef TCL_NO_DEPRECATED -static int -ReflectSeek( - void *clientData, - long offset, - int seekMode, - int *errorCodePtr) -{ - /* - * This function can be invoked from a transformation which is based on - * standard seeking, i.e. non-wide. Because of this we have to implement - * it, a dummy is not enough. We simply delegate the call to the wide - * routine. - */ - - return ReflectSeekWide(clientData, offset, seekMode, - errorCodePtr); -} -#endif /* *---------------------------------------------------------------------- @@ -1758,11 +1719,10 @@ NewReflectedTransform( Tcl_Channel parentChan) { ReflectedTransform *rtPtr; - int listc; + size_t i, listc; Tcl_Obj **listv; - int i; - rtPtr = (ReflectedTransform *)ckalloc(sizeof(ReflectedTransform)); + rtPtr = (ReflectedTransform *)Tcl_Alloc(sizeof(ReflectedTransform)); /* rtPtr->chan: Assigned by caller. Dummy data here. */ /* rtPtr->methods: Assigned by caller. Dummy data here. */ @@ -1809,7 +1769,7 @@ NewReflectedTransform( */ rtPtr->argc = listc + 2; - rtPtr->argv = (Tcl_Obj **)ckalloc(sizeof(Tcl_Obj *) * (listc+4)); + rtPtr->argv = (Tcl_Obj **)Tcl_Alloc(sizeof(Tcl_Obj *) * (listc+4)); /* * Duplicate object references. @@ -1917,8 +1877,8 @@ FreeReflectedTransform( FreeReflectedTransformArgs(rtPtr); - ckfree(rtPtr->argv); - ckfree(rtPtr); + Tcl_Free(rtPtr->argv); + Tcl_Free(rtPtr); } /* @@ -2044,8 +2004,8 @@ InvokeTclMethod( */ if (result != TCL_ERROR) { Tcl_Obj *cmd = Tcl_NewListObj(cmdc, rtPtr->argv); - int cmdLen; - const char *cmdString = TclGetStringFromObj(cmd, &cmdLen); + size_t cmdLen; + const char *cmdString = Tcl_GetStringFromObj(cmd, &cmdLen); Tcl_IncrRefCount(cmd); Tcl_ResetResult(rtPtr->interp); @@ -2117,7 +2077,7 @@ GetReflectedTransformMap( ReflectedTransformMap *rtmPtr = (ReflectedTransformMap *)Tcl_GetAssocData(interp, RTMKEY, NULL); if (rtmPtr == NULL) { - rtmPtr = (ReflectedTransformMap *)ckalloc(sizeof(ReflectedTransformMap)); + rtmPtr = (ReflectedTransformMap *)Tcl_Alloc(sizeof(ReflectedTransformMap)); Tcl_InitHashTable(&rtmPtr->map, TCL_STRING_KEYS); Tcl_SetAssocData(interp, RTMKEY, (Tcl_InterpDeleteProc *) DeleteReflectedTransformMap, rtmPtr); @@ -2184,7 +2144,7 @@ DeleteReflectedTransformMap( Tcl_DeleteHashEntry(hPtr); } Tcl_DeleteHashTable(&rtmPtr->map); - ckfree(&rtmPtr->map); + Tcl_Free(&rtmPtr->map); #if TCL_THREADS /* @@ -2282,7 +2242,7 @@ GetThreadReflectedTransformMap(void) ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (!tsdPtr->rtmPtr) { - tsdPtr->rtmPtr = (ReflectedTransformMap *)ckalloc(sizeof(ReflectedTransformMap)); + tsdPtr->rtmPtr = (ReflectedTransformMap *)Tcl_Alloc(sizeof(ReflectedTransformMap)); Tcl_InitHashTable(&tsdPtr->rtmPtr->map, TCL_STRING_KEYS); Tcl_CreateThreadExitHandler(DeleteThreadReflectedTransformMap, NULL); } @@ -2340,7 +2300,7 @@ DeleteThreadReflectedTransformMap( FreeReflectedTransformArgs(rtPtr); Tcl_DeleteHashEntry(hPtr); } - ckfree(rtmPtr); + Tcl_Free(rtmPtr); /* * Go through the list of pending results and cancel all whose events were @@ -2417,8 +2377,8 @@ ForwardOpToOwnerThread( * Create and initialize the event and data structures. */ - evPtr = (ForwardingEvent *)ckalloc(sizeof(ForwardingEvent)); - resultPtr = (ForwardingResult *)ckalloc(sizeof(ForwardingResult)); + evPtr = (ForwardingEvent *)Tcl_Alloc(sizeof(ForwardingEvent)); + resultPtr = (ForwardingResult *)Tcl_Alloc(sizeof(ForwardingResult)); evPtr->event.proc = ForwardProc; evPtr->resultPtr = resultPtr; @@ -2498,7 +2458,7 @@ ForwardOpToOwnerThread( Tcl_DeleteThreadExitHandler(SrcExitProc, evPtr); - ckfree(resultPtr); + Tcl_Free(resultPtr); } static int @@ -2595,14 +2555,14 @@ ForwardProc( if (InvokeTclMethod(rtPtr, "read", bufObj, NULL, &resObj) != TCL_OK) { ForwardSetObjError(paramPtr, resObj); - paramPtr->transform.size = -1; + paramPtr->transform.size = TCL_INDEX_NONE; } else { /* * Process a regular return. Contains the transformation result. * Sent it back to the request originator. */ - int bytec; /* Number of returned bytes */ + size_t bytec = 0; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ @@ -2611,7 +2571,7 @@ ForwardProc( paramPtr->transform.size = bytec; if (bytec > 0) { - paramPtr->transform.buf = (char *)ckalloc(bytec); + paramPtr->transform.buf = (char *)Tcl_Alloc(bytec); memcpy(paramPtr->transform.buf, bytev, bytec); } else { paramPtr->transform.buf = NULL; @@ -2629,14 +2589,14 @@ ForwardProc( if (InvokeTclMethod(rtPtr, "write", bufObj, NULL, &resObj) != TCL_OK) { ForwardSetObjError(paramPtr, resObj); - paramPtr->transform.size = -1; + paramPtr->transform.size = TCL_INDEX_NONE; } else { /* * Process a regular return. Contains the transformation result. * Sent it back to the request originator. */ - int bytec; /* Number of returned bytes */ + size_t bytec = 0; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ @@ -2645,7 +2605,7 @@ ForwardProc( paramPtr->transform.size = bytec; if (bytec > 0) { - paramPtr->transform.buf = (char *)ckalloc(bytec); + paramPtr->transform.buf = (char *)Tcl_Alloc(bytec); memcpy(paramPtr->transform.buf, bytev, bytec); } else { paramPtr->transform.buf = NULL; @@ -2659,14 +2619,14 @@ ForwardProc( case ForwardedDrain: if (InvokeTclMethod(rtPtr, "drain", NULL, NULL, &resObj) != TCL_OK) { ForwardSetObjError(paramPtr, resObj); - paramPtr->transform.size = -1; + paramPtr->transform.size = TCL_INDEX_NONE; } else { /* * Process a regular return. Contains the transformation result. * Sent it back to the request originator. */ - int bytec; /* Number of returned bytes */ + size_t bytec = 0; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ bytev = Tcl_GetByteArrayFromObj(resObj, &bytec); @@ -2674,7 +2634,7 @@ ForwardProc( paramPtr->transform.size = bytec; if (bytec > 0) { - paramPtr->transform.buf = (char *)ckalloc(bytec); + paramPtr->transform.buf = (char *)Tcl_Alloc(bytec); memcpy(paramPtr->transform.buf, bytev, bytec); } else { paramPtr->transform.buf = NULL; @@ -2685,14 +2645,14 @@ ForwardProc( case ForwardedFlush: if (InvokeTclMethod(rtPtr, "flush", NULL, NULL, &resObj) != TCL_OK) { ForwardSetObjError(paramPtr, resObj); - paramPtr->transform.size = -1; + paramPtr->transform.size = TCL_INDEX_NONE; } else { /* * Process a regular return. Contains the transformation result. * Sent it back to the request originator. */ - int bytec; /* Number of returned bytes */ + size_t bytec = 0; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ @@ -2701,7 +2661,7 @@ ForwardProc( paramPtr->transform.size = bytec; if (bytec > 0) { - paramPtr->transform.buf = (char *)ckalloc(bytec); + paramPtr->transform.buf = (char *)Tcl_Alloc(bytec); memcpy(paramPtr->transform.buf, bytev, bytec); } else { paramPtr->transform.buf = NULL; @@ -2810,11 +2770,11 @@ ForwardSetObjError( ForwardParam *paramPtr, Tcl_Obj *obj) { - int len; - const char *msgStr = TclGetStringFromObj(obj, &len); + size_t len; + const char *msgStr = Tcl_GetStringFromObj(obj, &len); len++; - ForwardSetDynamicError(paramPtr, ckalloc(len)); + ForwardSetDynamicError(paramPtr, Tcl_Alloc(len)); memcpy(paramPtr->base.msgStr, msgStr, len); } #endif /* TCL_THREADS */ @@ -2959,7 +2919,7 @@ ResultClear( return; } - ckfree(rPtr->buf); + Tcl_Free(rPtr->buf); rPtr->buf = NULL; rPtr->allocated = 0; } @@ -2994,10 +2954,10 @@ ResultAdd( if (rPtr->allocated == 0) { rPtr->allocated = toWrite + RB_INCREMENT; - rPtr->buf = UCHARP(ckalloc(rPtr->allocated)); + rPtr->buf = UCHARP(Tcl_Alloc(rPtr->allocated)); } else { rPtr->allocated += toWrite + RB_INCREMENT; - rPtr->buf = UCHARP(ckrealloc((char *) rPtr->buf, + rPtr->buf = UCHARP(Tcl_Realloc((char *) rPtr->buf, rPtr->allocated)); } } @@ -3042,7 +3002,7 @@ ResultCopy( */ copied = 0; - } else if (rPtr->used == toRead) { + } else if (rPtr->used == (size_t)toRead) { /* * We have just enough. Copy everything to the caller. */ @@ -3050,7 +3010,7 @@ ResultCopy( memcpy(buf, rPtr->buf, toRead); rPtr->used = 0; copied = toRead; - } else if (rPtr->used > toRead) { + } else if (rPtr->used > (size_t)toRead) { /* * The internal buffer contains more than requested. Copy the * requested subset to the caller, and shift the remaining bytes down. @@ -3085,7 +3045,7 @@ TransformRead( Tcl_Obj *bufObj) { Tcl_Obj *resObj; - int bytec; /* Number of returned bytes */ + size_t bytec = 0; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ /* @@ -3109,7 +3069,7 @@ TransformRead( *errorCodePtr = EOK; ResultAdd(&rtPtr->result, UCHARP(p.transform.buf), p.transform.size); - ckfree(p.transform.buf); + Tcl_Free(p.transform.buf); return 1; } #endif /* TCL_THREADS */ @@ -3140,7 +3100,7 @@ TransformWrite( { Tcl_Obj *bufObj; Tcl_Obj *resObj; - int bytec; /* Number of returned bytes */ + size_t bytec = 0; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ int res; @@ -3166,7 +3126,7 @@ TransformWrite( *errorCodePtr = EOK; res = Tcl_WriteRaw(rtPtr->parent, (char *) p.transform.buf, p.transform.size); - ckfree(p.transform.buf); + Tcl_Free(p.transform.buf); } else #endif /* TCL_THREADS */ { @@ -3207,7 +3167,7 @@ TransformDrain( int *errorCodePtr) { Tcl_Obj *resObj; - int bytec; /* Number of returned bytes */ + size_t bytec = 0; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ /* @@ -3228,7 +3188,7 @@ TransformDrain( *errorCodePtr = EOK; ResultAdd(&rtPtr->result, UCHARP(p.transform.buf), p.transform.size); - ckfree(p.transform.buf); + Tcl_Free(p.transform.buf); } else #endif /* TCL_THREADS */ { @@ -3256,7 +3216,7 @@ TransformFlush( int op) { Tcl_Obj *resObj; - int bytec; /* Number of returned bytes */ + size_t bytec = 0; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ int res; @@ -3283,7 +3243,7 @@ TransformFlush( } else { res = 0; } - ckfree(p.transform.buf); + Tcl_Free(p.transform.buf); } else #endif /* TCL_THREADS */ { diff --git a/generic/tclIOSock.c b/generic/tclIOSock.c index eaa9cc8..f14c5c1 100644 --- a/generic/tclIOSock.c +++ b/generic/tclIOSock.c @@ -117,11 +117,15 @@ TclSockGetPort( int TclSockMinimumBuffers( void *sock, /* Socket file descriptor */ - int size) /* Minimum buffer size */ + size_t size1) /* Minimum buffer size */ { int current; socklen_t len; + int size = size1; + if ((size_t)size != size1) { + return TCL_ERROR; + } len = sizeof(int); getsockopt((SOCKET)(size_t) sock, SOL_SOCKET, SO_SNDBUF, (char *) ¤t, &len); @@ -224,7 +228,7 @@ TclCreateSocketAddress( * using AI_ADDRCONFIG is probably low even in situations where it works, * we'll leave it out for now. After all, it is just an optimisation. * - * Missing on: OpenBSD, NetBSD. + * Missing on NetBSD. * Causes failure when used on AIX 5.1 and HP-UX */ diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index ae6bc56..470977e 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -34,7 +34,7 @@ */ typedef struct FilesystemRecord { - ClientData clientData; /* Client-specific data for the filesystem + void *clientData; /* Client-specific data for the filesystem * (can be NULL) */ const Tcl_Filesystem *fsPtr;/* Pointer to filesystem dispatch table. */ struct FilesystemRecord *nextPtr; @@ -58,7 +58,7 @@ typedef struct { * the value is accessed and cwdPathEpoch has * changed. */ - ClientData cwdClientData; + void *cwdClientData; FilesystemRecord *filesystemList; size_t claims; } ThreadSpecificData; @@ -69,12 +69,12 @@ typedef struct { static Tcl_NRPostProc EvalFileCallback; static FilesystemRecord*FsGetFirstFilesystem(void); -static void FsThrExitProc(ClientData cd); +static void FsThrExitProc(void *cd); static Tcl_Obj * FsListMounts(Tcl_Obj *pathPtr, const char *pattern); static void FsAddMountsToGlobResult(Tcl_Obj *resultPtr, Tcl_Obj *pathPtr, const char *pattern, Tcl_GlobTypeData *types); -static void FsUpdateCwd(Tcl_Obj *cwdObj, ClientData clientData); +static void FsUpdateCwd(Tcl_Obj *cwdObj, void *clientData); static void FsRecacheFilesystemList(void); static void Claim(void); static void Disclaim(void); @@ -212,7 +212,7 @@ TCL_DECLARE_MUTEX(filesystemMutex) static Tcl_Obj *cwdPathPtr = NULL; static size_t cwdPathEpoch = 0; /* The pathname of the current directory */ -static ClientData cwdClientData = NULL; +static void *cwdClientData = NULL; TCL_DECLARE_MUTEX(cwdMutex) static Tcl_ThreadDataKey fsDataKey; @@ -230,7 +230,7 @@ typedef struct { Tcl_FSUnloadFileProc *unloadProcPtr; Tcl_Obj *divertedFile; const Tcl_Filesystem *divertedFilesystem; - ClientData divertedFileNativeRep; + void *divertedFileNativeRep; } FsDivertLoad; /* @@ -414,7 +414,7 @@ Tcl_EvalFile( static void FsThrExitProc( - ClientData cd) + void *cd) { ThreadSpecificData *tsdPtr = (ThreadSpecificData *)cd; FilesystemRecord *fsRecPtr = NULL, *tmpFsRecPtr = NULL; @@ -439,7 +439,7 @@ FsThrExitProc( while (fsRecPtr != NULL) { tmpFsRecPtr = fsRecPtr->nextPtr; fsRecPtr->fsPtr = NULL; - ckfree(fsRecPtr); + Tcl_Free(fsRecPtr); fsRecPtr = tmpFsRecPtr; } tsdPtr->filesystemList = NULL; @@ -521,11 +521,11 @@ TclFSCwdPointerEquals( if (tsdPtr->cwdPathPtr == *pathPtrPtr) { return 1; } else { - int len1, len2; + size_t len1, len2; const char *str1, *str2; - str1 = TclGetStringFromObj(tsdPtr->cwdPathPtr, &len1); - str2 = TclGetStringFromObj(*pathPtrPtr, &len2); + str1 = Tcl_GetStringFromObj(tsdPtr->cwdPathPtr, &len1); + str2 = Tcl_GetStringFromObj(*pathPtrPtr, &len2); if ((len1 == len2) && !memcmp(str1, str2, len1)) { /* * The values are equal but the objects are different. Cache the @@ -578,7 +578,7 @@ FsRecacheFilesystemList(void) list = NULL; fsRecPtr = tmpFsRecPtr; while (fsRecPtr != NULL) { - tmpFsRecPtr = (FilesystemRecord *)ckalloc(sizeof(FilesystemRecord)); + tmpFsRecPtr = (FilesystemRecord *)Tcl_Alloc(sizeof(FilesystemRecord)); *tmpFsRecPtr = *fsRecPtr; tmpFsRecPtr->nextPtr = list; tmpFsRecPtr->prevPtr = NULL; @@ -593,7 +593,7 @@ FsRecacheFilesystemList(void) FilesystemRecord *next = toFree->nextPtr; toFree->fsPtr = NULL; - ckfree(toFree); + Tcl_Free(toFree); toFree = next; } @@ -661,14 +661,14 @@ TclFSEpoch(void) static void FsUpdateCwd( Tcl_Obj *cwdObj, - ClientData clientData) + void *clientData) { - int len; + size_t len = 0; const char *str = NULL; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey); if (cwdObj != NULL) { - str = TclGetStringFromObj(cwdObj, &len); + str = Tcl_GetStringFromObj(cwdObj, &len); } Tcl_MutexLock(&cwdMutex); @@ -770,7 +770,7 @@ TclFinalizeFilesystem(void) */ if (fsRecPtr != &nativeFilesystemRecord) { - ckfree(fsRecPtr); + Tcl_Free(fsRecPtr); } fsRecPtr = tmpFsRecPtr; } @@ -843,7 +843,7 @@ TclResetFilesystem(void) int Tcl_FSRegister( - ClientData clientData, /* Client-specific data for this filesystem. */ + void *clientData, /* Client-specific data for this filesystem. */ const Tcl_Filesystem *fsPtr)/* The filesystem record for the new fs. */ { FilesystemRecord *newFilesystemPtr; @@ -852,7 +852,7 @@ Tcl_FSRegister( return TCL_ERROR; } - newFilesystemPtr = (FilesystemRecord *)ckalloc(sizeof(FilesystemRecord)); + newFilesystemPtr = (FilesystemRecord *)Tcl_Alloc(sizeof(FilesystemRecord)); newFilesystemPtr->clientData = clientData; newFilesystemPtr->fsPtr = fsPtr; @@ -938,7 +938,7 @@ Tcl_FSUnregister( ++theFilesystemEpoch; } - ckfree(fsRecPtr); + Tcl_Free(fsRecPtr); retVal = TCL_OK; } else { @@ -989,7 +989,8 @@ Tcl_FSMatchInDirectory( { const Tcl_Filesystem *fsPtr; Tcl_Obj *cwd, *tmpResultPtr, **elemsPtr; - int resLength, i, ret = -1; + size_t resLength, i; + int ret = -1; if (types != NULL && (types->type & TCL_GLOB_TYPE_MOUNT)) { /* @@ -1105,7 +1106,7 @@ FsAddMountsToGlobResult( * directory flag is particularly significant. */ { - int mLength, gLength, i; + size_t mLength, gLength, i; int dir = (types == NULL || (types->type & TCL_GLOB_TYPE_DIR)); Tcl_Obj *mounts = FsListMounts(pathPtr, pattern); @@ -1121,7 +1122,7 @@ FsAddMountsToGlobResult( } for (i=0 ; i<mLength ; i++) { Tcl_Obj *mElt; - int j; + size_t j; int found = 0; Tcl_ListObjIndex(NULL, mounts, i, &mElt); @@ -1145,7 +1146,7 @@ FsAddMountsToGlobResult( } if (!found && dir) { Tcl_Obj *norm; - int len, mlen; + size_t len, mlen; /* * mElt is normalized and lies inside pathPtr so @@ -1157,8 +1158,8 @@ FsAddMountsToGlobResult( if (norm != NULL) { const char *path, *mount; - mount = TclGetStringFromObj(mElt, &mlen); - path = TclGetStringFromObj(norm, &len); + mount = Tcl_GetStringFromObj(mElt, &mlen); + path = Tcl_GetStringFromObj(norm, &len); if (path[len-1] == '/') { /* * Deal with the root of the volume. @@ -1212,9 +1213,7 @@ FsAddMountsToGlobResult( * native file system; see note below). * * (4) The mapping from a string representation of a file to a full, - * normalized pathname changes. For example, if 'env(HOME)' is modified, - * then any pathname containing '~' maps to a different item, possibly in - * a different filesystem. + * normalized pathname changes. * * Tcl has no control over (2) and (3), so each registered filesystem must * call Tcl_FSMountsChnaged in each of those circumstances. @@ -1263,12 +1262,12 @@ Tcl_FSMountsChanged( *---------------------------------------------------------------------- */ -ClientData +void * Tcl_FSData( const Tcl_Filesystem *fsPtr) /* The filesystem to find in the list of * registered filesystems. */ { - ClientData retVal = NULL; + void *retVal = NULL; FilesystemRecord *fsRecPtr = FsGetFirstFilesystem(); /* @@ -1325,7 +1324,7 @@ TclFSNormalizeToUniquePath( { FilesystemRecord *fsRecPtr, *firstFsRecPtr; - int i; + size_t i; int isVfsPath = 0; const char *path; @@ -1475,7 +1474,8 @@ TclGetOpenModeEx( * configure the channel for binary * operations after opening the file. */ { - int mode, modeArgc, c, i, gotRW; + int mode, c, gotRW; + size_t modeArgc, i; const char **modeArgv, *flag; #define RW_MODES (O_RDONLY|O_WRONLY|O_RDWR) @@ -1597,7 +1597,7 @@ TclGetOpenModeEx( "access mode \"%s\" not supported by this system", flag)); } - ckfree(modeArgv); + Tcl_Free((void *)modeArgv); return -1; #endif @@ -1610,7 +1610,7 @@ TclGetOpenModeEx( "access mode \"%s\" not supported by this system", flag)); } - ckfree(modeArgv); + Tcl_Free((void *)modeArgv); return -1; #endif @@ -1626,12 +1626,12 @@ TclGetOpenModeEx( "RDWR, APPEND, BINARY, CREAT, EXCL, NOCTTY, NONBLOCK," " or TRUNC", flag)); } - ckfree(modeArgv); + Tcl_Free((void *)modeArgv); return -1; } } - ckfree(modeArgv); + Tcl_Free((void *)modeArgv); if (!gotRW) { if (interp != NULL) { @@ -1686,7 +1686,8 @@ Tcl_FSEvalFileEx( const char *encodingName) /* Either the name of an encoding or NULL to use the utf-8 encoding. */ { - int length, result = TCL_ERROR; + size_t length; + int result = TCL_ERROR; Tcl_StatBuf statBuf; Tcl_Obj *oldScriptFile; Interp *iPtr; @@ -1702,23 +1703,23 @@ Tcl_FSEvalFileEx( Tcl_SetErrno(errno); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't read file \"%s\": %s", - Tcl_GetString(pathPtr), Tcl_PosixError(interp))); + TclGetString(pathPtr), Tcl_PosixError(interp))); return result; } chan = Tcl_FSOpenFileChannel(interp, pathPtr, "r", 0644); if (chan == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't read file \"%s\": %s", - Tcl_GetString(pathPtr), Tcl_PosixError(interp))); + TclGetString(pathPtr), Tcl_PosixError(interp))); return result; } /* - * The eof character is \32 (^Z). This is standard on Windows, and Tcl - * uses it on every platform to allow for scripted documents. [Bug: 2040] + * The eof character is \x1A (^Z). Tcl uses it on every platform to allow + * for scripted documents. [Bug: 2040] */ - Tcl_SetChannelOption(interp, chan, "-eofchar", "\32 {}"); + Tcl_SetChannelOption(interp, chan, "-eofchar", "\x1A"); /* * If the encoding is specified, set the channel to that encoding. @@ -1730,7 +1731,7 @@ Tcl_FSEvalFileEx( } if (Tcl_SetChannelOption(interp, chan, "-encoding", encodingName) != TCL_OK) { - Tcl_Close(interp,chan); + Tcl_CloseEx(interp,chan,0); return result; } @@ -1742,13 +1743,13 @@ Tcl_FSEvalFileEx( */ if (Tcl_ReadChars(chan, objPtr, 1, 0) == TCL_IO_FAILURE) { - Tcl_Close(interp, chan); + Tcl_CloseEx(interp, chan, 0); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't read file \"%s\": %s", - Tcl_GetString(pathPtr), Tcl_PosixError(interp))); + TclGetString(pathPtr), Tcl_PosixError(interp))); goto end; } - string = Tcl_GetString(objPtr); + string = TclGetString(objPtr); /* * If first character is not a BOM, append the remaining characters. @@ -1757,14 +1758,14 @@ Tcl_FSEvalFileEx( if (Tcl_ReadChars(chan, objPtr, -1, memcmp(string, "\xEF\xBB\xBF", 3)) == TCL_IO_FAILURE) { - Tcl_Close(interp, chan); + Tcl_CloseEx(interp, chan, 0); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't read file \"%s\": %s", - Tcl_GetString(pathPtr), Tcl_PosixError(interp))); + TclGetString(pathPtr), Tcl_PosixError(interp))); goto end; } - if (Tcl_Close(interp, chan) != TCL_OK) { + if (Tcl_CloseEx(interp, chan, 0) != TCL_OK) { goto end; } @@ -1772,7 +1773,7 @@ Tcl_FSEvalFileEx( oldScriptFile = iPtr->scriptFile; iPtr->scriptFile = pathPtr; Tcl_IncrRefCount(iPtr->scriptFile); - string = TclGetStringFromObj(objPtr, &length); + string = Tcl_GetStringFromObj(objPtr, &length); /* * TIP #280: Open a frame for the evaluated script. @@ -1799,13 +1800,13 @@ Tcl_FSEvalFileEx( * Record information about where the error occurred. */ - const char *pathString = TclGetStringFromObj(pathPtr, &length); - int limit = 150; + const char *pathString = Tcl_GetStringFromObj(pathPtr, &length); + unsigned limit = 150; int overflow = (length > limit); Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (file \"%.*s%s\" line %d)", - (overflow ? limit : length), pathString, + (overflow ? limit : (unsigned)length), pathString, (overflow ? "..." : ""), Tcl_GetErrorLine(interp))); } @@ -1837,24 +1838,24 @@ TclNREvalFile( Tcl_SetErrno(errno); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't read file \"%s\": %s", - Tcl_GetString(pathPtr), Tcl_PosixError(interp))); + TclGetString(pathPtr), Tcl_PosixError(interp))); return TCL_ERROR; } chan = Tcl_FSOpenFileChannel(interp, pathPtr, "r", 0644); if (chan == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't read file \"%s\": %s", - Tcl_GetString(pathPtr), Tcl_PosixError(interp))); + TclGetString(pathPtr), Tcl_PosixError(interp))); return TCL_ERROR; } - TclPkgFileSeen(interp, Tcl_GetString(pathPtr)); + TclPkgFileSeen(interp, TclGetString(pathPtr)); /* - * The eof character is \32 (^Z). This is standard on Windows, and Tcl - * uses it on every platform to allow for scripted documents. [Bug: 2040] + * The eof character is \x1A (^Z). Tcl uses it on every platform to allow + * for scripted documents. [Bug: 2040] */ - Tcl_SetChannelOption(interp, chan, "-eofchar", "\32 {}"); + Tcl_SetChannelOption(interp, chan, "-eofchar", "\x1A"); /* * If the encoding is specified, set the channel to that encoding. @@ -1866,7 +1867,7 @@ TclNREvalFile( } if (Tcl_SetChannelOption(interp, chan, "-encoding", encodingName) != TCL_OK) { - Tcl_Close(interp, chan); + Tcl_CloseEx(interp, chan, 0); return TCL_ERROR; } @@ -1878,14 +1879,14 @@ TclNREvalFile( */ if (Tcl_ReadChars(chan, objPtr, 1, 0) == TCL_IO_FAILURE) { - Tcl_Close(interp, chan); + Tcl_CloseEx(interp, chan, 0); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't read file \"%s\": %s", - Tcl_GetString(pathPtr), Tcl_PosixError(interp))); + TclGetString(pathPtr), Tcl_PosixError(interp))); Tcl_DecrRefCount(objPtr); return TCL_ERROR; } - string = Tcl_GetString(objPtr); + string = TclGetString(objPtr); /* * If first character is not a BOM, append the remaining characters. @@ -1894,15 +1895,15 @@ TclNREvalFile( if (Tcl_ReadChars(chan, objPtr, -1, memcmp(string, "\xEF\xBB\xBF", 3)) == TCL_IO_FAILURE) { - Tcl_Close(interp, chan); + Tcl_CloseEx(interp, chan, 0); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't read file \"%s\": %s", - Tcl_GetString(pathPtr), Tcl_PosixError(interp))); + TclGetString(pathPtr), Tcl_PosixError(interp))); Tcl_DecrRefCount(objPtr); return TCL_ERROR; } - if (Tcl_Close(interp, chan) != TCL_OK) { + if (Tcl_CloseEx(interp, chan, 0) != TCL_OK) { Tcl_DecrRefCount(objPtr); return TCL_ERROR; } @@ -1924,7 +1925,7 @@ TclNREvalFile( static int EvalFileCallback( - ClientData data[], + void *data[], Tcl_Interp *interp, int result) { @@ -1951,14 +1952,14 @@ EvalFileCallback( * Record information about where the error occurred. */ - int length; - const char *pathString = TclGetStringFromObj(pathPtr, &length); - const int limit = 150; + size_t length; + const char *pathString = Tcl_GetStringFromObj(pathPtr, &length); + const unsigned int limit = 150; int overflow = (length > limit); Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (file \"%.*s%s\" line %d)", - (overflow ? limit : length), pathString, + (overflow ? limit : (unsigned int)length), pathString, (overflow ? "..." : ""), Tcl_GetErrorLine(interp))); } @@ -2232,9 +2233,9 @@ Tcl_FSOpenFileChannel( if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not seek to end of file while opening \"%s\": %s", - Tcl_GetString(pathPtr), Tcl_PosixError(interp))); + TclGetString(pathPtr), Tcl_PosixError(interp))); } - Tcl_Close(NULL, retVal); + Tcl_CloseEx(NULL, retVal, 0); return NULL; } if (binary) { @@ -2251,7 +2252,7 @@ Tcl_FSOpenFileChannel( if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't open \"%s\": %s", - Tcl_GetString(pathPtr), Tcl_PosixError(interp))); + TclGetString(pathPtr), Tcl_PosixError(interp))); } return NULL; } @@ -2473,7 +2474,7 @@ TclFSFileAttrIndex( * It's a non-constant attribute list, so do a literal search. */ - int i, objc; + size_t i, objc; Tcl_Obj **objv; if (TclListObjGetElementsM(NULL, listObj, &objc, &objv) != TCL_OK) { @@ -2620,7 +2621,7 @@ Tcl_FSGetCwd( Claim(); for (; (retVal == NULL) && (fsRecPtr != NULL); fsRecPtr = fsRecPtr->nextPtr) { - ClientData retCd; + void *retCd; TclFSGetCwdProc2 *proc2; if (fsRecPtr->fsPtr->getCwdProc == NULL) { @@ -2721,7 +2722,7 @@ Tcl_FSGetCwd( const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(tsdPtr->cwdPathPtr); - ClientData retCd = NULL; + void *retCd = NULL; Tcl_Obj *retVal, *norm; if (fsPtr == NULL || fsPtr->getCwdProc == NULL) { @@ -2794,11 +2795,11 @@ Tcl_FSGetCwd( * infinite loop bug when trying to normalize tsdPtr->cwdPathPtr. */ - int len1, len2; + size_t len1, len2; const char *str1, *str2; - str1 = TclGetStringFromObj(tsdPtr->cwdPathPtr, &len1); - str2 = TclGetStringFromObj(norm, &len2); + str1 = Tcl_GetStringFromObj(tsdPtr->cwdPathPtr, &len1); + str2 = Tcl_GetStringFromObj(norm, &len2); if ((len1 == len2) && (strcmp(str1, str2) == 0)) { /* * The pathname values are equal so retain the old pathname @@ -2923,8 +2924,8 @@ Tcl_FSChdir( } if (fsPtr == &tclNativeFilesystem) { - ClientData cd; - ClientData oldcd = tsdPtr->cwdClientData; + void *cd; + void *oldcd = tsdPtr->cwdClientData; /* * Assume that the native filesystem has a getCwdProc and that it @@ -3134,7 +3135,7 @@ skipUnlink( */ #define AUFS_SUPER_MAGIC ('a' << 24 | 'u' << 16 | 'f' << 8 | 's') #endif /* AUFS_SUPER_MAGIC */ - if ((statfs(Tcl_GetString(shlibFile), &fs) == 0) + if ((statfs(TclGetString(shlibFile), &fs) == 0) && (fs.f_type == AUFS_SUPER_MAGIC)) { return 1; } @@ -3210,7 +3211,7 @@ Tcl_LoadFile( if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't load library \"%s\": %s", - Tcl_GetString(pathPtr), Tcl_PosixError(interp))); + TclGetString(pathPtr), Tcl_PosixError(interp))); } return TCL_ERROR; } @@ -3247,11 +3248,11 @@ Tcl_LoadFile( } buffer = TclpLoadMemoryGetBuffer(interp, size); if (!buffer) { - Tcl_Close(interp, data); + Tcl_CloseEx(interp, data, 0); goto mustCopyToTempAnyway; } ret = Tcl_Read(data, (char *)buffer, size); - Tcl_Close(interp, data); + Tcl_CloseEx(interp, data, 0); ret = TclpLoadMemory(interp, buffer, size, ret, handlePtr, &unloadProcPtr, flags); if (ret == TCL_OK && *handlePtr != NULL) { @@ -3365,7 +3366,7 @@ Tcl_LoadFile( * Divert the unloading in order to unload and cleanup the temporary file. */ - tvdlPtr = (FsDivertLoad *)ckalloc(sizeof(FsDivertLoad)); + tvdlPtr = (FsDivertLoad *)Tcl_Alloc(sizeof(FsDivertLoad)); /* * Remember three pieces of information in order to clean up the diverted @@ -3406,7 +3407,7 @@ Tcl_LoadFile( copyToPtr = NULL; - divertedLoadHandle = (Tcl_LoadHandle)ckalloc(sizeof(struct Tcl_LoadHandle_)); + divertedLoadHandle = (Tcl_LoadHandle)Tcl_Alloc(sizeof(struct Tcl_LoadHandle_)); divertedLoadHandle->clientData = tvdlPtr; divertedLoadHandle->findSymbolProcPtr = DivertFindSymbol; divertedLoadHandle->unloadFileProcPtr = DivertUnloadFile; @@ -3544,8 +3545,8 @@ DivertUnloadFile( Tcl_DecrRefCount(tvdlPtr->divertedFile); } - ckfree(tvdlPtr); - ckfree(loadHandle); + Tcl_Free(tvdlPtr); + Tcl_Free(loadHandle); } /* @@ -3685,7 +3686,7 @@ TclFSUnloadTempFile( Tcl_DecrRefCount(tvdlPtr->divertedFile); } - ckfree(tvdlPtr); + Tcl_Free(tvdlPtr); } /* @@ -3875,13 +3876,13 @@ FsListMounts( Tcl_Obj * Tcl_FSSplitPath( Tcl_Obj *pathPtr, /* The pathname to split. */ - int *lenPtr) /* A place to hold the number of pathname + size_t *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 = '/'; - int driveNameLength; + size_t driveNameLength; const char *p; /* @@ -3904,7 +3905,7 @@ Tcl_FSSplitPath( if (sep != NULL) { Tcl_IncrRefCount(sep); - separator = Tcl_GetString(sep)[0]; + separator = TclGetString(sep)[0]; Tcl_DecrRefCount(sep); } } @@ -3916,7 +3917,7 @@ Tcl_FSSplitPath( */ TclNewObj(result); - p = Tcl_GetString(pathPtr); + p = TclGetString(pathPtr); Tcl_ListObjAppendElement(NULL, result, Tcl_NewStringObj(p, driveNameLength)); p += driveNameLength; @@ -3927,7 +3928,7 @@ Tcl_FSSplitPath( for (;;) { const char *elementStart = p; - int length; + size_t length; while ((*p != '\0') && (*p != separator)) { p++; @@ -3935,14 +3936,8 @@ Tcl_FSSplitPath( length = p - elementStart; if (length > 0) { Tcl_Obj *nextElt; - - if (elementStart[0] == '~') { - TclNewLiteralStringObj(nextElt, "./"); - Tcl_AppendToObj(nextElt, elementStart, length); - } else { - nextElt = Tcl_NewStringObj(elementStart, length); - } - Tcl_ListObjAppendElement(NULL, result, nextElt); + nextElt = Tcl_NewStringObj(elementStart, length); + Tcl_ListObjAppendElement(NULL, result, nextElt); } if (*p++ == '\0') { break; @@ -3978,15 +3973,15 @@ TclGetPathType( /* If not NULL, a place in which to store a * pointer to the filesystem for this pathname * if it is absolute. */ - int *driveNameLengthPtr, /* If not NULL, a place in which to store the + size_t *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. */ { - int pathLen; - const char *path = TclGetStringFromObj(pathPtr, &pathLen); + size_t pathLen; + const char *path = Tcl_GetStringFromObj(pathPtr, &pathLen); Tcl_PathType type; type = TclFSNonnativePathType(path, pathLen, filesystemPtrPtr, @@ -4027,12 +4022,12 @@ TclGetPathType( Tcl_PathType TclFSNonnativePathType( const char *path, /* Pathname to determine the type of. */ - int pathLen, /* Length of the pathname. */ + size_t 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. */ - int *driveNameLengthPtr, /* If not NULL, a place to store the length of + size_t *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 @@ -4069,7 +4064,7 @@ TclFSNonnativePathType( if ((fsRecPtr->fsPtr != &tclNativeFilesystem) && (fsRecPtr->fsPtr->listVolumesProc != NULL)) { - int numVolumes; + size_t numVolumes; Tcl_Obj *thisFsVolumes = fsRecPtr->fsPtr->listVolumesProc(); if (thisFsVolumes != NULL) { @@ -4084,16 +4079,16 @@ TclFSNonnativePathType( * Tcl_Panic seems a bit excessive. */ - numVolumes = -1; + numVolumes = TCL_INDEX_NONE; } - while (numVolumes > 0) { + while (numVolumes + 1 > 1) { Tcl_Obj *vol; - int len; + size_t len; const char *strVol; numVolumes--; Tcl_ListObjIndex(NULL, thisFsVolumes, numVolumes, &vol); - strVol = TclGetStringFromObj(vol,&len); + strVol = Tcl_GetStringFromObj(vol,&len); if (pathLen < len) { continue; } @@ -4254,7 +4249,7 @@ TclCrossFilesystemCopy( * Could not open an input channel. Why didn't the caller check this? */ - Tcl_Close(interp, out); + Tcl_CloseEx(interp, out, 0); goto done; } @@ -4271,8 +4266,8 @@ TclCrossFilesystemCopy( * If the copy failed, assume that copy channel left an error message. */ - Tcl_Close(interp, in); - Tcl_Close(interp, out); + Tcl_CloseEx(interp, in, 0); + Tcl_CloseEx(interp, out, 0); /* * Set modification date of copied file. @@ -4435,14 +4430,14 @@ Tcl_FSRemoveDirectory( Tcl_Obj *cwdPtr = Tcl_FSGetCwd(NULL); if (cwdPtr != NULL) { const char *cwdStr, *normPathStr; - int cwdLen, normLen; + size_t cwdLen, normLen; Tcl_Obj *normPath = Tcl_FSGetNormalizedPath(NULL, pathPtr); if (normPath != NULL) { - normPathStr = TclGetStringFromObj(normPath, &normLen); - cwdStr = TclGetStringFromObj(cwdPtr, &cwdLen); + normPathStr = Tcl_GetStringFromObj(normPath, &normLen); + cwdStr = Tcl_GetStringFromObj(cwdPtr, &cwdLen); if ((cwdLen >= normLen) && (strncmp(normPathStr, cwdStr, - (size_t) normLen) == 0)) { + normLen) == 0)) { /* * The cwd is inside the directory to be removed. Change * the cwd to [file dirname $path]. @@ -4523,7 +4518,7 @@ Tcl_FSGetFileSystemForPath( * corresponding filesystem is found. */ for (; fsRecPtr!=NULL ; fsRecPtr=fsRecPtr->nextPtr) { - ClientData clientData = NULL; + void *clientData = NULL; if (fsRecPtr->fsPtr->pathInFilesystemProc == NULL) { continue; @@ -4580,9 +4575,9 @@ Tcl_FSGetNativePath( static void NativeFreeInternalRep( - ClientData clientData) + void *clientData) { - ckfree(clientData); + Tcl_Free(clientData); } /* diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c index 79be731..58bcc04 100644 --- a/generic/tclIndexObj.c +++ b/generic/tclIndexObj.c @@ -41,7 +41,8 @@ static const Tcl_ObjType indexType = { FreeIndex, /* freeIntRepProc */ DupIndex, /* dupIntRepProc */ UpdateStringOfIndex, /* updateStringProc */ - NULL /* setFromAnyProc */ + NULL, /* setFromAnyProc */ + TCL_OBJTYPE_V0 }; /* @@ -54,8 +55,8 @@ static const Tcl_ObjType indexType = { typedef struct { void *tablePtr; /* Pointer to the table of strings */ - int offset; /* Offset between table entries */ - int index; /* Selected index into table. */ + size_t offset; /* Offset between table entries */ + size_t index; /* Selected index into table. */ } IndexRep; /* @@ -67,76 +68,7 @@ typedef struct { #define NEXT_ENTRY(table, offset) \ (&(STRING_AT(table, offset))) #define EXPAND_OF(indexRep) \ - (((indexRep)->index >= 0) ? STRING_AT((indexRep)->tablePtr, (indexRep)->offset*(indexRep)->index) : "") - -/* - *---------------------------------------------------------------------- - * - * Tcl_GetIndexFromObj -- - * - * This function looks up an object's value in a table of strings and - * returns the index of the matching string, if any. - * - * Results: - * If the value of objPtr is identical to or a unique abbreviation for - * one of the entries in tablePtr, then the return value is TCL_OK and the - * index of the matching entry is stored at *indexPtr. If there isn't a - * proper match, then TCL_ERROR is returned and an error message is left - * in interp's result (unless interp is NULL). The msg argument is used - * in the error message; for example, if msg has the value "option" then - * the error message will say something flag 'bad option "foo": must be - * ...' - * - * Side effects: - * The result of the lookup is cached as the internal rep of objPtr, so - * that repeated lookups can be done quickly. - * - *---------------------------------------------------------------------- - */ - -#ifndef TCL_NO_DEPRECATED -#undef Tcl_GetIndexFromObj -int -Tcl_GetIndexFromObj( - Tcl_Interp *interp, /* Used for error reporting if not NULL. */ - Tcl_Obj *objPtr, /* Object containing the string to lookup. */ - const char *const *tablePtr, /* Array of strings to compare against the - * value of objPtr; last entry must be NULL - * and there must not be duplicate entries. */ - const char *msg, /* Identifying word to use in error - * messages. */ - int flags, /* 0 or TCL_EXACT */ - int *indexPtr) /* Place to store resulting integer index. */ -{ - if (!(flags & TCL_INDEX_TEMP_TABLE)) { - - /* - * See if there is a valid cached result from a previous lookup (doing the - * check here saves the overhead of calling Tcl_GetIndexFromObjStruct in - * the common case where the result is cached). - */ - - const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objPtr, &indexType); - - if (irPtr) { - IndexRep *indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1; - - /* - * Here's hoping we don't get hit by unfortunate packing constraints - * on odd platforms like a Cray PVP... - */ - - if (indexRep->tablePtr == (void *)tablePtr - && indexRep->offset == sizeof(char *)) { - *indexPtr = indexRep->index; - return TCL_OK; - } - } - } - return Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, sizeof(char *), - msg, flags, indexPtr); -} -#endif /* TCL_NO_DEPRECATED */ + (((indexRep)->index != TCL_INDEX_NONE) ? STRING_AT((indexRep)->tablePtr, (indexRep)->offset*(indexRep)->index) : "") /* *---------------------------------------------------------------------- @@ -175,7 +107,8 @@ GetIndexFromObjList( int *indexPtr) /* Place to store resulting integer index. */ { - int objc, result, t; + size_t objc, t; + int result; Tcl_Obj **objv; const char **tablePtr; @@ -193,26 +126,26 @@ GetIndexFromObjList( * Build a string table from the list. */ - tablePtr = (const char **)ckalloc((objc + 1) * sizeof(char *)); + tablePtr = (const char **)Tcl_Alloc((objc + 1) * sizeof(char *)); for (t = 0; t < objc; t++) { if (objv[t] == objPtr) { /* * An exact match is always chosen, so we can stop here. */ - ckfree(tablePtr); + Tcl_Free((void *)tablePtr); *indexPtr = t; return TCL_OK; } - tablePtr[t] = Tcl_GetString(objv[t]); + tablePtr[t] = TclGetString(objv[t]); } tablePtr[objc] = NULL; result = Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, sizeof(char *), msg, flags | TCL_INDEX_TEMP_TABLE, indexPtr); - ckfree(tablePtr); + Tcl_Free((void *)tablePtr); return result; } @@ -254,13 +187,13 @@ Tcl_GetIndexFromObjStruct( * offset, the third plus the offset again, * etc. The last entry must be NULL and there * must not be duplicate entries. */ - int offset, /* The number of bytes between entries */ + size_t 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. */ { - int index, idx, numAbbrev; + size_t index, idx, numAbbrev; const char *key, *p1; const char *p2; const char *const *entryPtr; @@ -268,9 +201,9 @@ Tcl_GetIndexFromObjStruct( IndexRep *indexRep; const Tcl_ObjInternalRep *irPtr; - /* Protect against invalid values, like -1 or 0. */ - if (offset < (int)sizeof(char *)) { - offset = (int)sizeof(char *); + /* Protect against invalid values, like TCL_INDEX_NONE or 0. */ + if (offset+1 <= sizeof(char *)) { + offset = sizeof(char *); } /* * See if there is a valid cached result from a previous lookup. @@ -282,7 +215,7 @@ Tcl_GetIndexFromObjStruct( indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1; if ((indexRep->tablePtr == tablePtr) && (indexRep->offset == offset) - && (indexRep->index >= 0)) { + && (indexRep->index != TCL_INDEX_NONE)) { index = indexRep->index; goto uncachedDone; } @@ -295,7 +228,7 @@ Tcl_GetIndexFromObjStruct( */ key = objPtr ? TclGetString(objPtr) : ""; - index = -1; + index = TCL_INDEX_NONE; numAbbrev = 0; if (!*key && (flags & TCL_NULL_OK)) { @@ -345,14 +278,14 @@ Tcl_GetIndexFromObjStruct( * operation. */ - if (objPtr && (index >= 0) && !(flags & TCL_INDEX_TEMP_TABLE)) { + if (objPtr && (index != TCL_INDEX_NONE) && !(flags & TCL_INDEX_TEMP_TABLE)) { irPtr = TclFetchInternalRep(objPtr, &indexType); if (irPtr) { indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1; } else { Tcl_ObjInternalRep ir; - indexRep = (IndexRep*)ckalloc(sizeof(IndexRep)); + indexRep = (IndexRep*)Tcl_Alloc(sizeof(IndexRep)); ir.twoPtrValue.ptr1 = indexRep; Tcl_StoreInternalRep(objPtr, &indexType, &ir); } @@ -424,6 +357,9 @@ Tcl_GetIndexFromObjStruct( } return TCL_ERROR; } +/* #define again, needed below */ +#define Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags, indexPtr) \ + ((Tcl_GetIndexFromObjStruct)((interp), (objPtr), (tablePtr), (offset), (msg), (flags)|(int)(sizeof(*(indexPtr))<<1), (indexPtr))) /* *---------------------------------------------------------------------- @@ -476,7 +412,7 @@ DupIndex( Tcl_Obj *dupPtr) { Tcl_ObjInternalRep ir; - IndexRep *dupIndexRep = (IndexRep *)ckalloc(sizeof(IndexRep)); + IndexRep *dupIndexRep = (IndexRep *)Tcl_Alloc(sizeof(IndexRep)); memcpy(dupIndexRep, TclFetchInternalRep(srcPtr, &indexType)->twoPtrValue.ptr1, sizeof(IndexRep)); @@ -506,7 +442,7 @@ static void FreeIndex( Tcl_Obj *objPtr) { - ckfree(TclFetchInternalRep(objPtr, &indexType)->twoPtrValue.ptr1); + Tcl_Free(TclFetchInternalRep(objPtr, &indexType)->twoPtrValue.ptr1); objPtr->typePtr = NULL; } @@ -568,8 +504,8 @@ PrefixMatchObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int flags = 0, result, index; - int dummyLength, i, errorLength; + int flags = 0, result, dummy, i; + size_t dummyLength, errorLength; Tcl_Obj *errorPtr = NULL; const char *message = "option"; Tcl_Obj *tablePtr, *objPtr, *resultPtr; @@ -578,7 +514,7 @@ PrefixMatchObjCmd( }; enum matchOptionsEnum { PRFMATCH_ERROR, PRFMATCH_EXACT, PRFMATCH_MESSAGE - }; + } index; if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "?options? table string"); @@ -586,11 +522,11 @@ PrefixMatchObjCmd( } for (i = 1; i < (objc - 2); i++) { - if (Tcl_GetIndexFromObj(interp, objv[i], matchOptions, "option", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[i], matchOptions, + sizeof(char *), "option", 0, &index) != TCL_OK) { return TCL_ERROR; } - switch ((enum matchOptionsEnum) index) { + switch (index) { case PRFMATCH_EXACT: flags |= TCL_EXACT; break; @@ -602,7 +538,7 @@ PrefixMatchObjCmd( return TCL_ERROR; } i++; - message = Tcl_GetString(objv[i]); + message = TclGetString(objv[i]); break; case PRFMATCH_ERROR: if (i > objc-4) { @@ -642,7 +578,7 @@ PrefixMatchObjCmd( } result = GetIndexFromObjList(interp, objPtr, tablePtr, message, flags, - &index); + &dummy); if (result != TCL_OK) { if (errorPtr != NULL && errorLength == 0) { Tcl_ResetResult(interp); @@ -661,7 +597,7 @@ PrefixMatchObjCmd( return Tcl_SetReturnOptions(interp, errorPtr); } - result = Tcl_ListObjIndex(interp, tablePtr, index, &resultPtr); + result = Tcl_ListObjIndex(interp, tablePtr, dummy, &resultPtr); if (result != TCL_OK) { return result; } @@ -692,7 +628,8 @@ PrefixAllObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int tableObjc, result, t, length, elemLength; + int result; + size_t length, elemLength, tableObjc, t; const char *string, *elemString; Tcl_Obj **tableObjv, *resultPtr; @@ -706,10 +643,10 @@ PrefixAllObjCmd( return result; } resultPtr = Tcl_NewListObj(0, NULL); - string = TclGetStringFromObj(objv[2], &length); + string = Tcl_GetStringFromObj(objv[2], &length); for (t = 0; t < tableObjc; t++) { - elemString = TclGetStringFromObj(tableObjv[t], &elemLength); + elemString = Tcl_GetStringFromObj(tableObjv[t], &elemLength); /* * A prefix cannot match if it is longest. @@ -749,7 +686,8 @@ PrefixLongestObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int tableObjc, result, i, t, length, elemLength, resultLength; + int result; + size_t i, length, elemLength, resultLength, tableObjc, t; const char *string, *elemString, *resultString; Tcl_Obj **tableObjv; @@ -762,13 +700,13 @@ PrefixLongestObjCmd( if (result != TCL_OK) { return result; } - string = TclGetStringFromObj(objv[2], &length); + string = Tcl_GetStringFromObj(objv[2], &length); resultString = NULL; resultLength = 0; for (t = 0; t < tableObjc; t++) { - elemString = TclGetStringFromObj(tableObjv[t], &elemLength); + elemString = Tcl_GetStringFromObj(tableObjv[t], &elemLength); /* * First check if the prefix string matches the element. A prefix @@ -864,7 +802,7 @@ PrefixLongestObjCmd( void Tcl_WrongNumArgs( Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments to print from objv. */ + size_t 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 @@ -872,34 +810,11 @@ Tcl_WrongNumArgs( * NULL. */ { Tcl_Obj *objPtr; - int i, len, elemLen; + size_t i, len, elemLen; char flags; Interp *iPtr = (Interp *)interp; const char *elementStr; - /* - * [incr Tcl] does something fairly horrific when generating error - * messages for its ensembles; it passes the whole set of ensemble - * arguments as a list in the first argument. This means that this code - * causes a problem in iTcl if it attempts to correctly quote all - * arguments, which would be the correct thing to do. We work around this - * nasty behaviour for now, and hope that we can remove it all in the - * future... - */ - -#ifndef AVOID_HACKS_FOR_ITCL - int isFirst = 1; /* Special flag used to inhibit the treating - * of the first word as a list element so the - * hacky way Itcl generates error messages for - * its ensembles will still work. [Bug - * 1066837] */ -# define MAY_QUOTE_WORD (!isFirst) -# define AFTER_FIRST_WORD (isFirst = 0) -#else /* !AVOID_HACKS_FOR_ITCL */ -# define MAY_QUOTE_WORD 1 -# define AFTER_FIRST_WORD (void) 0 -#endif /* AVOID_HACKS_FOR_ITCL */ - TclNewObj(objPtr); if (iPtr->flags & INTERP_ALTERNATE_WRONG_ARGS) { iPtr->flags &= ~INTERP_ALTERNATE_WRONG_ARGS; @@ -915,8 +830,8 @@ Tcl_WrongNumArgs( */ if (iPtr->ensembleRewrite.sourceObjs != NULL) { - int toSkip = iPtr->ensembleRewrite.numInsertedObjs; - int toPrint = iPtr->ensembleRewrite.numRemovedObjs; + size_t toSkip = iPtr->ensembleRewrite.numInsertedObjs; + size_t toPrint = iPtr->ensembleRewrite.numRemovedObjs; Tcl_Obj *const *origObjv = TclEnsembleGetRewriteValues(interp); /* @@ -938,7 +853,7 @@ Tcl_WrongNumArgs( objc -= toSkip; /* - * We assume no object is of index type. + * Assume no object is of index type. */ for (i=0 ; i<toPrint ; i++) { @@ -953,12 +868,12 @@ Tcl_WrongNumArgs( elementStr = EXPAND_OF(indexRep); elemLen = strlen(elementStr); } else { - elementStr = TclGetStringFromObj(origObjv[i], &elemLen); + elementStr = Tcl_GetStringFromObj(origObjv[i], &elemLen); } flags = 0; len = TclScanElement(elementStr, elemLen, &flags); - if (MAY_QUOTE_WORD && len != elemLen) { + if (len != elemLen) { char *quotedElementStr = (char *)TclStackAlloc(interp, len + 1); len = TclConvertElement(elementStr, elemLen, @@ -969,14 +884,12 @@ Tcl_WrongNumArgs( Tcl_AppendToObj(objPtr, elementStr, elemLen); } - AFTER_FIRST_WORD; - /* * Add a space if the word is not the last one (which has a * moderately complex condition here). */ - if (i<toPrint-1 || objc!=0 || message!=NULL) { + if (i+1<toPrint || objc!=0 || message!=NULL) { Tcl_AppendStringsToObj(objPtr, " ", NULL); } } @@ -990,7 +903,7 @@ Tcl_WrongNumArgs( addNormalArgumentsToMessage: for (i = 0; i < objc; i++) { /* - * If the object is an index type use the index table which allows for + * If the object is an index type, use the index table which allows for * the correct error message even if the subcommand was abbreviated. * Otherwise, just use the string rep. */ @@ -1005,11 +918,11 @@ Tcl_WrongNumArgs( * Quote the argument if it contains spaces (Bug 942757). */ - elementStr = TclGetStringFromObj(objv[i], &elemLen); + elementStr = Tcl_GetStringFromObj(objv[i], &elemLen); flags = 0; len = TclScanElement(elementStr, elemLen, &flags); - if (MAY_QUOTE_WORD && len != elemLen) { + if (len != elemLen) { char *quotedElementStr = (char *)TclStackAlloc(interp, len + 1); len = TclConvertElement(elementStr, elemLen, @@ -1021,14 +934,12 @@ Tcl_WrongNumArgs( } } - AFTER_FIRST_WORD; - /* * Append a space character (" ") if there is more text to follow * (either another element from objv, or the message string). */ - if (i<objc-1 || message!=NULL) { + if (i + 1 < objc || message!=NULL) { Tcl_AppendStringsToObj(objPtr, " ", NULL); } } @@ -1045,8 +956,6 @@ Tcl_WrongNumArgs( Tcl_AppendStringsToObj(objPtr, "\"", NULL); Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); Tcl_SetObjResult(interp, objPtr); -#undef MAY_QUOTE_WORD -#undef AFTER_FIRST_WORD } /* @@ -1078,7 +987,7 @@ Tcl_ParseArgsObjv( Tcl_Interp *interp, /* Place to store error message. */ const Tcl_ArgvInfo *argTable, /* Array of option descriptions. */ - int *objcPtr, /* Number of arguments in objv. Modified to + size_t *objcPtr, /* Number of arguments in objv. Modified to * hold # args left in objv at end. */ Tcl_Obj *const *objv, /* Array of arguments to be parsed. */ Tcl_Obj ***remObjv) /* Pointer to array of arguments that were not @@ -1088,7 +997,7 @@ Tcl_ParseArgsObjv( Tcl_Obj **leftovers; /* Array to write back to remObjv on * successful exit. Will include the name of * the command. */ - int nrem; /* Size of leftovers.*/ + size_t nrem; /* Size of leftovers.*/ const Tcl_ArgvInfo *infoPtr; /* Pointer to the current entry in the table * of argument descriptions. */ @@ -1100,13 +1009,13 @@ Tcl_ParseArgsObjv( * quick check for matching; use 2nd char. * because first char. will almost always be * '-'). */ - int srcIndex; /* Location from which to read next argument + size_t srcIndex; /* Location from which to read next argument * from objv. */ - int dstIndex; /* Used to keep track of current arguments + size_t dstIndex; /* Used to keep track of current arguments * being processed, primarily for error * reporting. */ - int objc; /* # arguments in objv still to process. */ - int length; /* Number of characters in current argument */ + size_t objc; /* # arguments in objv still to process. */ + size_t length; /* Number of characters in current argument */ if (remObjv != NULL) { /* @@ -1117,7 +1026,7 @@ Tcl_ParseArgsObjv( */ nrem = 1; - leftovers = (Tcl_Obj **)ckalloc((1 + *objcPtr) * sizeof(Tcl_Obj *)); + leftovers = (Tcl_Obj **)Tcl_Alloc((1 + *objcPtr) * sizeof(Tcl_Obj *)); leftovers[0] = objv[0]; } else { nrem = 0; @@ -1135,7 +1044,7 @@ Tcl_ParseArgsObjv( curArg = objv[srcIndex]; srcIndex++; objc--; - str = TclGetStringFromObj(curArg, &length); + str = Tcl_GetStringFromObj(curArg, &length); if (length > 0) { c = str[1]; } else { @@ -1143,7 +1052,7 @@ Tcl_ParseArgsObjv( } /* - * Loop throught the argument descriptors searching for one with the + * Loop through the argument descriptors searching for one with the * matching key string. If found, leave a pointer to it in matchPtr. */ @@ -1203,7 +1112,7 @@ Tcl_ParseArgsObjv( (int *) infoPtr->dstPtr) == TCL_ERROR) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "expected integer argument for \"%s\" but got \"%s\"", - infoPtr->keyStr, Tcl_GetString(objv[srcIndex]))); + infoPtr->keyStr, TclGetString(objv[srcIndex]))); goto error; } srcIndex++; @@ -1214,7 +1123,7 @@ Tcl_ParseArgsObjv( goto missingArg; } *((const char **) infoPtr->dstPtr) = - Tcl_GetString(objv[srcIndex]); + TclGetString(objv[srcIndex]); srcIndex++; objc--; break; @@ -1236,7 +1145,7 @@ Tcl_ParseArgsObjv( (double *) infoPtr->dstPtr) == TCL_ERROR) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "expected floating-point argument for \"%s\" but got \"%s\"", - infoPtr->keyStr, Tcl_GetString(objv[srcIndex]))); + infoPtr->keyStr, TclGetString(objv[srcIndex]))); goto error; } srcIndex++; @@ -1259,14 +1168,22 @@ Tcl_ParseArgsObjv( break; } case TCL_ARGV_GENFUNC: { + int i = (int)objc; + + if (objc > INT_MAX) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "too many (%" TCL_Z_MODIFIER "u) arguments for TCL_ARGV_GENFUNC", objc)); + goto error; + } Tcl_ArgvGenFuncProc *handlerProc = (Tcl_ArgvGenFuncProc *) infoPtr->srcPtr; - objc = handlerProc(infoPtr->clientData, interp, objc, + i = handlerProc(infoPtr->clientData, interp, i, &objv[srcIndex], infoPtr->dstPtr); - if (objc < 0) { + if (i < 0) { goto error; } + objc = i; break; } case TCL_ARGV_HELP: @@ -1301,7 +1218,7 @@ Tcl_ParseArgsObjv( } leftovers[nrem] = NULL; *objcPtr = nrem++; - *remObjv = (Tcl_Obj **)ckrealloc(leftovers, nrem * sizeof(Tcl_Obj *)); + *remObjv = (Tcl_Obj **)Tcl_Realloc(leftovers, nrem * sizeof(Tcl_Obj *)); return TCL_OK; /* @@ -1314,7 +1231,7 @@ Tcl_ParseArgsObjv( "\"%s\" option requires an additional argument", str)); error: if (leftovers != NULL) { - ckfree(leftovers); + Tcl_Free(leftovers); } return TCL_ERROR; } @@ -1357,13 +1274,13 @@ PrintUsage( width = 4; for (infoPtr = argTable; infoPtr->type != TCL_ARGV_END; infoPtr++) { - int length; + size_t length; if (infoPtr->keyStr == NULL) { continue; } length = strlen(infoPtr->keyStr); - if (length > width) { + if (length > (size_t)width) { width = length; } } @@ -1446,8 +1363,8 @@ TclGetCompletionCodeFromObj( && TclGetIntFromObj(NULL, value, codePtr) == TCL_OK) { return TCL_OK; } - if (Tcl_GetIndexFromObj(NULL, value, returnCodes, NULL, TCL_EXACT, - codePtr) == TCL_OK) { + if (Tcl_GetIndexFromObjStruct(NULL, value, returnCodes, + sizeof(char *), NULL, TCL_EXACT, codePtr) == TCL_OK) { return TCL_OK; } diff --git a/generic/tclInt.decls b/generic/tclInt.decls index 4db3919..10cfbf6 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -28,24 +28,23 @@ declare 3 { void TclAllocateFreeObjects(void) } declare 5 { - int TclCleanupChildren(Tcl_Interp *interp, int numPids, Tcl_Pid *pidPtr, + int TclCleanupChildren(Tcl_Interp *interp, Tcl_Size numPids, Tcl_Pid *pidPtr, Tcl_Channel errorChan) } declare 6 { void TclCleanupCommand(Command *cmdPtr) } declare 7 { - int TclCopyAndCollapse(int count, const char *src, char *dst) + Tcl_Size TclCopyAndCollapse(Tcl_Size count, const char *src, char *dst) } -declare 8 {deprecated {}} { - int TclCopyChannelOld(Tcl_Interp *interp, Tcl_Channel inChan, - Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr) -} - +# Removed in 9.0: +#declare 8 { +# int TclCopyChannelOld(Tcl_Interp *interp, Tcl_Channel inChan, +# Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr) +#} # TclCreatePipeline unofficially exported for use by BLT. - declare 9 { - int TclCreatePipeline(Tcl_Interp *interp, int argc, const char **argv, + Tcl_Size TclCreatePipeline(Tcl_Interp *interp, Tcl_Size argc, const char **argv, Tcl_Pid **pidArrayPtr, TclFile *inPipePtr, TclFile *outPipePtr, TclFile *errFilePtr) } @@ -68,15 +67,15 @@ declare 16 { } declare 22 { int TclFindElement(Tcl_Interp *interp, const char *listStr, - int listLength, const char **elementPtr, const char **nextPtr, - int *sizePtr, int *bracePtr) + Tcl_Size listLength, const char **elementPtr, const char **nextPtr, + Tcl_Size *sizePtr, int *bracePtr) } declare 23 { Proc *TclFindProc(Interp *iPtr, const char *procName) } # Replaced with macro (see tclInt.h) in Tcl 8.5.0, restored in 8.5.10 declare 24 { - int TclFormatInt(char *buffer, Tcl_WideInt n) + Tcl_Size TclFormatInt(char *buffer, Tcl_WideInt n) } declare 25 { void TclFreePackageInfo(Interp *iPtr) @@ -91,13 +90,14 @@ declare 32 { int TclGetFrame(Tcl_Interp *interp, const char *str, CallFrame **framePtrPtr) } -declare 34 {deprecated {Use Tcl_GetIntForIndex}} { - int TclGetIntForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr, - int endValue, int *indexPtr) -} -declare 37 { - int TclGetLoadedPackages(Tcl_Interp *interp, const char *targetName) -} +# Removed in 9.0: +#declare 34 { +# int TclGetIntForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr, +# int endValue, int *indexPtr) +#} +#declare 37 { +# int TclGetLoadedPackages(Tcl_Interp *interp, const char *targetName) +#} declare 38 { int TclGetNamespaceForQualName(Tcl_Interp *interp, const char *qualName, Namespace *cxtNsPtr, int flags, Namespace **nsPtrPtr, @@ -119,19 +119,21 @@ declare 42 { declare 43 { Tcl_ObjCmdProc2 *TclGetObjInterpProc2(void) } -declare 44 { - int TclGuessPackageName(const char *fileName, Tcl_DString *bufPtr) -} +# Removed in 9.0: +#declare 44 { +# int TclGuessPackageName(const char *fileName, Tcl_DString *bufPtr) +#} declare 45 { int TclHideUnsafeCommands(Tcl_Interp *interp) } declare 46 { int TclInExit(void) } -declare 50 { - void TclInitCompiledLocals(Tcl_Interp *interp, CallFrame *framePtr, - Namespace *nsPtr) -} +# Removed in 9.0: +#declare 50 { +# void TclInitCompiledLocals(Tcl_Interp *interp, CallFrame *framePtr, +# Namespace *nsPtr) +#} declare 51 { int TclInterpInit(Tcl_Interp *interp) } @@ -169,27 +171,29 @@ declare 64 { int flags) } declare 69 { - void *TclpAlloc(unsigned int size) + void *TclpAlloc(TCL_HASH_TYPE size) } declare 74 { void TclpFree(void *ptr) } declare 75 { - unsigned long TclpGetClicks(void) + unsigned long long TclpGetClicks(void) } declare 76 { - unsigned long TclpGetSeconds(void) -} -declare 77 {deprecated {}} { - void TclpGetTime(Tcl_Time *time) + unsigned long long TclpGetSeconds(void) } +# Removed in 9.0: +#declare 77 { +# void TclpGetTime(Tcl_Time *time) +#} declare 81 { - void *TclpRealloc(void *ptr, unsigned int size) -} -declare 88 {deprecated {}} { - char *TclPrecTraceProc(void *clientData, Tcl_Interp *interp, - const char *name1, const char *name2, int flags) + void *TclpRealloc(void *ptr, TCL_HASH_TYPE size) } +# Removed in 9.0: +#declare 88 { +# char *TclPrecTraceProc(void *clientData, Tcl_Interp *interp, +# const char *name1, const char *name2, int flags) +#} declare 89 { int TclPreventAliasLoop(Tcl_Interp *interp, Tcl_Interp *cmdInterp, Tcl_Command cmd) @@ -215,9 +219,10 @@ declare 97 { declare 98 { int TclServiceIdle(void) } -declare 101 { - const char *TclSetPreInitScript(const char *string) -} +# Removed in 9.0: +#declare 101 { +# const char *TclSetPreInitScript(const char *string) +#} declare 102 { void TclSetupEnv(Tcl_Interp *interp) } @@ -225,9 +230,10 @@ declare 103 { int TclSockGetPort(Tcl_Interp *interp, const char *str, const char *proto, int *portPtr) } -declare 104 {deprecated {}} { - int TclSockMinimumBuffersOld(int sock, int size) -} +# Removed in 9.0: +#declare 104 { +# int TclSockMinimumBuffersOld(int sock, int size) +#} declare 108 { void TclTeardownNamespace(Namespace *nsPtr) } @@ -235,7 +241,7 @@ declare 109 { int TclUpdateReturnInfo(Interp *iPtr) } declare 110 { - int TclSockMinimumBuffers(void *sock, int size) + int TclSockMinimumBuffers(void *sock, Tcl_Size size) } # Procedures used in conjunction with Tcl namespaces. They are @@ -246,29 +252,30 @@ declare 111 { Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc) } -declare 112 { - int TclAppendExportList(Tcl_Interp *interp, Tcl_Namespace *nsPtr, - Tcl_Obj *objPtr) -} -declare 113 { - Tcl_Namespace *TclCreateNamespace(Tcl_Interp *interp, const char *name, - void *clientData, Tcl_NamespaceDeleteProc *deleteProc) -} -declare 114 { - void TclDeleteNamespace(Tcl_Namespace *nsPtr) -} -declare 115 { - int TclExport(Tcl_Interp *interp, Tcl_Namespace *nsPtr, - const char *pattern, int resetListFirst) -} -declare 116 { - Tcl_Command TclFindCommand(Tcl_Interp *interp, const char *name, - Tcl_Namespace *contextNsPtr, int flags) -} -declare 117 { - Tcl_Namespace *TclFindNamespace(Tcl_Interp *interp, const char *name, - Tcl_Namespace *contextNsPtr, int flags) -} +# Removed in 9.0: +#declare 112 { +# int TclAppendExportList(Tcl_Interp *interp, Tcl_Namespace *nsPtr, +# Tcl_Obj *objPtr) +#} +#declare 113 { +# Tcl_Namespace *TclCreateNamespace(Tcl_Interp *interp, const char *name, +# void *clientData, Tcl_NamespaceDeleteProc *deleteProc) +#} +#declare 114 { +# void TclDeleteNamespace(Tcl_Namespace *nsPtr) +#} +#declare 115 { +# int TclExport(Tcl_Interp *interp, Tcl_Namespace *nsPtr, +# const char *pattern, int resetListFirst) +#} +#declare 116 { +# Tcl_Command TclFindCommand(Tcl_Interp *interp, const char *name, +# Tcl_Namespace *contextNsPtr, int flags) +#} +#declare 117 { +# Tcl_Namespace *TclFindNamespace(Tcl_Interp *interp, const char *name, +# Tcl_Namespace *contextNsPtr, int flags) +#} declare 118 { int Tcl_GetInterpResolvers(Tcl_Interp *interp, const char *name, Tcl_ResolverInfo *resInfo) @@ -281,31 +288,33 @@ declare 120 { Tcl_Var Tcl_FindNamespaceVar(Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags) } -declare 121 { - int TclForgetImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr, - const char *pattern) -} -declare 122 { - Tcl_Command TclGetCommandFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr) -} -declare 123 { - void TclGetCommandFullName(Tcl_Interp *interp, Tcl_Command command, - Tcl_Obj *objPtr) -} -declare 124 { - Tcl_Namespace *TclGetCurrentNamespace_(Tcl_Interp *interp) -} -declare 125 { - Tcl_Namespace *TclGetGlobalNamespace_(Tcl_Interp *interp) -} +# Removed in 9.0: +#declare 121 { +# int TclForgetImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr, +# const char *pattern) +#} +#declare 122 { +# Tcl_Command TclGetCommandFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr) +#} +#declare 123 { +# void TclGetCommandFullName(Tcl_Interp *interp, Tcl_Command command, +# Tcl_Obj *objPtr) +#} +#declare 124 { +# Tcl_Namespace *TclGetCurrentNamespace_(Tcl_Interp *interp) +#} +#declare 125 { +# Tcl_Namespace *TclGetGlobalNamespace_(Tcl_Interp *interp) +#} declare 126 { void Tcl_GetVariableFullName(Tcl_Interp *interp, Tcl_Var variable, Tcl_Obj *objPtr) } -declare 127 { - int TclImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr, - const char *pattern, int allowOverwrite) -} +# Removed in 9.0: +#declare 127 { +# int TclImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr, +# const char *pattern, int allowOverwrite) +#} declare 128 { void Tcl_PopCallFrame(Tcl_Interp *interp) } @@ -321,12 +330,14 @@ declare 131 { Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc) } -declare 132 {deprecated {}} { - int TclpHasSockets(Tcl_Interp *interp) -} -declare 133 {deprecated {}} { - struct tm *TclpGetDate(const time_t *time, int useGMT) -} +# Removed in 9.0: +#declare 132 { +# int TclpHasSockets(Tcl_Interp *interp) +#} +# Removed in 9.0: +#declare 133 { +# struct tm *TclpGetDate(const time_t *time, int useGMT) +#} declare 138 { const char *TclGetEnv(const char *name, Tcl_DString *valuePtr) } @@ -339,7 +350,7 @@ declare 142 { CompileHookProc *hookProc, void *clientData) } declare 143 { - int TclAddLiteralObj(struct CompileEnv *envPtr, Tcl_Obj *objPtr, + Tcl_Size TclAddLiteralObj(struct CompileEnv *envPtr, Tcl_Obj *objPtr, LiteralEntry **litPtrPtr) } declare 144 { @@ -365,8 +376,8 @@ declare 150 { int TclRegAbout(Tcl_Interp *interp, Tcl_RegExp re) } declare 151 { - void TclRegExpRangeUniChar(Tcl_RegExp re, int index, int *startPtr, - int *endPtr) + void TclRegExpRangeUniChar(Tcl_RegExp re, Tcl_Size index, Tcl_Size *startPtr, + Tcl_Size *endPtr) } declare 152 { void TclSetLibraryPath(Tcl_Obj *pathPtr) @@ -381,12 +392,13 @@ declare 156 { declare 157 { Var *TclVarTraceExists(Tcl_Interp *interp, const char *varName) } -declare 158 {deprecated {use public Tcl_SetStartupScript()}} { - void TclSetStartupScriptFileName(const char *filename) -} -declare 159 {deprecated {use public Tcl_GetStartupScript()}} { - const char *TclGetStartupScriptFileName(void) -} +# Removed in 9.0: +#declare 158 { +# void TclSetStartupScriptFileName(const char *filename) +#} +#declare 159 { +# const char *TclGetStartupScriptFileName(void) +#} declare 161 { int TclChannelTransform(Tcl_Interp *interp, Tcl_Channel chan, @@ -421,35 +433,36 @@ declare 165 { # New function due to TIP #33 declare 166 { int TclListObjSetElement(Tcl_Interp *interp, Tcl_Obj *listPtr, - int index, Tcl_Obj *valuePtr) + Tcl_Size index, Tcl_Obj *valuePtr) } -declare 167 {deprecated {use public Tcl_SetStartupScript()}} { - void TclSetStartupScriptPath(Tcl_Obj *pathPtr) -} -declare 168 {deprecated {use public Tcl_GetStartupScript()}} { - Tcl_Obj *TclGetStartupScriptPath(void) -} +# Removed in 9.0: +#declare 167 { +# void TclSetStartupScriptPath(Tcl_Obj *pathPtr) +#} +#declare 168 { +# Tcl_Obj *TclGetStartupScriptPath(void) +#} # variant of Tcl_UtfNCmp that takes n as bytes, not chars declare 169 { - int TclpUtfNcmp2(const char *s1, const char *s2, unsigned long n) + int TclpUtfNcmp2(const char *s1, const char *s2, size_t n) } declare 170 { int TclCheckInterpTraces(Tcl_Interp *interp, const char *command, - int numChars, Command *cmdPtr, int result, int traceFlags, - int objc, Tcl_Obj *const objv[]) + Tcl_Size numChars, Command *cmdPtr, int result, int traceFlags, + Tcl_Size objc, Tcl_Obj *const objv[]) } declare 171 { int TclCheckExecutionTraces(Tcl_Interp *interp, const char *command, - int numChars, Command *cmdPtr, int result, int traceFlags, - int objc, Tcl_Obj *const objv[]) + Tcl_Size numChars, Command *cmdPtr, int result, int traceFlags, + Tcl_Size objc, Tcl_Obj *const objv[]) } declare 172 { int TclInThreadExit(void) } declare 173 { - int TclUniCharMatch(const Tcl_UniChar *string, int strLen, - const Tcl_UniChar *pattern, int ptnLen, int flags) + int TclUniCharMatch(const Tcl_UniChar *string, Tcl_Size strLen, + const Tcl_UniChar *pattern, Tcl_Size ptnLen, int flags) } declare 175 { int TclCallVarTraces(Interp *iPtr, Var *arrayPtr, Var *varPtr, @@ -462,18 +475,19 @@ declare 177 { void TclVarErrMsg(Tcl_Interp *interp, const char *part1, const char *part2, const char *operation, const char *reason) } -declare 178 { - void TclSetStartupScript(Tcl_Obj *pathPtr, const char *encodingName) -} -declare 179 { - Tcl_Obj *TclGetStartupScript(const char **encodingNamePtr) -} -declare 182 {deprecated {}} { - struct tm *TclpLocaltime(const time_t *clock) -} -declare 183 {deprecated {}} { - struct tm *TclpGmtime(const time_t *clock) -} +# Removed in 9.0: +#declare 178 { +# void TclSetStartupScript(Tcl_Obj *pathPtr, const char *encodingName) +#} +#declare 179 { +# Tcl_Obj *TclGetStartupScript(const char **encodingNamePtr) +#} +#declare 182 { +# struct tm *TclpLocaltime(const time_t *clock) +#} +#declare 183 { +# struct tm *TclpGmtime(const time_t *clock) +#} # For the new "Thread Storage" subsystem. @@ -512,16 +526,6 @@ declare 208 { Tcl_Channel TclpOpenFileChannel(Tcl_Interp *interp, Tcl_Obj *pathPtr, int mode, int permissions) } -# Made public by TIP 258 -#declare 209 { -# Tcl_Obj *TclGetEncodingSearchPath(void) -#} -#declare 210 { -# int TclSetEncodingSearchPath(Tcl_Obj *searchPath) -#} -#declare 211 { -# const char *TclpGetEncodingNameFromEnvironment(Tcl_DString *bufPtr) -#} declare 212 { void TclpFindExecutable(const char *argv0) } @@ -532,7 +536,7 @@ declare 214 { void TclSetObjNameOfExecutable(Tcl_Obj *name, Tcl_Encoding encoding) } declare 215 { - void *TclStackAlloc(Tcl_Interp *interp, int numBytes) + void *TclStackAlloc(Tcl_Interp *interp, Tcl_Size numBytes) } declare 216 { void TclStackFree(Tcl_Interp *interp, void *freePtr) @@ -551,13 +555,13 @@ declare 224 { } declare 225 { Tcl_Obj *TclTraceDictPath(Tcl_Interp *interp, Tcl_Obj *rootPtr, - int keyc, Tcl_Obj *const keyv[], int flags) + Tcl_Size keyc, Tcl_Obj *const keyv[], int flags) } declare 226 { int TclObjBeingDeleted(Tcl_Obj *objPtr) } declare 227 { - void TclSetNsPath(Namespace *nsPtr, int pathLength, + void TclSetNsPath(Namespace *nsPtr, Tcl_Size pathLength, Tcl_Namespace *pathAry[]) } declare 229 { @@ -591,9 +595,10 @@ declare 234 { declare 235 { void TclInitVarHashTable(TclVarHashTable *tablePtr, Namespace *nsPtr) } -declare 236 {deprecated {use Tcl_BackgroundException}} { - void TclBackgroundException(Tcl_Interp *interp, int code) -} +# Removed in 9.0: +#declare 236 { +# void TclBackgroundException(Tcl_Interp *interp, int code) +#} # TIP #285: Script cancellation support. declare 237 { @@ -608,7 +613,7 @@ declare 238 { } declare 239 { int TclNRInterpProcCore(Tcl_Interp *interp, Tcl_Obj *procNameObj, - int skip, ProcErrorProc *errorProc) + Tcl_Size skip, ProcErrorProc *errorProc) } declare 240 { int TclNRRunCallbacks(Tcl_Interp *interp, int result, @@ -619,7 +624,7 @@ declare 241 { const CmdFrame *invoker, int word) } declare 242 { - int TclNREvalObjv(Tcl_Interp *interp, int objc, + int TclNREvalObjv(Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const objv[], int flags, Command *cmdPtr) } @@ -636,8 +641,8 @@ declare 245 { Tcl_HashTable *TclGetNamespaceCommandTable(Tcl_Namespace *nsPtr) } declare 246 { - int TclInitRewriteEnsemble(Tcl_Interp *interp, int numRemoved, - int numInserted, Tcl_Obj *const *objv) + int TclInitRewriteEnsemble(Tcl_Interp *interp, Tcl_Size numRemoved, + Tcl_Size numInserted, Tcl_Obj *const *objv) } declare 247 { void TclResetRewriteEnsemble(Tcl_Interp *interp, int isRootEnsemble) @@ -659,8 +664,8 @@ declare 250 { # Allow extensions for optimization declare 251 { - int TclRegisterLiteral(void *envPtr, - const char *bytes, int length, int flags) + Tcl_Size TclRegisterLiteral(void *envPtr, + const char *bytes, Tcl_Size length, int flags) } # Exporting of the internal API to variables. @@ -717,198 +722,68 @@ declare 261 { interface tclIntPlat ################################ -# Windows specific functions - -declare 0 win { - void TclWinConvertError(DWORD errCode) -} -declare 1 win { - void TclWinConvertWSAError(DWORD errCode) -} -declare 2 win { - struct servent *TclWinGetServByName(const char *nm, - const char *proto) -} -declare 3 win { - int TclWinGetSockOpt(SOCKET s, int level, int optname, - char *optval, int *optlen) -} -declare 4 win { - HINSTANCE TclWinGetTclInstance(void) -} -declare 5 win { - int TclUnixWaitForFile(int fd, int mask, int timeout) -} -declare 6 win { - unsigned short TclWinNToHS(unsigned short ns) -} -declare 7 win { - int TclWinSetSockOpt(SOCKET s, int level, int optname, - const char *optval, int optlen) -} -declare 8 win { - int TclpGetPid(Tcl_Pid pid) -} -declare 9 win { - int TclWinGetPlatformId(void) -} -declare 10 win { - Tcl_DirEntry *TclpReaddir(TclDIR *dir) -} - -# Pipe channel functions +# Platform specific functions -declare 11 win { - void TclGetAndDetachPids(Tcl_Interp *interp, Tcl_Channel chan) -} -declare 12 win { +# Removed in 9.0 +#declare 0 {unix win} { +# void TclWinConvertError(unsigned errCode) +#} +declare 1 { int TclpCloseFile(TclFile file) } -declare 13 win { +declare 2 { Tcl_Channel TclpCreateCommandChannel(TclFile readFile, - TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr) + TclFile writeFile, TclFile errorFile, size_t numPids, Tcl_Pid *pidPtr) } -declare 14 win { +declare 3 { int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe) } -declare 15 win { - int TclpCreateProcess(Tcl_Interp *interp, int argc, - const char **argv, TclFile inputFile, TclFile outputFile, - TclFile errorFile, Tcl_Pid *pidPtr) -} -declare 16 win { - int TclpIsAtty(int fd) +declare 4 { + void *TclWinGetTclInstance(void) } -declare 17 win { - int TclUnixCopyFile(const char *src, const char *dst, - const Tcl_StatBuf *statBufPtr, int dontCopyAtts) +declare 5 { + int TclUnixWaitForFile(int fd, int mask, int timeout) } -declare 18 win { +declare 6 { TclFile TclpMakeFile(Tcl_Channel channel, int direction) } -declare 19 win { +declare 7 { TclFile TclpOpenFile(const char *fname, int mode) } -declare 20 win { - void TclWinAddProcess(HANDLE hProcess, DWORD id) +declare 8 { + size_t TclpGetPid(Tcl_Pid pid) } -declare 21 win { - char *TclpInetNtoa(struct in_addr addr) -} -declare 22 win { +declare 9 { TclFile TclpCreateTempFile(const char *contents) } -declare 24 win { - char *TclWinNoBackslash(char *path) -} -declare 26 win { - void TclWinSetInterfaces(int wide) -} -declare 27 win { - void TclWinFlushDirtyChannels(void) -} -declare 28 win { - void TclWinResetInterfaces(void) -} - -################################ -# Unix specific functions - -# Pipe channel functions - -declare 0 unix { +declare 11 { void TclGetAndDetachPids(Tcl_Interp *interp, Tcl_Channel chan) } -declare 1 unix { - int TclpCloseFile(TclFile file) -} -declare 2 unix { - Tcl_Channel TclpCreateCommandChannel(TclFile readFile, - TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr) -} -declare 3 unix { - int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe) -} -declare 4 unix { - int TclpCreateProcess(Tcl_Interp *interp, int argc, +declare 15 { + int TclpCreateProcess(Tcl_Interp *interp, size_t argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr) } -declare 5 unix { - int TclUnixWaitForFile_(int fd, int mask, int timeout) -} -declare 6 unix { - TclFile TclpMakeFile(Tcl_Channel channel, int direction) -} -declare 7 unix { - TclFile TclpOpenFile(const char *fname, int mode) -} -declare 8 unix { - int TclUnixWaitForFile(int fd, int mask, int timeout) -} - -# Added in 8.1: - -declare 9 unix { - TclFile TclpCreateTempFile(const char *contents) -} - -# Added in 8.4: - -declare 10 unix { - Tcl_DirEntry *TclpReaddir(TclDIR *dir) -} -# Slots 11 and 12 are forwarders for functions that were promoted to -# generic Stubs -declare 11 unix { - struct tm *TclpLocaltime_unix(const time_t *clock) -} -declare 12 unix { - struct tm *TclpGmtime_unix(const time_t *clock) -} -declare 13 unix { - char *TclpInetNtoa(struct in_addr addr) +declare 16 { + int TclpIsAtty(int fd) } - -# Added in 8.5: - -declare 14 unix { +declare 17 { int TclUnixCopyFile(const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts) } - -################################ -# Mac OS X specific functions - -declare 15 {unix macosx} { - int TclMacOSXGetFileAttribute(Tcl_Interp *interp, int objIndex, - Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr) -} -declare 16 {unix macosx} { - int TclMacOSXSetFileAttribute(Tcl_Interp *interp, int objIndex, - Tcl_Obj *fileName, Tcl_Obj *attributePtr) -} -declare 17 {unix macosx} { - int TclMacOSXCopyFileAttributes(const char *src, const char *dst, - const Tcl_StatBuf *statBufPtr) -} -declare 18 {unix macosx} { - int TclMacOSXMatchType(Tcl_Interp *interp, const char *pathName, - const char *fileName, Tcl_StatBuf *statBufPtr, - Tcl_GlobTypeData *types) +declare 20 { + void TclWinAddProcess(void *hProcess, size_t id) } -declare 19 {unix macosx} { - void TclMacOSXNotifierAddRunLoopMode(const void *runLoopMode) +declare 24 { + char *TclWinNoBackslash(char *path) } -declare 22 {unix macosx} { - TclFile TclpCreateTempFile_(const char *contents) +declare 27 { + void TclWinFlushDirtyChannels(void) } - -declare 29 {win unix} { +declare 29 { int TclWinCPUID(int index, int *regs) } -# Added in 8.6; core of TclpOpenTemporaryFile -declare 30 {win unix} { +declare 30 { int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj) } diff --git a/generic/tclInt.h b/generic/tclInt.h index 31c7fcb..650ea2d 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -26,20 +26,6 @@ #undef ACCEPT_NAN /* - * In Tcl 8.7, stop supporting special hacks for legacy Itcl 3. - * Itcl 4 doesn't need them. Itcl 3 can be updated to not need them - * using the Tcl(Init|Reset)RewriteEnsemble() routines in all Tcl 8.6+ - * releases. Perhaps Tcl 8.7 will add even better public interfaces - * supporting all the re-invocation mechanisms extensions like Itcl 3 - * need. As an absolute last resort, folks who must make Itcl 3 work - * unchanged with Tcl 8.7 can remove this line to regain the migration - * support. Tcl 9 will no longer offer even that option. - */ - -#define AVOID_HACKS_FOR_ITCL 1 - - -/* * Used to tag functions that are only to be visible within the module being * built and not outside it (where this is supported by the linker). * Also used in the platform-specific *Port.h files. @@ -79,6 +65,7 @@ #include <stdio.h> #include <ctype.h> +#include <stdarg.h> #ifdef NO_STDLIB_H # include "../compat/stdlib.h" #else @@ -118,6 +105,12 @@ #endif /* + * 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) + +/* * Macros used to cast between pointers and integers (e.g. when storing an int * in ClientData), on 64-bit architectures they avoid gcc warning about "cast * to/from pointer from/to integer of different size". @@ -214,9 +207,6 @@ typedef struct Tcl_ResolverInfo { * - Bug #696893 - variable is either proc-local or in the current * namespace; never follow the second (global) resolution path * - Bug #631741 - do not use special namespace or interp resolvers - * - * It should also not collide with the (deprecated) TCL_PARSE_PART1 flag - * (Bug #835020) */ #define TCL_AVOID_RESOLVERS 0x40000 @@ -231,15 +221,18 @@ typedef struct Tcl_Ensemble Tcl_Ensemble; typedef struct NamespacePathEntry NamespacePathEntry; /* - * Special hashtable for variables: this is just a Tcl_HashTable with an nsPtr - * field added at the end: in this way variables can find their namespace - * without having to copy a pointer in their struct: they can access it via - * their hPtr->tablePtr. + * 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 + * namespace and possibly containing array without having to copy a pointer in + * their struct: they can access them via their hPtr->tablePtr. */ typedef struct TclVarHashTable { Tcl_HashTable table; struct Namespace *nsPtr; +#if TCL_MAJOR_VERSION > 8 + struct Var *arrayPtr; +#endif /* TCL_MAJOR_VERSION > 8 */ } TclVarHashTable; /* @@ -289,7 +282,11 @@ typedef struct Namespace { * strings; values have type (Namespace *). If * NULL, there are no children. */ #endif - unsigned long nsId; /* Unique id for the namespace. */ +#if TCL_MAJOR_VERSION > 8 + size_t nsId; /* Unique id for the namespace. */ +#else + unsigned long nsId; +#endif Tcl_Interp *interp; /* The interpreter containing this * namespace. */ int flags; /* OR-ed combination of the namespace status @@ -631,7 +628,7 @@ typedef struct Var { TclVarHashTable *tablePtr;/* For array variables, this points to * information about the hash table used to * implement the associative array. Points to - * ckalloc-ed data. */ + * Tcl_Alloc-ed data. */ struct Var *linkPtr; /* If this is a global variable being referred * to in a procedure, or a variable created by * "upvar", this field points to the @@ -829,6 +826,14 @@ typedef struct VarInHash { * MODULE_SCOPE int TclIsVarResolved(Var *varPtr); */ +#define TclVarFindHiddenArray(varPtr,arrayPtr) \ + do { \ + if ((arrayPtr == NULL) && TclIsVarInHash(varPtr) && \ + (TclVarParentArray(varPtr) != NULL)) { \ + arrayPtr = TclVarParentArray(varPtr); \ + } \ + } while(0) + #define TclIsVarScalar(varPtr) \ !((varPtr)->flags & (VAR_ARRAY|VAR_LINK)) @@ -873,26 +878,38 @@ typedef struct VarInHash { ? ((TclVarHashTable *) ((((VarInHash *) (varPtr))->entry.tablePtr)))->nsPtr \ : NULL) +#define TclVarParentArray(varPtr) \ + ((TclVarHashTable *) ((VarInHash *) (varPtr))->entry.tablePtr)->arrayPtr + #define VarHashRefCount(varPtr) \ ((VarInHash *) (varPtr))->refCount +#define VarHashGetKey(varPtr) \ + (((VarInHash *)(varPtr))->entry.key.objPtr) + /* * Macros for direct variable access by TEBC. */ -#define TclIsVarDirectReadable(varPtr) \ - ( !((varPtr)->flags & (VAR_ARRAY|VAR_LINK|VAR_TRACED_READ)) \ - && (varPtr)->value.objPtr) +#define TclIsVarTricky(varPtr,trickyFlags) \ + ( ((varPtr)->flags & (VAR_ARRAY|VAR_LINK|trickyFlags)) \ + || (TclIsVarInHash(varPtr) \ + && (TclVarParentArray(varPtr) != NULL) \ + && (TclVarParentArray(varPtr)->flags & (trickyFlags)))) + +#define TclIsVarDirectReadable(varPtr) \ + ( (!TclIsVarTricky(varPtr,VAR_TRACED_READ)) \ + && (varPtr)->value.objPtr) #define TclIsVarDirectWritable(varPtr) \ - !((varPtr)->flags & (VAR_ARRAY|VAR_LINK|VAR_TRACED_WRITE|VAR_DEAD_HASH)) + (!TclIsVarTricky(varPtr,VAR_TRACED_WRITE|VAR_DEAD_HASH)) #define TclIsVarDirectUnsettable(varPtr) \ - !((varPtr)->flags & (VAR_ARRAY|VAR_LINK|VAR_TRACED_READ|VAR_TRACED_WRITE|VAR_TRACED_UNSET|VAR_DEAD_HASH)) + (!TclIsVarTricky(varPtr,VAR_TRACED_READ|VAR_TRACED_WRITE|VAR_TRACED_UNSET|VAR_DEAD_HASH)) #define TclIsVarDirectModifyable(varPtr) \ - ( !((varPtr)->flags & (VAR_ARRAY|VAR_LINK|VAR_TRACED_READ|VAR_TRACED_WRITE)) \ - && (varPtr)->value.objPtr) + ( (!TclIsVarTricky(varPtr,VAR_TRACED_READ|VAR_TRACED_WRITE)) \ + && (varPtr)->value.objPtr) #define TclIsVarDirectReadable2(varPtr, arrayPtr) \ (TclIsVarDirectReadable(varPtr) &&\ @@ -950,10 +967,9 @@ typedef struct CompiledLocal { * Among others used to speed up var lookups. */ Tcl_Size frameIndex; /* Index in the array of compiler-assigned * variables in the procedure call frame. */ - int flags; /* Flag bits for the local variable. Same as - * the flags for the Var structure above, - * although only VAR_ARGUMENT, VAR_TEMPORARY, - * and VAR_RESOLVED make sense. */ +#if TCL_MAJOR_VERSION < 9 + int flags; +#endif Tcl_Obj *defValuePtr; /* Pointer to the default value of an * argument, if any. NULL if not an argument * or, if an argument, no default value. */ @@ -964,6 +980,12 @@ typedef struct CompiledLocal { * is marked by a unique tag during * compilation, and that same tag is used to * find the variable at runtime. */ +#if TCL_MAJOR_VERSION > 8 + int flags; /* Flag bits for the local variable. Same as + * the flags for the Var structure above, + * although only VAR_ARGUMENT, VAR_TEMPORARY, + * and VAR_RESOLVED make sense. */ +#endif char name[TCLFLEXARRAY]; /* Name of the local variable starts here. If * the name is NULL, this will just be '\0'. * The actual size of this field will be large @@ -1021,7 +1043,11 @@ typedef void (ProcErrorProc)(Tcl_Interp *interp, Tcl_Obj *procNameObj); typedef struct Trace { Tcl_Size level; /* Only trace commands at nesting level less * than or equal to this. */ +#if TCL_MAJOR_VERSION > 8 + Tcl_CmdObjTraceProc2 *proc; /* Procedure to call to trace command. */ +#else Tcl_CmdObjTraceProc *proc; /* Procedure to call to trace command. */ +#endif void *clientData; /* Arbitrary value to pass to proc. */ struct Trace *nextPtr; /* Next in list of traces for this interp. */ int flags; /* Flags governing the trace - see @@ -1424,14 +1450,8 @@ struct CompileEnv; * reporting is deferred until the actual runtime, * because by then changes in the interp state may allow * the command to be successfully evaluated. - * TCL_OUT_LINE_COMPILE A source-compatible alias for TCL_ERROR, kept for the - * sake of old code only. */ -#ifndef TCL_NO_DEPRECATED -# define TCL_OUT_LINE_COMPILE TCL_ERROR -#endif - typedef int (CompileProc)(Tcl_Interp *interp, Tcl_Parse *parsePtr, struct Command *cmdPtr, struct CompileEnv *compEnvPtr); @@ -1732,9 +1752,6 @@ typedef struct Command { */ #define CMD_DYING 0x01 -#ifndef TCL_NO_DEPRECATED -# define CMD_IS_DELETED 0x01 /* Same as CMD_DYING */ -#endif #define CMD_TRACE_ACTIVE 0x02 #define CMD_HAS_EXEC_TRACES 0x04 #define CMD_COMPILES_EXPANDED 0x08 @@ -1818,41 +1835,31 @@ typedef struct AllocCache { typedef struct Interp { /* - * Note: the first three fields must match exactly the fields in a - * Tcl_Interp struct (see tcl.h). If you change one, be sure to change the - * other. - * - * The interpreter's result is held in both the string and the - * objResultPtr fields. These fields hold, respectively, the result's - * string or object value. The interpreter's result is always in the - * result field if that is non-empty, otherwise it is in objResultPtr. - * The two fields are kept consistent unless some C code sets - * interp->result directly. Programs should not access result and - * objResultPtr directly; instead, they should always get and set the - * result using procedures such as Tcl_SetObjResult, Tcl_GetObjResult, and - * Tcl_GetStringResult. See the SetResult man page for details. + * The first two fields were named "result" and "freeProc" in earlier + * versions of Tcl. They are no longer used within Tcl, and are no + * longer available to be accessed by extensions. However, they cannot + * be removed. Why? There is a deployed base of stub-enabled extensions + * that query the value of iPtr->stubTable. For them to continue to work, + * the location of the field "stubTable" within the Interp struct cannot + * change. The most robust way to assure that is to leave all fields up to + * that one undisturbed. */ - char *result; /* If the last command returned a string - * result, this points to it. Should not be - * accessed directly; see comment above. */ - Tcl_FreeProc *freeProc; /* Zero means a string result is statically - * allocated. TCL_DYNAMIC means string result - * was allocated with ckalloc and should be - * freed with ckfree. Other values give - * address of procedure to invoke to free the - * string result. Tcl_Eval must free it before - * executing next command. */ + const char *legacyResult; + void (*legacyFreeProc) (void); int errorLine; /* When TCL_ERROR is returned, this gives the * line number in the command where the error * occurred (1 means first line). */ const struct TclStubs *stubTable; - /* Pointer to the exported Tcl stub table. On - * previous versions of Tcl this is a pointer - * to the objResultPtr or a pointer to a - * buckets array in a hash table. We therefore - * have to do some careful checking before we - * can use this. */ + /* Pointer to the exported Tcl stub table. In + * ancient pre-8.1 versions of Tcl this was a + * pointer to the objResultPtr or a pointer to a + * buckets array in a hash table. Deployed stubs + * enabled extensions check for a NULL pointer value + * and for a TCL_STUBS_MAGIC value to verify they + * are not [load]ing into one of those pre-stubs + * interps. + */ TclHandle handle; /* Handle used to keep track of when this * interp is deleted. */ @@ -1865,6 +1872,9 @@ typedef struct Interp { void *interpInfo; /* Information used by tclInterp.c to keep * track of parent/child interps on a * per-interp basis. */ +#if TCL_MAJOR_VERSION > 8 + void (*optimizer)(void *envPtr); +#else union { void (*optimizer)(void *envPtr); Tcl_HashTable unused2; /* No longer used (was mathFuncTable). The @@ -1873,6 +1883,7 @@ typedef struct Interp { * contains one optimizer, which can be * selectively overridden by extensions. */ } extra; +#endif /* * Information related to procedures and variables. See tclProc.c and * tclVar.c for usage. @@ -1901,20 +1912,7 @@ typedef struct Interp { Namespace *lookupNsPtr; /* Namespace to use ONLY on the next * TCL_EVAL_INVOKE call to Tcl_EvalObjv. */ - /* - * Information used by Tcl_AppendResult to keep track of partial results. - * See Tcl_AppendResult code for details. - */ - -#if !defined(TCL_NO_DEPRECATED) - char *appendResult; /* Storage space for results generated by - * Tcl_AppendResult. Ckalloc-ed. NULL means - * not yet allocated. */ - int appendAvl; /* Total amount of space available at - * partialResult. */ - int appendUsed; /* Number of non-null bytes currently stored - * at partialResult. */ -#else +#if TCL_MAJOR_VERSION < 9 char *appendResultDontUse; int appendAvlDontUse; int appendUsedDontUse; @@ -1942,7 +1940,9 @@ typedef struct Interp { * Normally zero, but may be set before * calling Tcl_Eval. See below for valid * values. */ +#if TCL_MAJOR_VERSION < 9 int unused1; /* No longer used (was termOffset) */ +#endif LiteralTable literalTable; /* Contains LiteralEntry's describing all Tcl * objects holding literals of scripts * compiled by the interpreter. Indexed by the @@ -1980,10 +1980,7 @@ typedef struct Interp { * string. Returned by Tcl_ObjSetVar2 when * variable traces change a variable in a * gross way. */ -#if !defined(TCL_NO_DEPRECATED) - char resultSpace[TCL_DSTRING_STATIC_SIZE+1]; - /* Static space holding small results. */ -#else +#if TCL_MAJOR_VERSION < 9 char resultSpaceDontUse[TCL_DSTRING_STATIC_SIZE+1]; #endif Tcl_Obj *objResultPtr; /* If the last command returned an object @@ -2489,11 +2486,11 @@ typedef struct ListStore { /* Max number of elements that can be contained in a list */ #define LIST_MAX \ - ((Tcl_Size)(((size_t)ListSizeT_MAX - offsetof(ListStore, slots)) \ - / sizeof(Tcl_Obj *))) + ((ListSizeT_MAX - offsetof(ListStore, slots)) \ + / sizeof(Tcl_Obj *)) /* Memory size needed for a ListStore to hold numSlots_ elements */ #define LIST_SIZE(numSlots_) \ - ((int)(offsetof(ListStore, slots) + ((numSlots_) * sizeof(Tcl_Obj *)))) + (offsetof(ListStore, slots) + ((numSlots_) * sizeof(Tcl_Obj *))) /* * ListSpan -- @@ -2651,12 +2648,20 @@ typedef struct ListRep { * WARNING: these macros eval their args more than once. */ +#if TCL_MAJOR_VERSION > 8 +#define TclGetBooleanFromObj(interp, objPtr, intPtr) \ + (((objPtr)->typePtr == &tclIntType \ + || (objPtr)->typePtr == &tclBooleanType) \ + ? (*(intPtr) = ((objPtr)->internalRep.wideValue!=0), TCL_OK) \ + : Tcl_GetBooleanFromObj((interp), (objPtr), (intPtr))) +#else #define TclGetBooleanFromObj(interp, objPtr, intPtr) \ (((objPtr)->typePtr == &tclIntType) \ ? (*(intPtr) = ((objPtr)->internalRep.wideValue!=0), TCL_OK) \ : ((objPtr)->typePtr == &tclBooleanType) \ ? (*(intPtr) = ((objPtr)->internalRep.longValue!=0), TCL_OK) \ : Tcl_GetBooleanFromObj((interp), (objPtr), (intPtr))) +#endif #ifdef TCL_WIDE_INT_IS_LONG #define TclGetLongFromObj(interp, objPtr, longPtr) \ @@ -2681,7 +2686,7 @@ typedef struct ListRep { #define TclGetIntForIndexM(interp, objPtr, endValue, idxPtr) \ ((((objPtr)->typePtr == &tclIntType) && ((objPtr)->internalRep.wideValue >= 0) \ && ((Tcl_WideUInt)(objPtr)->internalRep.wideValue <= (Tcl_WideUInt)(endValue + 1))) \ - ? ((*(idxPtr) = (int)(objPtr)->internalRep.wideValue), TCL_OK) \ + ? ((*(idxPtr) = (objPtr)->internalRep.wideValue), TCL_OK) \ : Tcl_GetIntForIndex((interp), (objPtr), (endValue), (idxPtr))) /* @@ -2768,18 +2773,6 @@ typedef struct TclFileAttrProcs { typedef struct TclFile_ *TclFile; -/* - * The "globParameters" argument of the function TclGlob is an or'ed - * combination of the following values: - */ - -#ifndef TCL_NO_DEPRECATED -# define TCL_GLOBMODE_NO_COMPLAIN 1 -# define TCL_GLOBMODE_JOIN 2 -# define TCL_GLOBMODE_DIR 4 -# define TCL_GLOBMODE_TAILS 8 -#endif - typedef enum Tcl_PathPart { TCL_PATH_DIRNAME, TCL_PATH_TAIL, @@ -2800,17 +2793,6 @@ typedef Tcl_Channel (TclOpenFileChannelProc_)(Tcl_Interp *interp, /* *---------------------------------------------------------------- - * Data structures related to procedures - *---------------------------------------------------------------- - */ - -#if !defined(TCL_NO_DEPRECATED) -typedef Tcl_CmdProc *TclCmdProcType; -typedef Tcl_ObjCmdProc *TclObjCmdProcType; -#endif - -/* - *---------------------------------------------------------------- * Data structures for process-global values. *---------------------------------------------------------------- */ @@ -2896,7 +2878,6 @@ MODULE_SCOPE void *tclTimeClientData; MODULE_SCOPE const Tcl_ObjType tclBignumType; MODULE_SCOPE const Tcl_ObjType tclBooleanType; -MODULE_SCOPE const Tcl_ObjType tclByteArrayType; MODULE_SCOPE const Tcl_ObjType tclByteCodeType; MODULE_SCOPE const Tcl_ObjType tclDoubleType; MODULE_SCOPE const Tcl_ObjType tclIntType; @@ -2905,7 +2886,6 @@ MODULE_SCOPE const Tcl_ObjType tclArithSeriesType; MODULE_SCOPE const Tcl_ObjType tclDictType; MODULE_SCOPE const Tcl_ObjType tclProcBodyType; MODULE_SCOPE const Tcl_ObjType tclStringType; -MODULE_SCOPE const Tcl_ObjType tclUniCharStringType; MODULE_SCOPE const Tcl_ObjType tclEnsembleCmdType; MODULE_SCOPE const Tcl_ObjType tclRegexpType; MODULE_SCOPE Tcl_ObjType tclCmdNameType; @@ -3045,13 +3025,14 @@ struct Tcl_LoadHandle_ { *---------------------------------------------------------------- */ +#if TCL_MAJOR_VERSION > 8 MODULE_SCOPE void TclAppendBytesToByteArray(Tcl_Obj *objPtr, - const unsigned char *bytes, int len); + const unsigned char *bytes, size_t len); MODULE_SCOPE int TclNREvalCmd(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); -MODULE_SCOPE void TclAdvanceContinuations(int *line, int **next, +MODULE_SCOPE void TclAdvanceContinuations(size_t *line, int **next, int loc); -MODULE_SCOPE void TclAdvanceLines(int *line, const char *start, +MODULE_SCOPE void TclAdvanceLines(size_t *line, const char *start, const char *end); MODULE_SCOPE void TclArgumentEnter(Tcl_Interp *interp, Tcl_Obj *objv[], int objc, CmdFrame *cf); @@ -3059,7 +3040,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, int pc); + void *codePtr, CmdFrame *cfPtr, int cmd, size_t pc); MODULE_SCOPE void TclArgumentBCRelease(Tcl_Interp *interp, CmdFrame *cfPtr); MODULE_SCOPE void TclArgumentGet(Tcl_Interp *interp, Tcl_Obj *obj, @@ -3069,15 +3050,13 @@ 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, - int strLen, const unsigned char *pattern, - int ptnLen, int flags); + size_t strLen, const unsigned char *pattern, + size_t ptnLen, int flags); MODULE_SCOPE double TclCeil(const void *a); MODULE_SCOPE void TclChannelPreserve(Tcl_Channel chan); MODULE_SCOPE void TclChannelRelease(Tcl_Channel chan); MODULE_SCOPE int TclCheckArrayTraces(Tcl_Interp *interp, Var *varPtr, Var *arrayPtr, Tcl_Obj *name, int index); -MODULE_SCOPE int TclCheckBadOctal(Tcl_Interp *interp, - const char *value); MODULE_SCOPE int TclCheckEmptyString(Tcl_Obj *objPtr); MODULE_SCOPE int TclChanCaughtErrorBypass(Tcl_Interp *interp, Tcl_Channel chan); @@ -3085,14 +3064,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, int num, +MODULE_SCOPE ContLineLoc *TclContinuationsEnter(Tcl_Obj *objPtr, size_t 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 int TclConvertElement(const char *src, int length, +MODULE_SCOPE size_t TclConvertElement(const char *src, size_t length, char *dst, int flags); MODULE_SCOPE Tcl_Command TclCreateObjCommandInNs(Tcl_Interp *interp, const char *cmdName, Tcl_Namespace *nsPtr, @@ -3104,12 +3083,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, int dictLength, + const char *dict, size_t dictLength, const char **elementPtr, const char **nextPtr, - int *sizePtr, int *literalPtr); + size_t *sizePtr, int *literalPtr); /* TIP #280 - Modified token based evaluation, with line information. */ MODULE_SCOPE int TclEvalEx(Tcl_Interp *interp, const char *script, - int numBytes, int flags, int line, + size_t numBytes, int flags, size_t line, int *clNextOuter, const char *outerScript); MODULE_SCOPE Tcl_ObjCmdProc TclFileAttrsCmd; MODULE_SCOPE Tcl_ObjCmdProc TclFileCopyCmd; @@ -3131,7 +3110,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, int objc, int *objcPtr); + Tcl_Obj *const *objv, size_t objc, size_t *objcPtr); MODULE_SCOPE Tcl_Obj *const *TclEnsembleGetRewriteValues(Tcl_Interp *interp); MODULE_SCOPE Tcl_Namespace *TclEnsureNamespace(Tcl_Interp *interp, Tcl_Namespace *namespacePtr); @@ -3215,7 +3194,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(int elements, Tcl_Obj * const objv[], +MODULE_SCOPE Tcl_Obj * TclJoinPath(size_t elements, Tcl_Obj * const objv[], int forceRelative); MODULE_SCOPE int MakeTildeRelativePath(Tcl_Interp *interp, const char *user, const char *subPath, Tcl_DString *dsPtr); @@ -3228,25 +3207,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, - int indexCount, Tcl_Obj *const indexArray[]); + size_t indexCount, Tcl_Obj *const indexArray[]); /* TIP #280 */ -MODULE_SCOPE void TclListLines(Tcl_Obj *listObj, int line, int n, +MODULE_SCOPE void TclListLines(Tcl_Obj *listObj, size_t 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, int elemCount, + Tcl_Obj *toObj, size_t elemCount, Tcl_Obj *const elemObjv[]); -MODULE_SCOPE Tcl_Obj * TclListObjRange(Tcl_Obj *listPtr, int fromIdx, - int toIdx); +MODULE_SCOPE Tcl_Obj * TclListObjRange(Tcl_Obj *listPtr, size_t fromIdx, + size_t 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, - int indexCount, Tcl_Obj *const indexArray[], + size_t 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, int numBytes, +MODULE_SCOPE int TclMaxListLength(const char *bytes, size_t numBytes, const char **endPtr); MODULE_SCOPE int TclMergeReturnOptions(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], Tcl_Obj **optionsPtrPtr, @@ -3264,15 +3243,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, - int numBytes, int *readPtr, char *dst); -MODULE_SCOPE int TclParseHex(const char *src, int numBytes, + size_t numBytes, size_t *readPtr, char *dst); +MODULE_SCOPE int TclParseHex(const char *src, size_t numBytes, int *resultPtr); MODULE_SCOPE int TclParseNumber(Tcl_Interp *interp, Tcl_Obj *objPtr, const char *expected, const char *bytes, - int numBytes, const char **endPtrPtr, int flags); + size_t numBytes, const char **endPtrPtr, int flags); MODULE_SCOPE void TclParseInit(Tcl_Interp *interp, const char *string, - int numBytes, Tcl_Parse *parsePtr); -MODULE_SCOPE int TclParseAllWhiteSpace(const char *src, int numBytes); + size_t numBytes, Tcl_Parse *parsePtr); +MODULE_SCOPE size_t TclParseAllWhiteSpace(const char *src, size_t 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); @@ -3280,7 +3259,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, - int len); + size_t len); MODULE_SCOPE void TclpAlertNotifier(void *clientData); MODULE_SCOPE void *TclpNotifierData(void); MODULE_SCOPE void TclpServiceModeHook(int mode); @@ -3306,8 +3285,8 @@ MODULE_SCOPE int TclCreateSocketAddress(Tcl_Interp *interp, const char **errorMsgPtr); MODULE_SCOPE int TclpThreadCreate(Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc *proc, void *clientData, - int stackSize, int flags); -MODULE_SCOPE int TclpFindVariable(const char *name, int *lengthPtr); + size_t stackSize, int flags); +MODULE_SCOPE size_t TclpFindVariable(const char *name, size_t *lengthPtr); MODULE_SCOPE void TclpInitLibraryPath(char **valuePtr, TCL_HASH_TYPE *lengthPtr, Tcl_Encoding *encodingPtr); MODULE_SCOPE void TclpInitLock(void); @@ -3322,15 +3301,15 @@ 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, int *lenPtr); +MODULE_SCOPE Tcl_Obj * TclpNativeSplitPath(Tcl_Obj *pathPtr, size_t *lenPtr); MODULE_SCOPE Tcl_PathType TclpGetNativePathType(Tcl_Obj *pathPtr, - int *driveNameLengthPtr, Tcl_Obj **driveNameRef); + size_t *driveNameLengthPtr, Tcl_Obj **driveNameRef); MODULE_SCOPE int TclCrossFilesystemCopy(Tcl_Interp *interp, Tcl_Obj *source, Tcl_Obj *target); MODULE_SCOPE int TclpMatchInDirectory(Tcl_Interp *interp, Tcl_Obj *resultPtr, Tcl_Obj *pathPtr, const char *pattern, Tcl_GlobTypeData *types); -MODULE_SCOPE void *TclpGetNativeCwd(void *clientData); +MODULE_SCOPE void *TclpGetNativeCwd(void *clientData); MODULE_SCOPE Tcl_FSDupInternalRepProc TclNativeDupInternalRep; MODULE_SCOPE Tcl_Obj * TclpObjLink(Tcl_Obj *pathPtr, Tcl_Obj *toPtr, int linkType); @@ -3355,9 +3334,9 @@ MODULE_SCOPE void TclRememberJoinableThread(Tcl_ThreadId id); MODULE_SCOPE void TclRememberMutex(Tcl_Mutex *mutex); MODULE_SCOPE void TclRemoveScriptLimitCallbacks(Tcl_Interp *interp); MODULE_SCOPE int TclReToGlob(Tcl_Interp *interp, const char *reStr, - int reStrLen, Tcl_DString *dsPtr, int *flagsPtr, + size_t reStrLen, Tcl_DString *dsPtr, int *flagsPtr, int *quantifiersFoundPtr); -MODULE_SCOPE TCL_HASH_TYPE TclScanElement(const char *string, int length, +MODULE_SCOPE TCL_HASH_TYPE TclScanElement(const char *string, size_t length, char *flagPtr); MODULE_SCOPE void TclSetBgErrorHandler(Tcl_Interp *interp, Tcl_Obj *cmdPrefix); @@ -3372,44 +3351,44 @@ MODULE_SCOPE void TclSetProcessGlobalValue(ProcessGlobalValue *pgvPtr, Tcl_Obj *newValue, Tcl_Encoding encoding); MODULE_SCOPE void TclSignalExitThread(Tcl_ThreadId id, int result); MODULE_SCOPE void TclSpellFix(Tcl_Interp *interp, - Tcl_Obj *const *objv, int objc, int subIdx, + Tcl_Obj *const *objv, size_t objc, size_t subIdx, Tcl_Obj *bad, Tcl_Obj *fix); MODULE_SCOPE void * TclStackRealloc(Tcl_Interp *interp, void *ptr, - int numBytes); + size_t numBytes); typedef int (*memCmpFn_t)(const void*, const void*, size_t); MODULE_SCOPE int TclStringCmp(Tcl_Obj *value1Ptr, Tcl_Obj *value2Ptr, - int checkEq, int nocase, int reqlength); + int checkEq, int nocase, size_t reqlength); MODULE_SCOPE int TclStringCmpOpts(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int *nocase, int *reqlength); -MODULE_SCOPE int TclStringMatch(const char *str, int strLen, +MODULE_SCOPE int TclStringMatch(const char *str, size_t 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, - int numBytes, int flags, int line, + size_t numBytes, int flags, size_t line, struct CompileEnv *envPtr); -MODULE_SCOPE int TclSubstOptions(Tcl_Interp *interp, int numOpts, +MODULE_SCOPE int TclSubstOptions(Tcl_Interp *interp, size_t numOpts, Tcl_Obj *const opts[], int *flagPtr); MODULE_SCOPE void TclSubstParse(Tcl_Interp *interp, const char *bytes, - int numBytes, int flags, Tcl_Parse *parsePtr, + size_t numBytes, int flags, Tcl_Parse *parsePtr, Tcl_InterpState *statePtr); MODULE_SCOPE int TclSubstTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr, - int count, int *tokensLeftPtr, int line, + size_t count, int *tokensLeftPtr, size_t line, int *clNextOuter, const char *outerScript); -MODULE_SCOPE int TclTrim(const char *bytes, int numBytes, - const char *trim, int numTrim, int *trimRight); -MODULE_SCOPE int TclTrimLeft(const char *bytes, int numBytes, - const char *trim, int numTrim); -MODULE_SCOPE int TclTrimRight(const char *bytes, int numBytes, - const char *trim, int numTrim); +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 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 int TclUtfCount(int ch); +MODULE_SCOPE size_t TclUtfCount(int ch); #if TCL_UTF_MAX > 3 # define TclUtfToUCS4 Tcl_UtfToUniChar # define TclUniCharToUCS4(src, ptr) (*ptr = *(src),1) @@ -3456,49 +3435,11 @@ 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, int length); + const char *msg, size_t length); /* Tip 430 */ MODULE_SCOPE int TclZipfs_Init(Tcl_Interp *interp); -#if TCL_UTF_MAX > 3 - MODULE_SCOPE int *TclGetUnicodeFromObj_(Tcl_Obj *, int *); - MODULE_SCOPE Tcl_Obj *TclNewUnicodeObj(const int *, int); - MODULE_SCOPE void TclAppendUnicodeToObj(Tcl_Obj *, const int *, int); - MODULE_SCOPE int TclUniCharNcasecmp(const int *, const int *, unsigned long); - MODULE_SCOPE int TclUniCharCaseMatch(const int *, const int *, int); - MODULE_SCOPE int TclUniCharNcmp(const int *, const int *, unsigned long); -# undef Tcl_NumUtfChars -# define Tcl_NumUtfChars TclNumUtfChars -# undef Tcl_GetCharLength -# define Tcl_GetCharLength TclGetCharLength -# undef Tcl_UtfAtIndex -# define Tcl_UtfAtIndex TclUtfAtIndex -# undef Tcl_GetRange -# define Tcl_GetRange TclGetRange -# undef Tcl_GetUniChar -# define Tcl_GetUniChar TclGetUniChar -#else -# define tclUniCharStringType tclStringType -# define TclGetUnicodeFromObj_ Tcl_GetUnicodeFromObj -# define TclNewUnicodeObj Tcl_NewUnicodeObj -# define TclAppendUnicodeToObj Tcl_AppendUnicodeToObj -# define TclUniCharNcasecmp Tcl_UniCharNcasecmp -# define TclUniCharCaseMatch Tcl_UniCharCaseMatch -# define TclUniCharNcmp Tcl_UniCharNcmp -# undef TclNumUtfChars -# define TclNumUtfChars Tcl_NumUtfChars -# undef TclGetCharLength -# define TclGetCharLength Tcl_GetCharLength -# undef TclUtfAtIndex -# define TclUtfAtIndex Tcl_UtfAtIndex -# undef TclGetRange -# define TclGetRange Tcl_GetRange -# undef TclGetUniChar -# define TclGetUniChar Tcl_GetUniChar -#endif - - /* * Many parsing tasks need a common definition of whitespace. * Use this routine and macro to achieve that and place @@ -3521,9 +3462,6 @@ MODULE_SCOPE Tcl_ObjCmdProc Tcl_ApplyObjCmd; MODULE_SCOPE Tcl_Command TclInitArrayCmd(Tcl_Interp *interp); MODULE_SCOPE Tcl_Command TclInitBinaryCmd(Tcl_Interp *interp); MODULE_SCOPE Tcl_ObjCmdProc Tcl_BreakObjCmd; -#if !defined(TCL_NO_DEPRECATED) -MODULE_SCOPE Tcl_ObjCmdProc Tcl_CaseObjCmd; -#endif MODULE_SCOPE Tcl_ObjCmdProc Tcl_CatchObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_CdObjCmd; MODULE_SCOPE Tcl_Command TclInitChanCmd(Tcl_Interp *interp); @@ -3546,7 +3484,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, - int pathc, Tcl_Obj *const pathv[]); + size_t pathc, Tcl_Obj *const pathv[]); MODULE_SCOPE Tcl_ObjCmdProc Tcl_DisassembleObjCmd; /* Assemble command function */ @@ -4072,13 +4010,13 @@ MODULE_SCOPE int TclCompileAssembleCmd(Tcl_Interp *interp, MODULE_SCOPE Tcl_Obj * TclStringCat(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags); MODULE_SCOPE Tcl_Obj * TclStringFirst(Tcl_Obj *needle, Tcl_Obj *haystack, - int start); + size_t start); MODULE_SCOPE Tcl_Obj * TclStringLast(Tcl_Obj *needle, Tcl_Obj *haystack, - int last); + size_t last); MODULE_SCOPE Tcl_Obj * TclStringRepeat(Tcl_Interp *interp, Tcl_Obj *objPtr, - int count, int flags); + size_t count, int flags); MODULE_SCOPE Tcl_Obj * TclStringReplace(Tcl_Interp *interp, Tcl_Obj *objPtr, - int first, int count, Tcl_Obj *insertPtr, + size_t first, size_t count, Tcl_Obj *insertPtr, int flags); MODULE_SCOPE Tcl_Obj * TclStringReverse(Tcl_Obj *objPtr, int flags); @@ -4143,6 +4081,19 @@ MODULE_SCOPE TCL_HASH_TYPE TclHashObjKey(Tcl_HashTable *tablePtr, void *keyPtr); MODULE_SCOPE int TclFullFinalizationRequested(void); /* + * TIP #542 + */ + +MODULE_SCOPE size_t TclUniCharLen(const Tcl_UniChar *uniStr); +MODULE_SCOPE int TclUniCharNcmp(const Tcl_UniChar *ucs, + const Tcl_UniChar *uct, size_t numChars); +MODULE_SCOPE int TclUniCharNcasecmp(const Tcl_UniChar *ucs, + const Tcl_UniChar *uct, size_t numChars); +MODULE_SCOPE int TclUniCharCaseMatch(const Tcl_UniChar *uniStr, + const Tcl_UniChar *uniPattern, int nocase); + + +/* * Just for the purposes of command-type registration. */ @@ -4178,7 +4129,7 @@ MODULE_SCOPE void TclProcessCreated(Tcl_Pid pid); MODULE_SCOPE TclProcessWaitStatus TclProcessWait(Tcl_Pid pid, int options, int *codePtr, Tcl_Obj **msgObjPtr, Tcl_Obj **errorObjPtr); - +MODULE_SCOPE int TclClose(Tcl_Interp *, Tcl_Channel chan); /* * TIP #508: [array default] */ @@ -4192,8 +4143,9 @@ MODULE_SCOPE Tcl_Obj * TclGetArrayDefault(Var *arrayPtr); */ MODULE_SCOPE int TclIndexEncode(Tcl_Interp *interp, Tcl_Obj *objPtr, - int before, int after, int *indexPtr); -MODULE_SCOPE int TclIndexDecode(int encoded, int endValue); + size_t before, size_t after, int *indexPtr); +MODULE_SCOPE size_t TclIndexDecode(int encoded, size_t endValue); +#endif /* TCL_MAJOR_VERSION > 8 */ /* Constants used in index value encoding routines. */ #define TCL_INDEX_END ((Tcl_Size)-2) @@ -4305,7 +4257,7 @@ TclScaleTime( TCL_DTRACE_OBJ_FREE(objPtr); \ if ((objPtr)->bytes \ && ((objPtr)->bytes != &tclEmptyString)) { \ - ckfree((objPtr)->bytes); \ + Tcl_Free((objPtr)->bytes); \ } \ (objPtr)->length = TCL_INDEX_NONE; \ TclFreeObjStorage(objPtr); \ @@ -4329,10 +4281,10 @@ TclScaleTime( */ # define TclAllocObjStorageEx(interp, objPtr) \ - (objPtr) = (Tcl_Obj *)ckalloc(sizeof(Tcl_Obj)) + (objPtr) = (Tcl_Obj *)Tcl_Alloc(sizeof(Tcl_Obj)) # define TclFreeObjStorageEx(interp, objPtr) \ - ckfree(objPtr) + Tcl_Free(objPtr) #undef USE_THREAD_ALLOC #undef USE_TCLALLOC @@ -4479,7 +4431,7 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file, (objPtr)->bytes = &tclEmptyString; \ (objPtr)->length = 0; \ } else { \ - (objPtr)->bytes = (char *)ckalloc((len) + 1U); \ + (objPtr)->bytes = (char *)Tcl_Alloc((len) + 1U); \ memcpy((objPtr)->bytes, (bytePtr) ? (bytePtr) : &tclEmptyString, (len)); \ (objPtr)->bytes[len] = '\0'; \ (objPtr)->length = (len); \ @@ -4500,12 +4452,6 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file, #define TclGetString(objPtr) \ ((objPtr)->bytes? (objPtr)->bytes : Tcl_GetString(objPtr)) -#undef TclGetStringFromObj -#define TclGetStringFromObj(objPtr, lenPtr) \ - ((objPtr)->bytes \ - ? (*(lenPtr) = (objPtr)->length, (objPtr)->bytes) \ - : (Tcl_GetStringFromObj)((objPtr), (lenPtr))) - /* *---------------------------------------------------------------- * Macro used by the Tcl core to clean out an object's internal @@ -4524,10 +4470,6 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file, (objPtr)->typePtr = NULL; \ } -#if !defined(TCL_NO_DEPRECATED) -# define TclFreeIntRep(objPtr) TclFreeInternalRep(objPtr) -#endif - /* *---------------------------------------------------------------- * Macro used by the Tcl core to clean out an object's string representation. @@ -4542,7 +4484,7 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file, Tcl_Obj *_isobjPtr = (Tcl_Obj *)(objPtr); \ if (_isobjPtr->bytes != NULL) { \ if (_isobjPtr->bytes != &tclEmptyString) { \ - ckfree((char *)_isobjPtr->bytes); \ + Tcl_Free((char *)_isobjPtr->bytes); \ } \ _isobjPtr->bytes = NULL; \ } \ @@ -4630,32 +4572,21 @@ MODULE_SCOPE const TclFileAttrProcs tclpFileAttrProcs[]; #define TCL_MIN_TOKEN_GROWTH TCL_MIN_GROWTH/sizeof(Tcl_Token) #endif -#define TCL_MAX_TOKENS (int)(UINT_MAX / sizeof(Tcl_Token)) #define TclGrowTokenArray(tokenPtr, used, available, append, staticPtr) \ do { \ - int _needed = (used) + (append); \ - if (_needed > TCL_MAX_TOKENS) { \ - Tcl_Panic("max # of tokens for a Tcl parse (%d) exceeded", \ - TCL_MAX_TOKENS); \ - } \ + size_t _needed = (used) + (append); \ if (_needed > (available)) { \ - int allocated = 2 * _needed; \ + size_t allocated = 2 * _needed; \ Tcl_Token *oldPtr = (tokenPtr); \ Tcl_Token *newPtr; \ if (oldPtr == (staticPtr)) { \ oldPtr = NULL; \ } \ - if (allocated > TCL_MAX_TOKENS) { \ - allocated = TCL_MAX_TOKENS; \ - } \ - newPtr = (Tcl_Token *) attemptckrealloc((char *) oldPtr, \ + newPtr = (Tcl_Token *)Tcl_AttemptRealloc((char *) oldPtr, \ allocated * sizeof(Tcl_Token)); \ if (newPtr == NULL) { \ allocated = _needed + (append) + TCL_MIN_TOKEN_GROWTH; \ - if (allocated > TCL_MAX_TOKENS) { \ - allocated = TCL_MAX_TOKENS; \ - } \ - newPtr = (Tcl_Token *) ckrealloc((char *) oldPtr, \ + newPtr = (Tcl_Token *)Tcl_Realloc((char *) oldPtr, \ allocated * sizeof(Tcl_Token)); \ } \ (available) = allocated; \ @@ -4710,12 +4641,12 @@ MODULE_SCOPE const TclFileAttrProcs tclpFileAttrProcs[]; #define TclNumUtfCharsM(numChars, bytes, numBytes) \ do { \ - int _count, _i = (numBytes); \ + size_t _count, _i = (numBytes); \ unsigned char *_str = (unsigned char *) (bytes); \ while (_i && (*_str < 0xC0)) { _i--; _str++; } \ _count = (numBytes) - _i; \ if (_i) { \ - _count += TclNumUtfChars((bytes) + _count, _i); \ + _count += Tcl_NumUtfChars((bytes) + _count, _i); \ } \ (numChars) = _count; \ } while (0); @@ -4746,6 +4677,22 @@ MODULE_SCOPE int TclIsPureByteArray(Tcl_Obj *objPtr); /* *---------------------------------------------------------------- + * Macro used by the Tcl core to compare Unicode strings. On big-endian + * systems we can use the more efficient memcmp, but this would not be + * lexically correct on little-endian systems. The ANSI C "prototype" for + * this macro is: + * + * MODULE_SCOPE int TclUniCharNcmp(const Tcl_UniChar *cs, + * const Tcl_UniChar *ct, unsigned long n); + *---------------------------------------------------------------- + */ + +#if defined(WORDS_BIGENDIAN) && (TCL_UTF_MAX > 3) +# define TclUniCharNcmp(cs,ct,n) memcmp((cs),(ct),(n)*sizeof(Tcl_UniChar)) +#endif /* WORDS_BIGENDIAN */ + +/* + *---------------------------------------------------------------- * Macro used by the Tcl core to increment a namespace's export epoch * counter. The ANSI C "prototype" for this macro is: * @@ -4835,7 +4782,7 @@ MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_SafeInit; * * MODULE_SCOPE void TclNewIntObj(Tcl_Obj *objPtr, Tcl_WideInt w); * MODULE_SCOPE void TclNewDoubleObj(Tcl_Obj *objPtr, double d); - * MODULE_SCOPE void TclNewStringObj(Tcl_Obj *objPtr, const char *s, int len); + * MODULE_SCOPE void TclNewStringObj(Tcl_Obj *objPtr, const char *s, size_t len); * MODULE_SCOPE void TclNewLiteralStringObj(Tcl_Obj*objPtr, const char *sLiteral); * *---------------------------------------------------------------- @@ -4873,8 +4820,28 @@ MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_SafeInit; TCL_DTRACE_OBJ_CREATE(objPtr); \ } while (0) -#define TclNewIndexObj(objPtr, w) \ - TclNewIntObj(objPtr, w) +#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; \ + } 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; \ + } \ + TCL_DTRACE_OBJ_CREATE(objPtr); \ + } while (0) #define TclNewDoubleObj(objPtr, d) \ do { \ @@ -4917,7 +4884,7 @@ MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_SafeInit; } while (0) #define TclNewIndexObj(objPtr, w) \ - TclNewIntObj(objPtr, w) + (objPtr) = (((Tcl_WideUInt)w) >= TCL_INDEX_NONE) ? Tcl_NewWideIntObj(-1) : Tcl_NewWideIntObj(w) #define TclNewDoubleObj(objPtr, d) \ (objPtr) = Tcl_NewDoubleObj(d) @@ -4950,33 +4917,6 @@ MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_SafeInit; /* *---------------------------------------------------------------- - * Macros used by the Tcl core to test for some special double values. - * (deprecated) The ANSI C "prototypes" for these macros are: - * - * MODULE_SCOPE int TclIsInfinite(double d); - * MODULE_SCOPE int TclIsNaN(double d); - */ - -#if !defined(TCL_NO_DEPRECATED) && !defined(BUILD_tcl) -# define TclIsInfinite(d) isinf(d) -# define TclIsNaN(d) isnan(d) -#endif - -/* - * Macro to use to find the offset of a field in astructure. - * Computes number of bytes from beginning of structure to a given field. - */ - -#if !defined(TCL_NO_DEPRECATED) && !defined(BUILD_tcl) -# define TclOffset(type, field) ((int) offsetof(type, field)) -#endif -/* Workaround for platforms missing offsetof(), e.g. VC++ 6.0 */ -#ifndef offsetof -# define offsetof(type, field) ((size_t) ((char *) &((type *) 0)->field)) -#endif - -/* - *---------------------------------------------------------------- * Inline version of Tcl_GetCurrentNamespace and Tcl_GetGlobalNamespace. */ @@ -4995,7 +4935,7 @@ MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_SafeInit; #define TclCleanupCommandMacro(cmdPtr) \ do { \ if ((cmdPtr)->refCount-- <= 1) { \ - ckfree(cmdPtr); \ + Tcl_Free(cmdPtr); \ } \ } while (0) @@ -5008,7 +4948,7 @@ MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_SafeInit; (cmdPtr)->refCount++; \ if ((location) != NULL \ && (location--) <= 1) { \ - ckfree(((location))); \ + Tcl_Free(((location))); \ } \ (location) = (cmdPtr); \ } while (0) @@ -5171,8 +5111,8 @@ typedef struct NRE_callback { #define TCLNR_FREE(interp, ptr) TclSmallFreeEx((interp), (ptr)) #else #define TCLNR_ALLOC(interp, ptr) \ - ((ptr) = ((void *)ckalloc(sizeof(NRE_callback)))) -#define TCLNR_FREE(interp, ptr) ckfree(ptr) + (ptr = (Tcl_Alloc(sizeof(NRE_callback)))) +#define TCLNR_FREE(interp, ptr) Tcl_Free(ptr) #endif #if NRE_ENABLE_ASSERTS @@ -5184,11 +5124,10 @@ typedef struct NRE_callback { #include "tclIntDecls.h" #include "tclIntPlatDecls.h" - #if !defined(USE_TCL_STUBS) && !defined(TCL_MEM_DEBUG) -#define Tcl_AttemptAlloc(size) TclpAlloc(size) -#define Tcl_AttemptRealloc(ptr, size) TclpRealloc((ptr), (size)) -#define Tcl_Free(ptr) TclpFree(ptr) +#define Tcl_AttemptAlloc TclpAlloc +#define Tcl_AttemptRealloc TclpRealloc +#define Tcl_Free TclpFree #endif /* diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index ffd559d..d6168b5 100644 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.h @@ -27,23 +27,6 @@ # endif #endif -#if !defined(TCL_NO_DEPRECATED) && (TCL_MAJOR_VERSION < 9) -# define tclGetIntForIndex tcl_GetIntForIndex -/* Those macro's are especially for Itcl 3.4 compatibility */ -# define tclCreateNamespace tcl_CreateNamespace -# define tclDeleteNamespace tcl_DeleteNamespace -# define tclAppendExportList tcl_AppendExportList -# define tclExport tcl_Export -# define tclImport tcl_Import -# define tclForgetImport tcl_ForgetImport -# define tclGetCurrentNamespace_ tcl_GetCurrentNamespace -# define tclGetGlobalNamespace_ tcl_GetGlobalNamespace -# define tclFindNamespace tcl_FindNamespace -# define tclFindCommand tcl_FindCommand -# define tclGetCommandFromObj tcl_GetCommandFromObj -# define tclGetCommandFullName tcl_GetCommandFullName -#endif /* !defined(TCL_NO_DEPRECATED) */ - /* * WARNING: This file is automatically generated by the tools/genStubs.tcl * script. Any modifications to the function declarations below should be made @@ -67,20 +50,17 @@ extern "C" { EXTERN void TclAllocateFreeObjects(void); /* Slot 4 is reserved */ /* 5 */ -EXTERN int TclCleanupChildren(Tcl_Interp *interp, int numPids, - Tcl_Pid *pidPtr, Tcl_Channel errorChan); +EXTERN int TclCleanupChildren(Tcl_Interp *interp, + Tcl_Size numPids, Tcl_Pid *pidPtr, + Tcl_Channel errorChan); /* 6 */ EXTERN void TclCleanupCommand(Command *cmdPtr); /* 7 */ -EXTERN int TclCopyAndCollapse(int count, const char *src, +EXTERN Tcl_Size TclCopyAndCollapse(Tcl_Size count, const char *src, char *dst); -/* 8 */ -TCL_DEPRECATED("") -int TclCopyChannelOld(Tcl_Interp *interp, - Tcl_Channel inChan, Tcl_Channel outChan, - int toRead, Tcl_Obj *cmdPtr); +/* Slot 8 is reserved */ /* 9 */ -EXTERN int TclCreatePipeline(Tcl_Interp *interp, int argc, +EXTERN Tcl_Size TclCreatePipeline(Tcl_Interp *interp, Tcl_Size argc, const char **argv, Tcl_Pid **pidArrayPtr, TclFile *inPipePtr, TclFile *outPipePtr, TclFile *errFilePtr); @@ -107,14 +87,14 @@ EXTERN void TclExprFloatError(Tcl_Interp *interp, double value); /* Slot 21 is reserved */ /* 22 */ EXTERN int TclFindElement(Tcl_Interp *interp, - const char *listStr, int listLength, + const char *listStr, Tcl_Size listLength, const char **elementPtr, - const char **nextPtr, int *sizePtr, + const char **nextPtr, Tcl_Size *sizePtr, int *bracePtr); /* 23 */ EXTERN Proc * TclFindProc(Interp *iPtr, const char *procName); /* 24 */ -EXTERN int TclFormatInt(char *buffer, Tcl_WideInt n); +EXTERN Tcl_Size TclFormatInt(char *buffer, Tcl_WideInt n); /* 25 */ EXTERN void TclFreePackageInfo(Interp *iPtr); /* Slot 26 is reserved */ @@ -129,15 +109,10 @@ EXTERN const char * TclGetExtension(const char *name); EXTERN int TclGetFrame(Tcl_Interp *interp, const char *str, CallFrame **framePtrPtr); /* Slot 33 is reserved */ -/* 34 */ -TCL_DEPRECATED("Use Tcl_GetIntForIndex") -int TclGetIntForIndex(Tcl_Interp *interp, - Tcl_Obj *objPtr, int endValue, int *indexPtr); +/* Slot 34 is reserved */ /* Slot 35 is reserved */ /* Slot 36 is reserved */ -/* 37 */ -EXTERN int TclGetLoadedPackages(Tcl_Interp *interp, - const char *targetName); +/* Slot 37 is reserved */ /* 38 */ EXTERN int TclGetNamespaceForQualName(Tcl_Interp *interp, const char *qualName, Namespace *cxtNsPtr, @@ -157,9 +132,7 @@ EXTERN const char * TclpGetUserHome(const char *name, Tcl_DString *bufferPtr); /* 43 */ EXTERN Tcl_ObjCmdProc2 * TclGetObjInterpProc2(void); -/* 44 */ -EXTERN int TclGuessPackageName(const char *fileName, - Tcl_DString *bufPtr); +/* Slot 44 is reserved */ /* 45 */ EXTERN int TclHideUnsafeCommands(Tcl_Interp *interp); /* 46 */ @@ -167,9 +140,7 @@ EXTERN int TclInExit(void); /* Slot 47 is reserved */ /* Slot 48 is reserved */ /* Slot 49 is reserved */ -/* 50 */ -EXTERN void TclInitCompiledLocals(Tcl_Interp *interp, - CallFrame *framePtr, Namespace *nsPtr); +/* Slot 50 is reserved */ /* 51 */ EXTERN int TclInterpInit(Tcl_Interp *interp); /* Slot 52 is reserved */ @@ -209,7 +180,7 @@ EXTERN int TclObjInvoke(Tcl_Interp *interp, int objc, /* Slot 67 is reserved */ /* Slot 68 is reserved */ /* 69 */ -EXTERN void * TclpAlloc(unsigned int size); +EXTERN void * TclpAlloc(TCL_HASH_TYPE size); /* Slot 70 is reserved */ /* Slot 71 is reserved */ /* Slot 72 is reserved */ @@ -217,28 +188,22 @@ EXTERN void * TclpAlloc(unsigned int size); /* 74 */ EXTERN void TclpFree(void *ptr); /* 75 */ -EXTERN unsigned long TclpGetClicks(void); +EXTERN unsigned long long TclpGetClicks(void); /* 76 */ -EXTERN unsigned long TclpGetSeconds(void); -/* 77 */ -TCL_DEPRECATED("") -void TclpGetTime(Tcl_Time *time); +EXTERN unsigned long long TclpGetSeconds(void); +/* Slot 77 is reserved */ /* Slot 78 is reserved */ /* Slot 79 is reserved */ /* Slot 80 is reserved */ /* 81 */ -EXTERN void * TclpRealloc(void *ptr, unsigned int size); +EXTERN void * TclpRealloc(void *ptr, TCL_HASH_TYPE size); /* Slot 82 is reserved */ /* Slot 83 is reserved */ /* Slot 84 is reserved */ /* Slot 85 is reserved */ /* Slot 86 is reserved */ /* Slot 87 is reserved */ -/* 88 */ -TCL_DEPRECATED("") -char * TclPrecTraceProc(void *clientData, - Tcl_Interp *interp, const char *name1, - const char *name2, int flags); +/* Slot 88 is reserved */ /* 89 */ EXTERN int TclPreventAliasLoop(Tcl_Interp *interp, Tcl_Interp *cmdInterp, Tcl_Command cmd); @@ -264,16 +229,13 @@ EXTERN void TclResetShadowedCmdRefs(Tcl_Interp *interp, EXTERN int TclServiceIdle(void); /* Slot 99 is reserved */ /* Slot 100 is reserved */ -/* 101 */ -EXTERN const char * TclSetPreInitScript(const char *string); +/* Slot 101 is reserved */ /* 102 */ EXTERN void TclSetupEnv(Tcl_Interp *interp); /* 103 */ EXTERN int TclSockGetPort(Tcl_Interp *interp, const char *str, const char *proto, int *portPtr); -/* 104 */ -TCL_DEPRECATED("") -int TclSockMinimumBuffersOld(int sock, int size); +/* Slot 104 is reserved */ /* Slot 105 is reserved */ /* Slot 106 is reserved */ /* Slot 107 is reserved */ @@ -282,32 +244,19 @@ EXTERN void TclTeardownNamespace(Namespace *nsPtr); /* 109 */ EXTERN int TclUpdateReturnInfo(Interp *iPtr); /* 110 */ -EXTERN int TclSockMinimumBuffers(void *sock, int size); +EXTERN int TclSockMinimumBuffers(void *sock, Tcl_Size size); /* 111 */ EXTERN void Tcl_AddInterpResolvers(Tcl_Interp *interp, const char *name, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc); -/* 112 */ -EXTERN int TclAppendExportList(Tcl_Interp *interp, - Tcl_Namespace *nsPtr, Tcl_Obj *objPtr); -/* 113 */ -EXTERN Tcl_Namespace * TclCreateNamespace(Tcl_Interp *interp, - const char *name, void *clientData, - Tcl_NamespaceDeleteProc *deleteProc); -/* 114 */ -EXTERN void TclDeleteNamespace(Tcl_Namespace *nsPtr); -/* 115 */ -EXTERN int TclExport(Tcl_Interp *interp, Tcl_Namespace *nsPtr, - const char *pattern, int resetListFirst); -/* 116 */ -EXTERN Tcl_Command TclFindCommand(Tcl_Interp *interp, const char *name, - Tcl_Namespace *contextNsPtr, int flags); -/* 117 */ -EXTERN Tcl_Namespace * TclFindNamespace(Tcl_Interp *interp, - const char *name, - Tcl_Namespace *contextNsPtr, int flags); +/* Slot 112 is reserved */ +/* Slot 113 is reserved */ +/* Slot 114 is reserved */ +/* Slot 115 is reserved */ +/* Slot 116 is reserved */ +/* Slot 117 is reserved */ /* 118 */ EXTERN int Tcl_GetInterpResolvers(Tcl_Interp *interp, const char *name, Tcl_ResolverInfo *resInfo); @@ -319,25 +268,15 @@ EXTERN int Tcl_GetNamespaceResolvers( EXTERN Tcl_Var Tcl_FindNamespaceVar(Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); -/* 121 */ -EXTERN int TclForgetImport(Tcl_Interp *interp, - Tcl_Namespace *nsPtr, const char *pattern); -/* 122 */ -EXTERN Tcl_Command TclGetCommandFromObj(Tcl_Interp *interp, - Tcl_Obj *objPtr); -/* 123 */ -EXTERN void TclGetCommandFullName(Tcl_Interp *interp, - Tcl_Command command, Tcl_Obj *objPtr); -/* 124 */ -EXTERN Tcl_Namespace * TclGetCurrentNamespace_(Tcl_Interp *interp); -/* 125 */ -EXTERN Tcl_Namespace * TclGetGlobalNamespace_(Tcl_Interp *interp); +/* Slot 121 is reserved */ +/* Slot 122 is reserved */ +/* Slot 123 is reserved */ +/* Slot 124 is reserved */ +/* Slot 125 is reserved */ /* 126 */ EXTERN void Tcl_GetVariableFullName(Tcl_Interp *interp, Tcl_Var variable, Tcl_Obj *objPtr); -/* 127 */ -EXTERN int TclImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr, - const char *pattern, int allowOverwrite); +/* Slot 127 is reserved */ /* 128 */ EXTERN void Tcl_PopCallFrame(Tcl_Interp *interp); /* 129 */ @@ -353,12 +292,8 @@ EXTERN void Tcl_SetNamespaceResolvers( Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc); -/* 132 */ -TCL_DEPRECATED("") -int TclpHasSockets(Tcl_Interp *interp); -/* 133 */ -TCL_DEPRECATED("") -struct tm * TclpGetDate(const time_t *time, int useGMT); +/* Slot 132 is reserved */ +/* Slot 133 is reserved */ /* Slot 134 is reserved */ /* Slot 135 is reserved */ /* Slot 136 is reserved */ @@ -374,7 +309,7 @@ EXTERN int TclSetByteCodeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr, CompileHookProc *hookProc, void *clientData); /* 143 */ -EXTERN int TclAddLiteralObj(struct CompileEnv *envPtr, +EXTERN Tcl_Size TclAddLiteralObj(struct CompileEnv *envPtr, Tcl_Obj *objPtr, LiteralEntry **litPtrPtr); /* 144 */ EXTERN void TclHideLiteral(Tcl_Interp *interp, @@ -392,8 +327,8 @@ EXTERN void TclHandleRelease(TclHandle handle); /* 150 */ EXTERN int TclRegAbout(Tcl_Interp *interp, Tcl_RegExp re); /* 151 */ -EXTERN void TclRegExpRangeUniChar(Tcl_RegExp re, int index, - int *startPtr, int *endPtr); +EXTERN void TclRegExpRangeUniChar(Tcl_RegExp re, Tcl_Size index, + Tcl_Size *startPtr, Tcl_Size *endPtr); /* 152 */ EXTERN void TclSetLibraryPath(Tcl_Obj *pathPtr); /* 153 */ @@ -406,12 +341,8 @@ EXTERN void TclRegError(Tcl_Interp *interp, const char *msg, /* 157 */ EXTERN Var * TclVarTraceExists(Tcl_Interp *interp, const char *varName); -/* 158 */ -TCL_DEPRECATED("use public Tcl_SetStartupScript()") -void TclSetStartupScriptFileName(const char *filename); -/* 159 */ -TCL_DEPRECATED("use public Tcl_GetStartupScript()") -const char * TclGetStartupScriptFileName(void); +/* Slot 158 is reserved */ +/* Slot 159 is reserved */ /* Slot 160 is reserved */ /* 161 */ EXTERN int TclChannelTransform(Tcl_Interp *interp, @@ -427,33 +358,29 @@ EXTERN void TclExpandCodeArray(void *envPtr); EXTERN void TclpSetInitialEncodings(void); /* 166 */ EXTERN int TclListObjSetElement(Tcl_Interp *interp, - Tcl_Obj *listPtr, int index, + Tcl_Obj *listPtr, Tcl_Size index, Tcl_Obj *valuePtr); -/* 167 */ -TCL_DEPRECATED("use public Tcl_SetStartupScript()") -void TclSetStartupScriptPath(Tcl_Obj *pathPtr); -/* 168 */ -TCL_DEPRECATED("use public Tcl_GetStartupScript()") -Tcl_Obj * TclGetStartupScriptPath(void); +/* Slot 167 is reserved */ +/* Slot 168 is reserved */ /* 169 */ EXTERN int TclpUtfNcmp2(const char *s1, const char *s2, - unsigned long n); + size_t n); /* 170 */ EXTERN int TclCheckInterpTraces(Tcl_Interp *interp, - const char *command, int numChars, + const char *command, Tcl_Size numChars, Command *cmdPtr, int result, int traceFlags, - int objc, Tcl_Obj *const objv[]); + Tcl_Size objc, Tcl_Obj *const objv[]); /* 171 */ EXTERN int TclCheckExecutionTraces(Tcl_Interp *interp, - const char *command, int numChars, + const char *command, Tcl_Size numChars, Command *cmdPtr, int result, int traceFlags, - int objc, Tcl_Obj *const objv[]); + Tcl_Size objc, Tcl_Obj *const objv[]); /* 172 */ EXTERN int TclInThreadExit(void); /* 173 */ EXTERN int TclUniCharMatch(const Tcl_UniChar *string, - int strLen, const Tcl_UniChar *pattern, - int ptnLen, int flags); + Tcl_Size strLen, const Tcl_UniChar *pattern, + Tcl_Size ptnLen, int flags); /* Slot 174 is reserved */ /* 175 */ EXTERN int TclCallVarTraces(Interp *iPtr, Var *arrayPtr, @@ -466,19 +393,12 @@ EXTERN void TclCleanupVar(Var *varPtr, Var *arrayPtr); EXTERN void TclVarErrMsg(Tcl_Interp *interp, const char *part1, const char *part2, const char *operation, const char *reason); -/* 178 */ -EXTERN void TclSetStartupScript(Tcl_Obj *pathPtr, - const char *encodingName); -/* 179 */ -EXTERN Tcl_Obj * TclGetStartupScript(const char **encodingNamePtr); +/* Slot 178 is reserved */ +/* Slot 179 is reserved */ /* Slot 180 is reserved */ /* Slot 181 is reserved */ -/* 182 */ -TCL_DEPRECATED("") -struct tm * TclpLocaltime(const time_t *clock); -/* 183 */ -TCL_DEPRECATED("") -struct tm * TclpGmtime(const time_t *clock); +/* Slot 182 is reserved */ +/* Slot 183 is reserved */ /* Slot 184 is reserved */ /* Slot 185 is reserved */ /* Slot 186 is reserved */ @@ -531,7 +451,7 @@ EXTERN Tcl_Obj * TclGetObjNameOfExecutable(void); EXTERN void TclSetObjNameOfExecutable(Tcl_Obj *name, Tcl_Encoding encoding); /* 215 */ -EXTERN void * TclStackAlloc(Tcl_Interp *interp, int numBytes); +EXTERN void * TclStackAlloc(Tcl_Interp *interp, Tcl_Size numBytes); /* 216 */ EXTERN void TclStackFree(Tcl_Interp *interp, void *freePtr); /* 217 */ @@ -550,12 +470,12 @@ EXTERN void TclPopStackFrame(Tcl_Interp *interp); EXTERN TclPlatformType * TclGetPlatform(void); /* 225 */ EXTERN Tcl_Obj * TclTraceDictPath(Tcl_Interp *interp, - Tcl_Obj *rootPtr, int keyc, + Tcl_Obj *rootPtr, Tcl_Size keyc, Tcl_Obj *const keyv[], int flags); /* 226 */ EXTERN int TclObjBeingDeleted(Tcl_Obj *objPtr); /* 227 */ -EXTERN void TclSetNsPath(Namespace *nsPtr, int pathLength, +EXTERN void TclSetNsPath(Namespace *nsPtr, Tcl_Size pathLength, Tcl_Namespace *pathAry[]); /* Slot 228 is reserved */ /* 229 */ @@ -580,9 +500,7 @@ EXTERN Var * TclVarHashCreateVar(TclVarHashTable *tablePtr, /* 235 */ EXTERN void TclInitVarHashTable(TclVarHashTable *tablePtr, Namespace *nsPtr); -/* 236 */ -TCL_DEPRECATED("use Tcl_BackgroundException") -void TclBackgroundException(Tcl_Interp *interp, int code); +/* Slot 236 is reserved */ /* 237 */ EXTERN int TclResetCancellation(Tcl_Interp *interp, int force); /* 238 */ @@ -590,7 +508,7 @@ EXTERN int TclNRInterpProc(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 239 */ EXTERN int TclNRInterpProcCore(Tcl_Interp *interp, - Tcl_Obj *procNameObj, int skip, + Tcl_Obj *procNameObj, Tcl_Size skip, ProcErrorProc *errorProc); /* 240 */ EXTERN int TclNRRunCallbacks(Tcl_Interp *interp, int result, @@ -599,7 +517,7 @@ EXTERN int TclNRRunCallbacks(Tcl_Interp *interp, int result, EXTERN int TclNREvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, const CmdFrame *invoker, int word); /* 242 */ -EXTERN int TclNREvalObjv(Tcl_Interp *interp, int objc, +EXTERN int TclNREvalObjv(Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const objv[], int flags, Command *cmdPtr); /* 243 */ @@ -610,7 +528,7 @@ EXTERN Tcl_HashTable * TclGetNamespaceChildTable(Tcl_Namespace *nsPtr); EXTERN Tcl_HashTable * TclGetNamespaceCommandTable(Tcl_Namespace *nsPtr); /* 246 */ EXTERN int TclInitRewriteEnsemble(Tcl_Interp *interp, - int numRemoved, int numInserted, + Tcl_Size numRemoved, Tcl_Size numInserted, Tcl_Obj *const *objv); /* 247 */ EXTERN void TclResetRewriteEnsemble(Tcl_Interp *interp, @@ -626,8 +544,8 @@ EXTERN char * TclDoubleDigits(double dv, int ndigits, int flags, EXTERN void TclSetChildCancelFlags(Tcl_Interp *interp, int flags, int force); /* 251 */ -EXTERN int TclRegisterLiteral(void *envPtr, const char *bytes, - int length, int flags); +EXTERN Tcl_Size TclRegisterLiteral(void *envPtr, const char *bytes, + Tcl_Size length, int flags); /* 252 */ EXTERN Tcl_Obj * TclPtrGetVar(Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, @@ -675,11 +593,11 @@ typedef struct TclIntStubs { void (*reserved2)(void); void (*tclAllocateFreeObjects) (void); /* 3 */ void (*reserved4)(void); - int (*tclCleanupChildren) (Tcl_Interp *interp, int numPids, Tcl_Pid *pidPtr, Tcl_Channel errorChan); /* 5 */ + int (*tclCleanupChildren) (Tcl_Interp *interp, Tcl_Size numPids, Tcl_Pid *pidPtr, Tcl_Channel errorChan); /* 5 */ void (*tclCleanupCommand) (Command *cmdPtr); /* 6 */ - int (*tclCopyAndCollapse) (int count, const char *src, char *dst); /* 7 */ - TCL_DEPRECATED_API("") int (*tclCopyChannelOld) (Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr); /* 8 */ - int (*tclCreatePipeline) (Tcl_Interp *interp, int argc, const char **argv, Tcl_Pid **pidArrayPtr, TclFile *inPipePtr, TclFile *outPipePtr, TclFile *errFilePtr); /* 9 */ + Tcl_Size (*tclCopyAndCollapse) (Tcl_Size count, const char *src, char *dst); /* 7 */ + void (*reserved8)(void); + Tcl_Size (*tclCreatePipeline) (Tcl_Interp *interp, Tcl_Size argc, const char **argv, Tcl_Pid **pidArrayPtr, TclFile *inPipePtr, TclFile *outPipePtr, TclFile *errFilePtr); /* 9 */ int (*tclCreateProc) (Tcl_Interp *interp, Namespace *nsPtr, const char *procName, Tcl_Obj *argsPtr, Tcl_Obj *bodyPtr, Proc **procPtrPtr); /* 10 */ void (*tclDeleteCompiledLocalVars) (Interp *iPtr, CallFrame *framePtr); /* 11 */ void (*tclDeleteVars) (Interp *iPtr, TclVarHashTable *tablePtr); /* 12 */ @@ -692,9 +610,9 @@ typedef struct TclIntStubs { void (*reserved19)(void); void (*reserved20)(void); void (*reserved21)(void); - int (*tclFindElement) (Tcl_Interp *interp, const char *listStr, int listLength, const char **elementPtr, const char **nextPtr, int *sizePtr, int *bracePtr); /* 22 */ + int (*tclFindElement) (Tcl_Interp *interp, const char *listStr, Tcl_Size listLength, const char **elementPtr, const char **nextPtr, Tcl_Size *sizePtr, int *bracePtr); /* 22 */ Proc * (*tclFindProc) (Interp *iPtr, const char *procName); /* 23 */ - int (*tclFormatInt) (char *buffer, Tcl_WideInt n); /* 24 */ + Tcl_Size (*tclFormatInt) (char *buffer, Tcl_WideInt n); /* 24 */ void (*tclFreePackageInfo) (Interp *iPtr); /* 25 */ void (*reserved26)(void); void (*reserved27)(void); @@ -704,23 +622,23 @@ typedef struct TclIntStubs { const char * (*tclGetExtension) (const char *name); /* 31 */ int (*tclGetFrame) (Tcl_Interp *interp, const char *str, CallFrame **framePtrPtr); /* 32 */ void (*reserved33)(void); - TCL_DEPRECATED_API("Use Tcl_GetIntForIndex") int (*tclGetIntForIndex) (Tcl_Interp *interp, Tcl_Obj *objPtr, int endValue, int *indexPtr); /* 34 */ + void (*reserved34)(void); void (*reserved35)(void); void (*reserved36)(void); - int (*tclGetLoadedPackages) (Tcl_Interp *interp, const char *targetName); /* 37 */ + void (*reserved37)(void); int (*tclGetNamespaceForQualName) (Tcl_Interp *interp, const char *qualName, Namespace *cxtNsPtr, int flags, Namespace **nsPtrPtr, Namespace **altNsPtrPtr, Namespace **actualCxtPtrPtr, const char **simpleNamePtr); /* 38 */ Tcl_ObjCmdProc * (*tclGetObjInterpProc) (void); /* 39 */ int (*tclGetOpenMode) (Tcl_Interp *interp, const char *str, int *seekFlagPtr); /* 40 */ Tcl_Command (*tclGetOriginalCommand) (Tcl_Command command); /* 41 */ const char * (*tclpGetUserHome) (const char *name, Tcl_DString *bufferPtr); /* 42 */ Tcl_ObjCmdProc2 * (*tclGetObjInterpProc2) (void); /* 43 */ - int (*tclGuessPackageName) (const char *fileName, Tcl_DString *bufPtr); /* 44 */ + void (*reserved44)(void); int (*tclHideUnsafeCommands) (Tcl_Interp *interp); /* 45 */ int (*tclInExit) (void); /* 46 */ void (*reserved47)(void); void (*reserved48)(void); void (*reserved49)(void); - void (*tclInitCompiledLocals) (Tcl_Interp *interp, CallFrame *framePtr, Namespace *nsPtr); /* 50 */ + void (*reserved50)(void); int (*tclInterpInit) (Tcl_Interp *interp); /* 51 */ void (*reserved52)(void); int (*tclInvokeObjectCommand) (void *clientData, Tcl_Interp *interp, int argc, const char **argv); /* 53 */ @@ -739,26 +657,26 @@ typedef struct TclIntStubs { void (*reserved66)(void); void (*reserved67)(void); void (*reserved68)(void); - void * (*tclpAlloc) (unsigned int size); /* 69 */ + void * (*tclpAlloc) (TCL_HASH_TYPE size); /* 69 */ void (*reserved70)(void); void (*reserved71)(void); void (*reserved72)(void); void (*reserved73)(void); void (*tclpFree) (void *ptr); /* 74 */ - unsigned long (*tclpGetClicks) (void); /* 75 */ - unsigned long (*tclpGetSeconds) (void); /* 76 */ - TCL_DEPRECATED_API("") void (*tclpGetTime) (Tcl_Time *time); /* 77 */ + unsigned long long (*tclpGetClicks) (void); /* 75 */ + unsigned long long (*tclpGetSeconds) (void); /* 76 */ + void (*reserved77)(void); void (*reserved78)(void); void (*reserved79)(void); void (*reserved80)(void); - void * (*tclpRealloc) (void *ptr, unsigned int size); /* 81 */ + void * (*tclpRealloc) (void *ptr, TCL_HASH_TYPE size); /* 81 */ void (*reserved82)(void); void (*reserved83)(void); void (*reserved84)(void); void (*reserved85)(void); void (*reserved86)(void); void (*reserved87)(void); - TCL_DEPRECATED_API("") char * (*tclPrecTraceProc) (void *clientData, Tcl_Interp *interp, const char *name1, const char *name2, int flags); /* 88 */ + void (*reserved88)(void); int (*tclPreventAliasLoop) (Tcl_Interp *interp, Tcl_Interp *cmdInterp, Tcl_Command cmd); /* 89 */ void (*reserved90)(void); void (*tclProcCleanupProc) (Proc *procPtr); /* 91 */ @@ -771,39 +689,39 @@ typedef struct TclIntStubs { int (*tclServiceIdle) (void); /* 98 */ void (*reserved99)(void); void (*reserved100)(void); - const char * (*tclSetPreInitScript) (const char *string); /* 101 */ + void (*reserved101)(void); void (*tclSetupEnv) (Tcl_Interp *interp); /* 102 */ int (*tclSockGetPort) (Tcl_Interp *interp, const char *str, const char *proto, int *portPtr); /* 103 */ - TCL_DEPRECATED_API("") int (*tclSockMinimumBuffersOld) (int sock, int size); /* 104 */ + void (*reserved104)(void); void (*reserved105)(void); void (*reserved106)(void); void (*reserved107)(void); void (*tclTeardownNamespace) (Namespace *nsPtr); /* 108 */ int (*tclUpdateReturnInfo) (Interp *iPtr); /* 109 */ - int (*tclSockMinimumBuffers) (void *sock, int size); /* 110 */ + int (*tclSockMinimumBuffers) (void *sock, Tcl_Size size); /* 110 */ void (*tcl_AddInterpResolvers) (Tcl_Interp *interp, const char *name, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc); /* 111 */ - int (*tclAppendExportList) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *objPtr); /* 112 */ - Tcl_Namespace * (*tclCreateNamespace) (Tcl_Interp *interp, const char *name, void *clientData, Tcl_NamespaceDeleteProc *deleteProc); /* 113 */ - void (*tclDeleteNamespace) (Tcl_Namespace *nsPtr); /* 114 */ - int (*tclExport) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int resetListFirst); /* 115 */ - Tcl_Command (*tclFindCommand) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 116 */ - Tcl_Namespace * (*tclFindNamespace) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 117 */ + void (*reserved112)(void); + void (*reserved113)(void); + void (*reserved114)(void); + void (*reserved115)(void); + void (*reserved116)(void); + void (*reserved117)(void); int (*tcl_GetInterpResolvers) (Tcl_Interp *interp, const char *name, Tcl_ResolverInfo *resInfo); /* 118 */ int (*tcl_GetNamespaceResolvers) (Tcl_Namespace *namespacePtr, Tcl_ResolverInfo *resInfo); /* 119 */ Tcl_Var (*tcl_FindNamespaceVar) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 120 */ - int (*tclForgetImport) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern); /* 121 */ - Tcl_Command (*tclGetCommandFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 122 */ - void (*tclGetCommandFullName) (Tcl_Interp *interp, Tcl_Command command, Tcl_Obj *objPtr); /* 123 */ - Tcl_Namespace * (*tclGetCurrentNamespace_) (Tcl_Interp *interp); /* 124 */ - Tcl_Namespace * (*tclGetGlobalNamespace_) (Tcl_Interp *interp); /* 125 */ + void (*reserved121)(void); + void (*reserved122)(void); + void (*reserved123)(void); + void (*reserved124)(void); + void (*reserved125)(void); void (*tcl_GetVariableFullName) (Tcl_Interp *interp, Tcl_Var variable, Tcl_Obj *objPtr); /* 126 */ - int (*tclImport) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int allowOverwrite); /* 127 */ + void (*reserved127)(void); void (*tcl_PopCallFrame) (Tcl_Interp *interp); /* 128 */ int (*tcl_PushCallFrame) (Tcl_Interp *interp, Tcl_CallFrame *framePtr, Tcl_Namespace *nsPtr, int isProcCallFrame); /* 129 */ int (*tcl_RemoveInterpResolvers) (Tcl_Interp *interp, const char *name); /* 130 */ void (*tcl_SetNamespaceResolvers) (Tcl_Namespace *namespacePtr, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc); /* 131 */ - TCL_DEPRECATED_API("") int (*tclpHasSockets) (Tcl_Interp *interp); /* 132 */ - TCL_DEPRECATED_API("") struct tm * (*tclpGetDate) (const time_t *time, int useGMT); /* 133 */ + void (*reserved132)(void); + void (*reserved133)(void); void (*reserved134)(void); void (*reserved135)(void); void (*reserved136)(void); @@ -813,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 */ - int (*tclAddLiteralObj) (struct CompileEnv *envPtr, Tcl_Obj *objPtr, LiteralEntry **litPtrPtr); /* 143 */ + Tcl_Size (*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 */ @@ -821,39 +739,39 @@ typedef struct TclIntStubs { TclHandle (*tclHandlePreserve) (TclHandle handle); /* 148 */ void (*tclHandleRelease) (TclHandle handle); /* 149 */ int (*tclRegAbout) (Tcl_Interp *interp, Tcl_RegExp re); /* 150 */ - void (*tclRegExpRangeUniChar) (Tcl_RegExp re, int index, int *startPtr, int *endPtr); /* 151 */ + void (*tclRegExpRangeUniChar) (Tcl_RegExp re, Tcl_Size index, Tcl_Size *startPtr, Tcl_Size *endPtr); /* 151 */ void (*tclSetLibraryPath) (Tcl_Obj *pathPtr); /* 152 */ Tcl_Obj * (*tclGetLibraryPath) (void); /* 153 */ void (*reserved154)(void); void (*reserved155)(void); void (*tclRegError) (Tcl_Interp *interp, const char *msg, int status); /* 156 */ Var * (*tclVarTraceExists) (Tcl_Interp *interp, const char *varName); /* 157 */ - TCL_DEPRECATED_API("use public Tcl_SetStartupScript()") void (*tclSetStartupScriptFileName) (const char *filename); /* 158 */ - TCL_DEPRECATED_API("use public Tcl_GetStartupScript()") const char * (*tclGetStartupScriptFileName) (void); /* 159 */ + void (*reserved158)(void); + void (*reserved159)(void); void (*reserved160)(void); int (*tclChannelTransform) (Tcl_Interp *interp, Tcl_Channel chan, Tcl_Obj *cmdObjPtr); /* 161 */ void (*tclChannelEventScriptInvoker) (void *clientData, int flags); /* 162 */ const void * (*tclGetInstructionTable) (void); /* 163 */ void (*tclExpandCodeArray) (void *envPtr); /* 164 */ void (*tclpSetInitialEncodings) (void); /* 165 */ - int (*tclListObjSetElement) (Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj *valuePtr); /* 166 */ - TCL_DEPRECATED_API("use public Tcl_SetStartupScript()") void (*tclSetStartupScriptPath) (Tcl_Obj *pathPtr); /* 167 */ - TCL_DEPRECATED_API("use public Tcl_GetStartupScript()") Tcl_Obj * (*tclGetStartupScriptPath) (void); /* 168 */ - int (*tclpUtfNcmp2) (const char *s1, const char *s2, unsigned long n); /* 169 */ - int (*tclCheckInterpTraces) (Tcl_Interp *interp, const char *command, int numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]); /* 170 */ - int (*tclCheckExecutionTraces) (Tcl_Interp *interp, const char *command, int numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]); /* 171 */ + int (*tclListObjSetElement) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size index, Tcl_Obj *valuePtr); /* 166 */ + void (*reserved167)(void); + void (*reserved168)(void); + int (*tclpUtfNcmp2) (const char *s1, const char *s2, size_t n); /* 169 */ + int (*tclCheckInterpTraces) (Tcl_Interp *interp, const char *command, Tcl_Size numChars, Command *cmdPtr, int result, int traceFlags, Tcl_Size objc, Tcl_Obj *const objv[]); /* 170 */ + int (*tclCheckExecutionTraces) (Tcl_Interp *interp, const char *command, Tcl_Size numChars, Command *cmdPtr, int result, int traceFlags, Tcl_Size objc, Tcl_Obj *const objv[]); /* 171 */ int (*tclInThreadExit) (void); /* 172 */ - int (*tclUniCharMatch) (const Tcl_UniChar *string, int strLen, const Tcl_UniChar *pattern, int ptnLen, int flags); /* 173 */ + int (*tclUniCharMatch) (const Tcl_UniChar *string, Tcl_Size strLen, const Tcl_UniChar *pattern, Tcl_Size ptnLen, int flags); /* 173 */ void (*reserved174)(void); int (*tclCallVarTraces) (Interp *iPtr, Var *arrayPtr, Var *varPtr, const char *part1, const char *part2, int flags, int leaveErrMsg); /* 175 */ void (*tclCleanupVar) (Var *varPtr, Var *arrayPtr); /* 176 */ void (*tclVarErrMsg) (Tcl_Interp *interp, const char *part1, const char *part2, const char *operation, const char *reason); /* 177 */ - void (*tclSetStartupScript) (Tcl_Obj *pathPtr, const char *encodingName); /* 178 */ - Tcl_Obj * (*tclGetStartupScript) (const char **encodingNamePtr); /* 179 */ + void (*reserved178)(void); + void (*reserved179)(void); void (*reserved180)(void); void (*reserved181)(void); - TCL_DEPRECATED_API("") struct tm * (*tclpLocaltime) (const time_t *clock); /* 182 */ - TCL_DEPRECATED_API("") struct tm * (*tclpGmtime) (const time_t *clock); /* 183 */ + void (*reserved182)(void); + void (*reserved183)(void); void (*reserved184)(void); void (*reserved185)(void); void (*reserved186)(void); @@ -885,7 +803,7 @@ typedef struct TclIntStubs { void (*tclpFindExecutable) (const char *argv0); /* 212 */ Tcl_Obj * (*tclGetObjNameOfExecutable) (void); /* 213 */ void (*tclSetObjNameOfExecutable) (Tcl_Obj *name, Tcl_Encoding encoding); /* 214 */ - void * (*tclStackAlloc) (Tcl_Interp *interp, int numBytes); /* 215 */ + void * (*tclStackAlloc) (Tcl_Interp *interp, Tcl_Size numBytes); /* 215 */ void (*tclStackFree) (Tcl_Interp *interp, void *freePtr); /* 216 */ int (*tclPushStackFrame) (Tcl_Interp *interp, Tcl_CallFrame **framePtrPtr, Tcl_Namespace *namespacePtr, int isProcCallFrame); /* 217 */ void (*tclPopStackFrame) (Tcl_Interp *interp); /* 218 */ @@ -895,9 +813,9 @@ typedef struct TclIntStubs { void (*reserved222)(void); void (*reserved223)(void); TclPlatformType * (*tclGetPlatform) (void); /* 224 */ - Tcl_Obj * (*tclTraceDictPath) (Tcl_Interp *interp, Tcl_Obj *rootPtr, int keyc, Tcl_Obj *const keyv[], int flags); /* 225 */ + Tcl_Obj * (*tclTraceDictPath) (Tcl_Interp *interp, Tcl_Obj *rootPtr, Tcl_Size keyc, Tcl_Obj *const keyv[], int flags); /* 225 */ int (*tclObjBeingDeleted) (Tcl_Obj *objPtr); /* 226 */ - void (*tclSetNsPath) (Namespace *nsPtr, int pathLength, Tcl_Namespace *pathAry[]); /* 227 */ + void (*tclSetNsPath) (Namespace *nsPtr, Tcl_Size pathLength, Tcl_Namespace *pathAry[]); /* 227 */ void (*reserved228)(void); int (*tclPtrMakeUpvar) (Tcl_Interp *interp, Var *otherP1Ptr, const char *myName, int myFlags, int index); /* 229 */ Var * (*tclObjLookupVar) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, const char *part2, int flags, const char *msg, int createPart1, int createPart2, Var **arrayPtrPtr); /* 230 */ @@ -906,22 +824,22 @@ typedef struct TclIntStubs { void (*tclGetSrcInfoForPc) (CmdFrame *contextPtr); /* 233 */ Var * (*tclVarHashCreateVar) (TclVarHashTable *tablePtr, const char *key, int *newPtr); /* 234 */ void (*tclInitVarHashTable) (TclVarHashTable *tablePtr, Namespace *nsPtr); /* 235 */ - TCL_DEPRECATED_API("use Tcl_BackgroundException") void (*tclBackgroundException) (Tcl_Interp *interp, int code); /* 236 */ + void (*reserved236)(void); int (*tclResetCancellation) (Tcl_Interp *interp, int force); /* 237 */ int (*tclNRInterpProc) (void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 238 */ - int (*tclNRInterpProcCore) (Tcl_Interp *interp, Tcl_Obj *procNameObj, int skip, ProcErrorProc *errorProc); /* 239 */ + int (*tclNRInterpProcCore) (Tcl_Interp *interp, Tcl_Obj *procNameObj, Tcl_Size skip, ProcErrorProc *errorProc); /* 239 */ int (*tclNRRunCallbacks) (Tcl_Interp *interp, int result, struct NRE_callback *rootPtr); /* 240 */ int (*tclNREvalObjEx) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, const CmdFrame *invoker, int word); /* 241 */ - int (*tclNREvalObjv) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags, Command *cmdPtr); /* 242 */ + int (*tclNREvalObjv) (Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const objv[], int flags, Command *cmdPtr); /* 242 */ void (*tclDbDumpActiveObjects) (FILE *outFile); /* 243 */ Tcl_HashTable * (*tclGetNamespaceChildTable) (Tcl_Namespace *nsPtr); /* 244 */ Tcl_HashTable * (*tclGetNamespaceCommandTable) (Tcl_Namespace *nsPtr); /* 245 */ - int (*tclInitRewriteEnsemble) (Tcl_Interp *interp, int numRemoved, int numInserted, Tcl_Obj *const *objv); /* 246 */ + int (*tclInitRewriteEnsemble) (Tcl_Interp *interp, Tcl_Size numRemoved, Tcl_Size numInserted, Tcl_Obj *const *objv); /* 246 */ void (*tclResetRewriteEnsemble) (Tcl_Interp *interp, int isRootEnsemble); /* 247 */ 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 */ - int (*tclRegisterLiteral) (void *envPtr, const char *bytes, int length, int flags); /* 251 */ + Tcl_Size (*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 */ @@ -958,8 +876,7 @@ extern const TclIntStubs *tclIntStubsPtr; (tclIntStubsPtr->tclCleanupCommand) /* 6 */ #define TclCopyAndCollapse \ (tclIntStubsPtr->tclCopyAndCollapse) /* 7 */ -#define TclCopyChannelOld \ - (tclIntStubsPtr->tclCopyChannelOld) /* 8 */ +/* Slot 8 is reserved */ #define TclCreatePipeline \ (tclIntStubsPtr->tclCreatePipeline) /* 9 */ #define TclCreateProc \ @@ -998,12 +915,10 @@ extern const TclIntStubs *tclIntStubsPtr; #define TclGetFrame \ (tclIntStubsPtr->tclGetFrame) /* 32 */ /* Slot 33 is reserved */ -#define TclGetIntForIndex \ - (tclIntStubsPtr->tclGetIntForIndex) /* 34 */ +/* Slot 34 is reserved */ /* Slot 35 is reserved */ /* Slot 36 is reserved */ -#define TclGetLoadedPackages \ - (tclIntStubsPtr->tclGetLoadedPackages) /* 37 */ +/* Slot 37 is reserved */ #define TclGetNamespaceForQualName \ (tclIntStubsPtr->tclGetNamespaceForQualName) /* 38 */ #define TclGetObjInterpProc \ @@ -1016,8 +931,7 @@ extern const TclIntStubs *tclIntStubsPtr; (tclIntStubsPtr->tclpGetUserHome) /* 42 */ #define TclGetObjInterpProc2 \ (tclIntStubsPtr->tclGetObjInterpProc2) /* 43 */ -#define TclGuessPackageName \ - (tclIntStubsPtr->tclGuessPackageName) /* 44 */ +/* Slot 44 is reserved */ #define TclHideUnsafeCommands \ (tclIntStubsPtr->tclHideUnsafeCommands) /* 45 */ #define TclInExit \ @@ -1025,8 +939,7 @@ extern const TclIntStubs *tclIntStubsPtr; /* Slot 47 is reserved */ /* Slot 48 is reserved */ /* Slot 49 is reserved */ -#define TclInitCompiledLocals \ - (tclIntStubsPtr->tclInitCompiledLocals) /* 50 */ +/* Slot 50 is reserved */ #define TclInterpInit \ (tclIntStubsPtr->tclInterpInit) /* 51 */ /* Slot 52 is reserved */ @@ -1067,8 +980,7 @@ extern const TclIntStubs *tclIntStubsPtr; (tclIntStubsPtr->tclpGetClicks) /* 75 */ #define TclpGetSeconds \ (tclIntStubsPtr->tclpGetSeconds) /* 76 */ -#define TclpGetTime \ - (tclIntStubsPtr->tclpGetTime) /* 77 */ +/* Slot 77 is reserved */ /* Slot 78 is reserved */ /* Slot 79 is reserved */ /* Slot 80 is reserved */ @@ -1080,8 +992,7 @@ extern const TclIntStubs *tclIntStubsPtr; /* Slot 85 is reserved */ /* Slot 86 is reserved */ /* Slot 87 is reserved */ -#define TclPrecTraceProc \ - (tclIntStubsPtr->tclPrecTraceProc) /* 88 */ +/* Slot 88 is reserved */ #define TclPreventAliasLoop \ (tclIntStubsPtr->tclPreventAliasLoop) /* 89 */ /* Slot 90 is reserved */ @@ -1101,14 +1012,12 @@ extern const TclIntStubs *tclIntStubsPtr; (tclIntStubsPtr->tclServiceIdle) /* 98 */ /* Slot 99 is reserved */ /* Slot 100 is reserved */ -#define TclSetPreInitScript \ - (tclIntStubsPtr->tclSetPreInitScript) /* 101 */ +/* Slot 101 is reserved */ #define TclSetupEnv \ (tclIntStubsPtr->tclSetupEnv) /* 102 */ #define TclSockGetPort \ (tclIntStubsPtr->tclSockGetPort) /* 103 */ -#define TclSockMinimumBuffersOld \ - (tclIntStubsPtr->tclSockMinimumBuffersOld) /* 104 */ +/* Slot 104 is reserved */ /* Slot 105 is reserved */ /* Slot 106 is reserved */ /* Slot 107 is reserved */ @@ -1120,38 +1029,26 @@ extern const TclIntStubs *tclIntStubsPtr; (tclIntStubsPtr->tclSockMinimumBuffers) /* 110 */ #define Tcl_AddInterpResolvers \ (tclIntStubsPtr->tcl_AddInterpResolvers) /* 111 */ -#define TclAppendExportList \ - (tclIntStubsPtr->tclAppendExportList) /* 112 */ -#define TclCreateNamespace \ - (tclIntStubsPtr->tclCreateNamespace) /* 113 */ -#define TclDeleteNamespace \ - (tclIntStubsPtr->tclDeleteNamespace) /* 114 */ -#define TclExport \ - (tclIntStubsPtr->tclExport) /* 115 */ -#define TclFindCommand \ - (tclIntStubsPtr->tclFindCommand) /* 116 */ -#define TclFindNamespace \ - (tclIntStubsPtr->tclFindNamespace) /* 117 */ +/* Slot 112 is reserved */ +/* Slot 113 is reserved */ +/* Slot 114 is reserved */ +/* Slot 115 is reserved */ +/* Slot 116 is reserved */ +/* Slot 117 is reserved */ #define Tcl_GetInterpResolvers \ (tclIntStubsPtr->tcl_GetInterpResolvers) /* 118 */ #define Tcl_GetNamespaceResolvers \ (tclIntStubsPtr->tcl_GetNamespaceResolvers) /* 119 */ #define Tcl_FindNamespaceVar \ (tclIntStubsPtr->tcl_FindNamespaceVar) /* 120 */ -#define TclForgetImport \ - (tclIntStubsPtr->tclForgetImport) /* 121 */ -#define TclGetCommandFromObj \ - (tclIntStubsPtr->tclGetCommandFromObj) /* 122 */ -#define TclGetCommandFullName \ - (tclIntStubsPtr->tclGetCommandFullName) /* 123 */ -#define TclGetCurrentNamespace_ \ - (tclIntStubsPtr->tclGetCurrentNamespace_) /* 124 */ -#define TclGetGlobalNamespace_ \ - (tclIntStubsPtr->tclGetGlobalNamespace_) /* 125 */ +/* Slot 121 is reserved */ +/* Slot 122 is reserved */ +/* Slot 123 is reserved */ +/* Slot 124 is reserved */ +/* Slot 125 is reserved */ #define Tcl_GetVariableFullName \ (tclIntStubsPtr->tcl_GetVariableFullName) /* 126 */ -#define TclImport \ - (tclIntStubsPtr->tclImport) /* 127 */ +/* Slot 127 is reserved */ #define Tcl_PopCallFrame \ (tclIntStubsPtr->tcl_PopCallFrame) /* 128 */ #define Tcl_PushCallFrame \ @@ -1160,10 +1057,8 @@ extern const TclIntStubs *tclIntStubsPtr; (tclIntStubsPtr->tcl_RemoveInterpResolvers) /* 130 */ #define Tcl_SetNamespaceResolvers \ (tclIntStubsPtr->tcl_SetNamespaceResolvers) /* 131 */ -#define TclpHasSockets \ - (tclIntStubsPtr->tclpHasSockets) /* 132 */ -#define TclpGetDate \ - (tclIntStubsPtr->tclpGetDate) /* 133 */ +/* Slot 132 is reserved */ +/* Slot 133 is reserved */ /* Slot 134 is reserved */ /* Slot 135 is reserved */ /* Slot 136 is reserved */ @@ -1204,10 +1099,8 @@ extern const TclIntStubs *tclIntStubsPtr; (tclIntStubsPtr->tclRegError) /* 156 */ #define TclVarTraceExists \ (tclIntStubsPtr->tclVarTraceExists) /* 157 */ -#define TclSetStartupScriptFileName \ - (tclIntStubsPtr->tclSetStartupScriptFileName) /* 158 */ -#define TclGetStartupScriptFileName \ - (tclIntStubsPtr->tclGetStartupScriptFileName) /* 159 */ +/* Slot 158 is reserved */ +/* Slot 159 is reserved */ /* Slot 160 is reserved */ #define TclChannelTransform \ (tclIntStubsPtr->tclChannelTransform) /* 161 */ @@ -1221,10 +1114,8 @@ extern const TclIntStubs *tclIntStubsPtr; (tclIntStubsPtr->tclpSetInitialEncodings) /* 165 */ #define TclListObjSetElement \ (tclIntStubsPtr->tclListObjSetElement) /* 166 */ -#define TclSetStartupScriptPath \ - (tclIntStubsPtr->tclSetStartupScriptPath) /* 167 */ -#define TclGetStartupScriptPath \ - (tclIntStubsPtr->tclGetStartupScriptPath) /* 168 */ +/* Slot 167 is reserved */ +/* Slot 168 is reserved */ #define TclpUtfNcmp2 \ (tclIntStubsPtr->tclpUtfNcmp2) /* 169 */ #define TclCheckInterpTraces \ @@ -1242,16 +1133,12 @@ extern const TclIntStubs *tclIntStubsPtr; (tclIntStubsPtr->tclCleanupVar) /* 176 */ #define TclVarErrMsg \ (tclIntStubsPtr->tclVarErrMsg) /* 177 */ -#define TclSetStartupScript \ - (tclIntStubsPtr->tclSetStartupScript) /* 178 */ -#define TclGetStartupScript \ - (tclIntStubsPtr->tclGetStartupScript) /* 179 */ +/* Slot 178 is reserved */ +/* Slot 179 is reserved */ /* Slot 180 is reserved */ /* Slot 181 is reserved */ -#define TclpLocaltime \ - (tclIntStubsPtr->tclpLocaltime) /* 182 */ -#define TclpGmtime \ - (tclIntStubsPtr->tclpGmtime) /* 183 */ +/* Slot 182 is reserved */ +/* Slot 183 is reserved */ /* Slot 184 is reserved */ /* Slot 185 is reserved */ /* Slot 186 is reserved */ @@ -1332,8 +1219,7 @@ extern const TclIntStubs *tclIntStubsPtr; (tclIntStubsPtr->tclVarHashCreateVar) /* 234 */ #define TclInitVarHashTable \ (tclIntStubsPtr->tclInitVarHashTable) /* 235 */ -#define TclBackgroundException \ - (tclIntStubsPtr->tclBackgroundException) /* 236 */ +/* Slot 236 is reserved */ #define TclResetCancellation \ (tclIntStubsPtr->tclResetCancellation) /* 237 */ #define TclNRInterpProc \ @@ -1388,45 +1274,26 @@ extern const TclIntStubs *tclIntStubsPtr; /* !END!: Do not edit above this line. */ -#undef TCL_STORAGE_CLASS -#define TCL_STORAGE_CLASS DLLIMPORT - #if defined(USE_TCL_STUBS) -# undef TclGetStartupScriptFileName -# undef TclSetStartupScriptFileName -# undef TclGetStartupScriptPath -# undef TclSetStartupScriptPath -# undef TclBackgroundException -# undef TclSetStartupScript -# undef TclGetStartupScript -# undef TclGetIntForIndex -# undef TclCreateNamespace -# undef TclDeleteNamespace -# undef TclAppendExportList -# undef TclExport -# undef TclImport -# undef TclForgetImport -# undef TclGetCurrentNamespace_ -# undef TclGetGlobalNamespace_ -# undef TclFindNamespace -# undef TclFindCommand -# undef TclGetCommandFromObj -# undef TclGetCommandFullName -# undef TclCopyChannelOld -# undef TclSockMinimumBuffersOld -# undef Tcl_StaticLibrary -# define Tcl_StaticLibrary (tclIntStubsPtr->tclStaticLibrary) +#undef Tcl_StaticLibrary +#define Tcl_StaticLibrary \ + (tclIntStubsPtr->tclStaticLibrary) +#endif /* defined(USE_TCL_STUBS) */ + +#if (TCL_MAJOR_VERSION < 9) && defined(USE_TCL_STUBS) +#undef TclpGetClicks +#define TclpGetClicks() \ + ((unsigned long)tclIntStubsPtr->tclpGetClicks()) +#undef TclpGetSeconds +#define TclpGetSeconds() \ + ((unsigned long)tclIntStubsPtr->tclpGetSeconds()) #endif -#undef TclGuessPackageName -#undef TclUnusedStubEntry -#undef TclSetPreInitScript #undef TclObjInterpProc #define TclObjInterpProc TclGetObjInterpProc() #define TclObjInterpProc2 TclGetObjInterpProc2() -#ifndef TCL_NO_DEPRECATED -# define TclSetPreInitScript Tcl_SetPreInitScript -# define TclGuessPackageName(fileName, pkgName) ((void)fileName,(void)pkgName,0) -#endif + +#undef TCL_STORAGE_CLASS +#define TCL_STORAGE_CLASS DLLIMPORT #endif /* _TCLINTDECLS */ diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h index bd8d8e5..cab43a4 100644 --- a/generic/tclIntPlatDecls.h +++ b/generic/tclIntPlatDecls.h @@ -30,7 +30,7 @@ * in the generic/tclInt.decls script. */ -/* !BEGIN!: Do not edit below this line. */ +#if TCL_MAJOR_VERSION < 9 #ifdef __cplusplus extern "C" { @@ -140,8 +140,6 @@ EXTERN int TclWinSetSockOpt(SOCKET s, int level, int optname, EXTERN int TclpGetPid(Tcl_Pid pid); /* 9 */ EXTERN int TclWinGetPlatformId(void); -/* 10 */ -EXTERN Tcl_DirEntry * TclpReaddir(TclDIR *dir); /* 11 */ EXTERN void TclGetAndDetachPids(Tcl_Interp *interp, Tcl_Channel chan); @@ -316,7 +314,7 @@ typedef struct TclIntPlatStubs { int (*tclWinSetSockOpt) (SOCKET s, int level, int optname, const char *optval, int optlen); /* 7 */ int (*tclpGetPid) (Tcl_Pid pid); /* 8 */ int (*tclWinGetPlatformId) (void); /* 9 */ - Tcl_DirEntry * (*tclpReaddir) (TclDIR *dir); /* 10 */ + void *(*tclpReaddir) (void *dir); /* 10 */ void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 11 */ int (*tclpCloseFile) (TclFile file); /* 12 */ Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 13 */ @@ -462,8 +460,6 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; (tclIntPlatStubsPtr->tclpGetPid) /* 8 */ #define TclWinGetPlatformId \ (tclIntPlatStubsPtr->tclWinGetPlatformId) /* 9 */ -#define TclpReaddir \ - (tclIntPlatStubsPtr->tclpReaddir) /* 10 */ #define TclGetAndDetachPids \ (tclIntPlatStubsPtr->tclGetAndDetachPids) /* 11 */ #define TclpCloseFile \ @@ -562,7 +558,180 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; #endif /* defined(USE_TCL_STUBS) */ +#else /* TCL_MAJOR_VERSION > 8 */ +/* !BEGIN!: Do not edit below this line. */ + +#ifdef __cplusplus +extern "C" { +#endif + +/* + * Exported function declarations: + */ + +/* Slot 0 is reserved */ +/* 1 */ +EXTERN int TclpCloseFile(TclFile file); +/* 2 */ +EXTERN Tcl_Channel TclpCreateCommandChannel(TclFile readFile, + TclFile writeFile, TclFile errorFile, + size_t numPids, Tcl_Pid *pidPtr); +/* 3 */ +EXTERN int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe); +/* 4 */ +EXTERN void * TclWinGetTclInstance(void); +/* 5 */ +EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout); +/* 6 */ +EXTERN TclFile TclpMakeFile(Tcl_Channel channel, int direction); +/* 7 */ +EXTERN TclFile TclpOpenFile(const char *fname, int mode); +/* 8 */ +EXTERN size_t TclpGetPid(Tcl_Pid pid); +/* 9 */ +EXTERN TclFile TclpCreateTempFile(const char *contents); +/* Slot 10 is reserved */ +/* 11 */ +EXTERN void TclGetAndDetachPids(Tcl_Interp *interp, + Tcl_Channel chan); +/* Slot 12 is reserved */ +/* Slot 13 is reserved */ +/* Slot 14 is reserved */ +/* 15 */ +EXTERN int TclpCreateProcess(Tcl_Interp *interp, size_t argc, + const char **argv, TclFile inputFile, + TclFile outputFile, TclFile errorFile, + Tcl_Pid *pidPtr); +/* 16 */ +EXTERN int TclpIsAtty(int fd); +/* 17 */ +EXTERN int TclUnixCopyFile(const char *src, const char *dst, + const Tcl_StatBuf *statBufPtr, + int dontCopyAtts); +/* Slot 18 is reserved */ +/* Slot 19 is reserved */ +/* 20 */ +EXTERN void TclWinAddProcess(void *hProcess, size_t id); +/* Slot 21 is reserved */ +/* Slot 22 is reserved */ +/* Slot 23 is reserved */ +/* 24 */ +EXTERN char * TclWinNoBackslash(char *path); +/* Slot 25 is reserved */ +/* Slot 26 is reserved */ +/* 27 */ +EXTERN void TclWinFlushDirtyChannels(void); +/* Slot 28 is reserved */ +/* 29 */ +EXTERN int TclWinCPUID(int index, int *regs); +/* 30 */ +EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj, + Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, + Tcl_Obj *resultingNameObj); + +typedef struct TclIntPlatStubs { + int magic; + void *hooks; + + void (*reserved0)(void); + int (*tclpCloseFile) (TclFile file); /* 1 */ + Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, size_t numPids, Tcl_Pid *pidPtr); /* 2 */ + int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 3 */ + void * (*tclWinGetTclInstance) (void); /* 4 */ + int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 5 */ + TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 6 */ + TclFile (*tclpOpenFile) (const char *fname, int mode); /* 7 */ + size_t (*tclpGetPid) (Tcl_Pid pid); /* 8 */ + TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */ + void (*reserved10)(void); + void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 11 */ + void (*reserved12)(void); + void (*reserved13)(void); + void (*reserved14)(void); + int (*tclpCreateProcess) (Tcl_Interp *interp, size_t argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 15 */ + int (*tclpIsAtty) (int fd); /* 16 */ + int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 17 */ + void (*reserved18)(void); + void (*reserved19)(void); + void (*tclWinAddProcess) (void *hProcess, size_t id); /* 20 */ + void (*reserved21)(void); + void (*reserved22)(void); + void (*reserved23)(void); + char * (*tclWinNoBackslash) (char *path); /* 24 */ + void (*reserved25)(void); + void (*reserved26)(void); + void (*tclWinFlushDirtyChannels) (void); /* 27 */ + void (*reserved28)(void); + int (*tclWinCPUID) (int index, int *regs); /* 29 */ + int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */ +} TclIntPlatStubs; + +extern const TclIntPlatStubs *tclIntPlatStubsPtr; + +#ifdef __cplusplus +} +#endif + +#if defined(USE_TCL_STUBS) + +/* + * Inline function declarations: + */ + +/* Slot 0 is reserved */ +#define TclpCloseFile \ + (tclIntPlatStubsPtr->tclpCloseFile) /* 1 */ +#define TclpCreateCommandChannel \ + (tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 2 */ +#define TclpCreatePipe \ + (tclIntPlatStubsPtr->tclpCreatePipe) /* 3 */ +#define TclWinGetTclInstance \ + (tclIntPlatStubsPtr->tclWinGetTclInstance) /* 4 */ +#define TclUnixWaitForFile \ + (tclIntPlatStubsPtr->tclUnixWaitForFile) /* 5 */ +#define TclpMakeFile \ + (tclIntPlatStubsPtr->tclpMakeFile) /* 6 */ +#define TclpOpenFile \ + (tclIntPlatStubsPtr->tclpOpenFile) /* 7 */ +#define TclpGetPid \ + (tclIntPlatStubsPtr->tclpGetPid) /* 8 */ +#define TclpCreateTempFile \ + (tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */ +/* Slot 10 is reserved */ +#define TclGetAndDetachPids \ + (tclIntPlatStubsPtr->tclGetAndDetachPids) /* 11 */ +/* Slot 12 is reserved */ +/* Slot 13 is reserved */ +/* Slot 14 is reserved */ +#define TclpCreateProcess \ + (tclIntPlatStubsPtr->tclpCreateProcess) /* 15 */ +#define TclpIsAtty \ + (tclIntPlatStubsPtr->tclpIsAtty) /* 16 */ +#define TclUnixCopyFile \ + (tclIntPlatStubsPtr->tclUnixCopyFile) /* 17 */ +/* Slot 18 is reserved */ +/* Slot 19 is reserved */ +#define TclWinAddProcess \ + (tclIntPlatStubsPtr->tclWinAddProcess) /* 20 */ +/* Slot 21 is reserved */ +/* Slot 22 is reserved */ +/* Slot 23 is reserved */ +#define TclWinNoBackslash \ + (tclIntPlatStubsPtr->tclWinNoBackslash) /* 24 */ +/* Slot 25 is reserved */ +/* Slot 26 is reserved */ +#define TclWinFlushDirtyChannels \ + (tclIntPlatStubsPtr->tclWinFlushDirtyChannels) /* 27 */ +/* Slot 28 is reserved */ +#define TclWinCPUID \ + (tclIntPlatStubsPtr->tclWinCPUID) /* 29 */ +#define TclUnixOpenTemporaryFile \ + (tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */ + +#endif /* defined(USE_TCL_STUBS) */ + /* !END!: Do not edit above this line. */ +#endif /* TCL_MAJOR_VERSION */ #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLIMPORT @@ -580,7 +749,24 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; #undef TclpCreateTempFile_ #undef TclUnixWaitForFile_ -#ifndef MAC_OSX_TCL /* not accessable on Win32/UNIX */ +#ifdef MAC_OSX_TCL /* not accessable on Win32/UNIX */ +MODULE_SCOPE int TclMacOSXGetFileAttribute(Tcl_Interp *interp, + int objIndex, Tcl_Obj *fileName, + Tcl_Obj **attributePtrPtr); +/* 16 */ +MODULE_SCOPE int TclMacOSXSetFileAttribute(Tcl_Interp *interp, + int objIndex, Tcl_Obj *fileName, + Tcl_Obj *attributePtr); +/* 17 */ +MODULE_SCOPE int TclMacOSXCopyFileAttributes(const char *src, + const char *dst, + const Tcl_StatBuf *statBufPtr); +/* 18 */ +MODULE_SCOPE int TclMacOSXMatchType(Tcl_Interp *interp, + const char *pathName, const char *fileName, + Tcl_StatBuf *statBufPtr, + Tcl_GlobTypeData *types); +#else #undef TclMacOSXGetFileAttribute /* 15 */ #undef TclMacOSXSetFileAttribute /* 16 */ #undef TclMacOSXCopyFileAttributes /* 17 */ @@ -607,7 +793,7 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; # endif /* TCL_NO_DEPRECATED */ #else # undef TclpGetPid -# define TclpGetPid(pid) ((int)(size_t)(pid)) +# define TclpGetPid(pid) ((size_t)(pid)) #endif #endif /* _TCLINTPLATDECLS */ diff --git a/generic/tclInterp.c b/generic/tclInterp.c index ad24d28..416f74e 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -12,7 +12,6 @@ */ #include "tclInt.h" -#include <assert.h> /* * A pointer to a string that holds an initialization script that if non-NULL @@ -26,14 +25,14 @@ static const char *tclPreInitScript = NULL; struct Target; /* - * struct Alias: + * Alias: * * Stores information about an alias. Is stored in the child interpreter and * used by the source command to find the target command in the parent when * the source command is invoked. */ -typedef struct Alias { +typedef struct { Tcl_Obj *token; /* Token for the alias command in the child * interp. This used to be the command name in * the child when the alias was first @@ -67,14 +66,14 @@ typedef struct Alias { /* * - * struct Child: + * Child: * * Used by the "interp" command to record and find information about child * interpreters. Maps from a command name in the parent to information about a * child interpreter, e.g. what aliases are defined in it. */ -typedef struct Child { +typedef struct { Tcl_Interp *parentInterp; /* Parent interpreter for this child. */ Tcl_HashEntry *childEntryPtr; /* Hash entry in parents child table for this @@ -113,7 +112,7 @@ typedef struct Target { } Target; /* - * struct Parent: + * Parent: * * This record is used for two purposes: First, childTable (a hashtable) maps * from names of commands to child interpreters. This hashtable is used to @@ -128,7 +127,7 @@ typedef struct Target { * only load safe extensions. */ -typedef struct Parent { +typedef struct { Tcl_HashTable childTable; /* Hash table for child interpreters. Maps * from command names to Child records. */ Target *targetsPtr; /* The head of a doubly-linked list of all the @@ -145,7 +144,7 @@ typedef struct Parent { * on a per-interp basis. */ -typedef struct InterpInfo { +typedef struct { Parent parent; /* Keeps track of all interps for which this * interp is the Parent. */ Child child; /* Information necessary for this interp to @@ -159,7 +158,7 @@ typedef struct InterpInfo { * likely to work properly on 64-bit architectures. */ -typedef struct ScriptLimitCallback { +typedef struct { Tcl_Interp *interp; /* The interpreter in which to execute the * callback. */ Tcl_Obj *scriptObj; /* The script to execute to perform the @@ -172,7 +171,7 @@ typedef struct ScriptLimitCallback { * table. */ } ScriptLimitCallback; -typedef struct ScriptLimitCallbackKey { +typedef struct { Tcl_Interp *interp; /* The interpreter that the limit callback was * attached to. This is not the interpreter * that the callback runs in! */ @@ -483,7 +482,7 @@ TclInterpInit( Parent *parentPtr; Child *childPtr; - interpInfoPtr = (InterpInfo *)ckalloc(sizeof(InterpInfo)); + interpInfoPtr = (InterpInfo *)Tcl_Alloc(sizeof(InterpInfo)); ((Interp *) interp)->interpInfo = interpInfoPtr; parentPtr = &interpInfoPtr->parent; @@ -580,7 +579,7 @@ InterpInfoDeleteProc( } Tcl_DeleteHashTable(&childPtr->aliasTable); - ckfree(interpInfoPtr); + Tcl_Free(interpInfoPtr); } /* @@ -618,15 +617,17 @@ NRInterpCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Interp *childInterp; - int index; static const char *const options[] = { "alias", "aliases", "bgerror", "cancel", "children", "create", "debug", "delete", "eval", "exists", "expose", "hide", "hidden", "issafe", "invokehidden", "limit", "marktrusted", "recursionlimit", - "share", "slaves", "target", "transfer", - NULL + "share", +#ifndef TCL_NO_DEPRECATED + "slaves", +#endif + "target", "transfer", NULL }; static const char *const optionsNoSlaves[] = { "alias", "aliases", "bgerror", "cancel", @@ -634,16 +635,20 @@ NRInterpCmd( "eval", "exists", "expose", "hide", "hidden", "issafe", "invokehidden", "limit", "marktrusted", "recursionlimit", - "share", "target", "transfer", NULL + "share", "target", "transfer", + NULL }; enum interpOptionEnum { OPT_ALIAS, OPT_ALIASES, OPT_BGERROR, OPT_CANCEL, OPT_CHILDREN, OPT_CREATE, OPT_DEBUG, OPT_DELETE, OPT_EVAL, OPT_EXISTS, OPT_EXPOSE, OPT_HIDE, OPT_HIDDEN, OPT_ISSAFE, OPT_INVOKEHID, - OPT_LIMIT, OPT_MARKTRUSTED,OPT_RECLIMIT, - OPT_SHARE, OPT_SLAVES, OPT_TARGET, OPT_TRANSFER - }; + OPT_LIMIT, OPT_MARKTRUSTED, OPT_RECLIMIT, OPT_SHARE, +#ifndef TCL_NO_DEPRECATED + OPT_SLAVES, +#endif + OPT_TARGET, OPT_TRANSFER + } index; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "cmd ?arg ...?"); @@ -656,7 +661,7 @@ NRInterpCmd( "option", 0, &index); return TCL_ERROR; } - switch ((enum interpOptionEnum)index) { + switch (index) { case OPT_ALIAS: { Tcl_Interp *parentInterp; @@ -711,7 +716,7 @@ NRInterpCmd( }; enum optionCancelEnum { OPT_UNWIND, OPT_LAST - }; + } idx; flags = 0; @@ -720,11 +725,11 @@ NRInterpCmd( break; } if (Tcl_GetIndexFromObj(interp, objv[i], cancelOptions, "option", - 0, &index) != TCL_OK) { + 0, &idx) != TCL_OK) { return TCL_ERROR; } - switch ((enum optionCancelEnum) index) { + switch (idx) { case OPT_UNWIND: /* * The evaluation stack in the target interp is to be unwound. @@ -784,7 +789,7 @@ NRInterpCmd( }; enum option { OPT_SAFE, OPT_LAST - }; + } idx; safe = Tcl_IsSafe(interp); @@ -795,12 +800,12 @@ NRInterpCmd( childPtr = NULL; last = 0; for (i = 2; i < objc; i++) { - if ((last == 0) && (Tcl_GetString(objv[i])[0] == '-')) { + if ((last == 0) && (TclGetString(objv[i])[0] == '-')) { if (Tcl_GetIndexFromObj(interp, objv[i], createOptions, - "option", 0, &index) != TCL_OK) { + "option", 0, &idx) != TCL_OK) { return TCL_ERROR; } - if (index == OPT_SAFE) { + if (idx == OPT_SAFE) { safe = 1; continue; } @@ -943,7 +948,7 @@ NRInterpCmd( }; enum hiddenOption { OPT_GLOBAL, OPT_NAMESPACE, OPT_LAST - }; + } idx; namespaceName = NULL; for (i = 3; i < objc; i++) { @@ -951,12 +956,12 @@ NRInterpCmd( break; } if (Tcl_GetIndexFromObj(interp, objv[i], hiddenOptions, "option", - 0, &index) != TCL_OK) { + 0, &idx) != TCL_OK) { return TCL_ERROR; } - if (index == OPT_GLOBAL) { + if (idx == OPT_GLOBAL) { namespaceName = "::"; - } else if (index == OPT_NAMESPACE) { + } else if (idx == OPT_NAMESPACE) { if (++i == objc) { /* There must be more arguments. */ break; } else { @@ -985,8 +990,7 @@ NRInterpCmd( }; enum LimitTypes { LIMIT_TYPE_COMMANDS, LIMIT_TYPE_TIME - }; - int limitType; + } limitType; if (objc < 4) { Tcl_WrongNumArgs(interp, 2, objv, @@ -1001,7 +1005,7 @@ NRInterpCmd( &limitType) != TCL_OK) { return TCL_ERROR; } - switch ((enum LimitTypes) limitType) { + switch (limitType) { case LIMIT_TYPE_COMMANDS: return ChildCommandLimitCmd(interp, childInterp, 4, objc,objv); case LIMIT_TYPE_TIME: @@ -1029,8 +1033,10 @@ NRInterpCmd( return TCL_ERROR; } return ChildRecursionLimit(interp, childInterp, objc - 3, objv + 3); - case OPT_CHILDREN: - case OPT_SLAVES: { +#ifndef TCL_NO_DEPRECATED + case OPT_SLAVES: +#endif + case OPT_CHILDREN: { InterpInfo *iiPtr; Tcl_Obj *resultPtr; Tcl_HashEntry *hPtr; @@ -1111,7 +1117,7 @@ NRInterpCmd( if (hPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "alias \"%s\" in path \"%s\" not found", - aliasName, Tcl_GetString(objv[2]))); + aliasName, TclGetString(objv[2]))); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ALIAS", aliasName, NULL); return TCL_ERROR; @@ -1120,7 +1126,7 @@ NRInterpCmd( if (Tcl_GetInterpPath(interp, aliasPtr->targetInterp) != TCL_OK) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "target interpreter for alias \"%s\" in path \"%s\" is " - "not my descendant", aliasName, Tcl_GetString(objv[2]))); + "not my descendant", aliasName, TclGetString(objv[2]))); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "TARGETSHROUDED", NULL); return TCL_ERROR; @@ -1191,12 +1197,12 @@ Tcl_CreateAlias( const char *childCmd, /* Command to install in child. */ Tcl_Interp *targetInterp, /* Interpreter for target command. */ const char *targetCmd, /* Name of target command. */ - int argc, /* How many additional arguments? */ + size_t argc, /* How many additional arguments? */ const char *const *argv) /* These are the additional args. */ { Tcl_Obj *childObjPtr, *targetObjPtr; Tcl_Obj **objv; - int i; + size_t i; int result; objv = (Tcl_Obj **)TclStackAlloc(childInterp, sizeof(Tcl_Obj *) * argc); @@ -1246,7 +1252,7 @@ Tcl_CreateAliasObj( const char *childCmd, /* Command to install in child. */ Tcl_Interp *targetInterp, /* Interpreter for target command. */ const char *targetCmd, /* Name of target command. */ - int objc, /* How many additional arguments? */ + size_t objc, /* How many additional arguments? */ Tcl_Obj *const objv[]) /* Argument vector. */ { Tcl_Obj *childObjPtr, *targetObjPtr; @@ -1320,7 +1326,7 @@ Tcl_GetAlias( } if (argvPtr != NULL) { *argvPtr = (const char **) - ckalloc(sizeof(const char *) * (objc - 1)); + Tcl_Alloc(sizeof(const char *) * (objc - 1)); for (i = 1; i < objc; i++) { (*argvPtr)[i - 1] = TclGetString(objv[i]); } @@ -1526,7 +1532,7 @@ AliasCreate( Tcl_Obj **prefv; int isNew, i; - aliasPtr = (Alias *)ckalloc(sizeof(Alias) + objc * sizeof(Tcl_Obj *)); + aliasPtr = (Alias *)Tcl_Alloc(sizeof(Alias) + objc * sizeof(Tcl_Obj *)); aliasPtr->token = namePtr; Tcl_IncrRefCount(aliasPtr->token); aliasPtr->targetInterp = parentInterp; @@ -1577,7 +1583,7 @@ AliasCreate( cmdPtr->deleteData = NULL; Tcl_DeleteCommandFromToken(childInterp, aliasPtr->childCmd); - ckfree(aliasPtr); + Tcl_Free(aliasPtr); /* * The result was already set by TclPreventAliasLoop. @@ -1634,7 +1640,7 @@ AliasCreate( * interp alias {} foo {} zop # Now recreate "foo"... */ - targetPtr = (Target *)ckalloc(sizeof(Target)); + targetPtr = (Target *)Tcl_Alloc(sizeof(Target)); targetPtr->childCmd = aliasPtr->childCmd; targetPtr->childInterp = childInterp; @@ -1736,7 +1742,7 @@ AliasDescribe( */ childPtr = &((InterpInfo *) ((Interp *) childInterp)->interpInfo)->child; - hPtr = Tcl_FindHashEntry(&childPtr->aliasTable, Tcl_GetString(namePtr)); + hPtr = Tcl_FindHashEntry(&childPtr->aliasTable, TclGetString(namePtr)); if (hPtr == NULL) { return TCL_OK; } @@ -2074,8 +2080,8 @@ AliasObjCmdDeleteProc( targetPtr->nextPtr->prevPtr = targetPtr->prevPtr; } - ckfree(targetPtr); - ckfree(aliasPtr); + Tcl_Free(targetPtr); + Tcl_Free(aliasPtr); } /* @@ -2317,7 +2323,7 @@ GetInterp( Tcl_HashEntry *hPtr; /* Search element. */ Child *childPtr; /* Interim child record. */ Tcl_Obj **objv; - int objc, i; + size_t objc, i; Tcl_Interp *searchInterp; /* Interim storage for interp. to find. */ InterpInfo *parentInfoPtr; @@ -2375,7 +2381,7 @@ ChildBgerror( Tcl_Obj *const objv[]) /* Argument strings. */ { if (objc) { - int length; + size_t length; if (TCL_ERROR == TclListObjLengthM(NULL, objv[0], &length) || (length < 1)) { @@ -2421,7 +2427,8 @@ ChildCreate( InterpInfo *parentInfoPtr; Tcl_HashEntry *hPtr; const char *path; - int isNew, objc; + int isNew; + size_t objc; Tcl_Obj **objv; if (TclListObjGetElementsM(interp, pathPtr, &objc, &objv) != TCL_OK) { @@ -2561,7 +2568,6 @@ NRChildCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Interp *childInterp = (Tcl_Interp *)clientData; - int index; static const char *const options[] = { "alias", "aliases", "bgerror", "debug", "eval", "expose", "hide", "hidden", @@ -2573,7 +2579,7 @@ NRChildCmd( OPT_EVAL, OPT_EXPOSE, OPT_HIDE, OPT_HIDDEN, OPT_ISSAFE, OPT_INVOKEHIDDEN, OPT_LIMIT, OPT_MARKTRUSTED, OPT_RECLIMIT - }; + } index; if (childInterp == NULL) { Tcl_Panic("TclChildObjCmd: interpreter has been deleted"); @@ -2588,7 +2594,7 @@ NRChildCmd( return TCL_ERROR; } - switch ((enum childCmdOptionsEnum) index) { + switch (index) { case OPT_ALIAS: if (objc > 2) { if (objc == 3) { @@ -2666,7 +2672,7 @@ NRChildCmd( }; enum hiddenOption { OPT_GLOBAL, OPT_NAMESPACE, OPT_LAST - }; + } idx; namespaceName = NULL; for (i = 2; i < objc; i++) { @@ -2674,12 +2680,12 @@ NRChildCmd( break; } if (Tcl_GetIndexFromObj(interp, objv[i], hiddenOptions, "option", - 0, &index) != TCL_OK) { + 0, &idx) != TCL_OK) { return TCL_ERROR; } - if (index == OPT_GLOBAL) { + if (idx == OPT_GLOBAL) { namespaceName = "::"; - } else if (index == OPT_NAMESPACE) { + } else if (idx == OPT_NAMESPACE) { if (++i == objc) { /* There must be more arguments. */ break; } else { @@ -2704,8 +2710,7 @@ NRChildCmd( }; enum LimitTypes { LIMIT_TYPE_COMMANDS, LIMIT_TYPE_TIME - }; - int limitType; + } limitType; if (objc < 3) { Tcl_WrongNumArgs(interp, 2, objv, "limitType ?-option value ...?"); @@ -2715,7 +2720,7 @@ NRChildCmd( &limitType) != TCL_OK) { return TCL_ERROR; } - switch ((enum LimitTypes) limitType) { + switch (limitType) { case LIMIT_TYPE_COMMANDS: return ChildCommandLimitCmd(interp, childInterp, 3, objc,objv); case LIMIT_TYPE_TIME: @@ -2991,7 +2996,7 @@ ChildRecursionLimit( Tcl_Obj *const objv[]) /* Argument strings. */ { Interp *iPtr; - int limit; + Tcl_WideInt limit; if (objc) { if (Tcl_IsSafe(interp)) { @@ -3001,19 +3006,19 @@ ChildRecursionLimit( NULL); return TCL_ERROR; } - if (TclGetIntFromObj(interp, objv[0], &limit) == TCL_ERROR) { + if (TclGetWideIntFromObj(interp, objv[0], &limit) == TCL_ERROR) { return TCL_ERROR; } - if (limit <= 0) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "recursion limit must be > 0", -1)); + 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); return TCL_ERROR; } Tcl_SetRecursionLimit(childInterp, limit); iPtr = (Interp *) childInterp; - if (interp == childInterp && iPtr->numLevels > limit) { + if (interp == childInterp && iPtr->numLevels > (size_t)limit) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "falling back due to new recursion limit", -1)); Tcl_SetErrorCode(interp, "TCL", "RECURSION", NULL); @@ -3577,7 +3582,7 @@ RunLimitHandlers( if (handlerPtr->deleteProc != NULL) { handlerPtr->deleteProc(handlerPtr->clientData); } - ckfree(handlerPtr); + Tcl_Free(handlerPtr); } } } @@ -3614,14 +3619,14 @@ Tcl_LimitAddHandler( */ if (deleteProc == (Tcl_LimitHandlerDeleteProc *) TCL_DYNAMIC) { - deleteProc = (Tcl_LimitHandlerDeleteProc *) Tcl_Free; + deleteProc = (Tcl_LimitHandlerDeleteProc *) TclpFree; } /* * Allocate a handler record. */ - handlerPtr = (LimitHandler *)ckalloc(sizeof(LimitHandler)); + handlerPtr = (LimitHandler *)Tcl_Alloc(sizeof(LimitHandler)); handlerPtr->flags = 0; handlerPtr->handlerProc = handlerProc; handlerPtr->clientData = clientData; @@ -3740,7 +3745,7 @@ Tcl_LimitRemoveHandler( if (handlerPtr->deleteProc != NULL) { handlerPtr->deleteProc(handlerPtr->clientData); } - ckfree(handlerPtr); + Tcl_Free(handlerPtr); } return; } @@ -3800,7 +3805,7 @@ TclLimitRemoveAllHandlers( if (handlerPtr->deleteProc != NULL) { handlerPtr->deleteProc(handlerPtr->clientData); } - ckfree(handlerPtr); + Tcl_Free(handlerPtr); } } @@ -3833,7 +3838,7 @@ TclLimitRemoveAllHandlers( if (handlerPtr->deleteProc != NULL) { handlerPtr->deleteProc(handlerPtr->clientData); } - ckfree(handlerPtr); + Tcl_Free(handlerPtr); } } @@ -3980,7 +3985,7 @@ Tcl_LimitTypeReset( void Tcl_LimitSetCommands( Tcl_Interp *interp, - int commandLimit) + size_t commandLimit) { Interp *iPtr = (Interp *) interp; @@ -4228,7 +4233,7 @@ DeleteScriptLimitCallback( if (limitCBPtr->entryPtr != NULL) { Tcl_DeleteHashEntry(limitCBPtr->entryPtr); } - ckfree(limitCBPtr); + Tcl_Free(limitCBPtr); } /* @@ -4311,7 +4316,7 @@ SetScriptLimitCallback( key.type = type; if (scriptObj == NULL) { - hashPtr = Tcl_FindHashEntry(&iPtr->limit.callbacks, (char *) &key); + hashPtr = Tcl_FindHashEntry(&iPtr->limit.callbacks, &key); if (hashPtr != NULL) { Tcl_LimitRemoveHandler(targetInterp, type, CallScriptLimitCallback, Tcl_GetHashValue(hashPtr)); @@ -4328,7 +4333,7 @@ SetScriptLimitCallback( limitCBPtr); } - limitCBPtr = (ScriptLimitCallback *)ckalloc(sizeof(ScriptLimitCallback)); + limitCBPtr = (ScriptLimitCallback *)Tcl_Alloc(sizeof(ScriptLimitCallback)); limitCBPtr->interp = interp; limitCBPtr->scriptObj = scriptObj; limitCBPtr->entryPtr = hashPtr; @@ -4488,9 +4493,8 @@ ChildCommandLimitCmd( }; enum Options { OPT_CMD, OPT_GRAN, OPT_VAL - }; + } index; Interp *iPtr = (Interp *) interp; - int index; ScriptLimitCallbackKey key; ScriptLimitCallback *limitCBPtr; Tcl_HashEntry *hPtr; @@ -4515,7 +4519,7 @@ ChildCommandLimitCmd( TclNewObj(dictPtr); key.interp = childInterp; key.type = TCL_LIMIT_COMMANDS; - hPtr = Tcl_FindHashEntry(&iPtr->limit.callbacks, (char *) &key); + hPtr = Tcl_FindHashEntry(&iPtr->limit.callbacks, &key); if (hPtr != NULL) { limitCBPtr = (ScriptLimitCallback *)Tcl_GetHashValue(hPtr); if (limitCBPtr != NULL && limitCBPtr->scriptObj != NULL) { @@ -4553,11 +4557,11 @@ ChildCommandLimitCmd( 0, &index) != TCL_OK) { return TCL_ERROR; } - switch ((enum Options) index) { + switch (index) { case OPT_CMD: key.interp = childInterp; key.type = TCL_LIMIT_COMMANDS; - hPtr = Tcl_FindHashEntry(&iPtr->limit.callbacks, (char *) &key); + hPtr = Tcl_FindHashEntry(&iPtr->limit.callbacks, &key); if (hPtr != NULL) { limitCBPtr = (ScriptLimitCallback *)Tcl_GetHashValue(hPtr); if (limitCBPtr != NULL && limitCBPtr->scriptObj != NULL) { @@ -4581,7 +4585,8 @@ ChildCommandLimitCmd( Tcl_WrongNumArgs(interp, consumedObjc, objv, "?-option value ...?"); return TCL_ERROR; } else { - int i, scriptLen = 0, limitLen = 0; + int i; + size_t scriptLen = 0, limitLen = 0; Tcl_Obj *scriptObj = NULL, *granObj = NULL, *limitObj = NULL; int gran = 0, limit = 0; @@ -4590,10 +4595,10 @@ ChildCommandLimitCmd( &index) != TCL_OK) { return TCL_ERROR; } - switch ((enum Options) index) { + switch (index) { case OPT_CMD: scriptObj = objv[i+1]; - (void) TclGetStringFromObj(scriptObj, &scriptLen); + (void) Tcl_GetStringFromObj(scriptObj, &scriptLen); break; case OPT_GRAN: granObj = objv[i+1]; @@ -4610,7 +4615,7 @@ ChildCommandLimitCmd( break; case OPT_VAL: limitObj = objv[i+1]; - (void) TclGetStringFromObj(objv[i+1], &limitLen); + (void) Tcl_GetStringFromObj(objv[i+1], &limitLen); if (limitLen == 0) { break; } @@ -4676,9 +4681,8 @@ ChildTimeLimitCmd( }; enum Options { OPT_CMD, OPT_GRAN, OPT_MILLI, OPT_SEC - }; + } index; Interp *iPtr = (Interp *) interp; - int index; ScriptLimitCallbackKey key; ScriptLimitCallback *limitCBPtr; Tcl_HashEntry *hPtr; @@ -4703,7 +4707,7 @@ ChildTimeLimitCmd( TclNewObj(dictPtr); key.interp = childInterp; key.type = TCL_LIMIT_TIME; - hPtr = Tcl_FindHashEntry(&iPtr->limit.callbacks, (char *) &key); + hPtr = Tcl_FindHashEntry(&iPtr->limit.callbacks, &key); if (hPtr != NULL) { limitCBPtr = (ScriptLimitCallback *)Tcl_GetHashValue(hPtr); if (limitCBPtr != NULL && limitCBPtr->scriptObj != NULL) { @@ -4747,11 +4751,11 @@ ChildTimeLimitCmd( 0, &index) != TCL_OK) { return TCL_ERROR; } - switch ((enum Options) index) { + switch (index) { case OPT_CMD: key.interp = childInterp; key.type = TCL_LIMIT_TIME; - hPtr = Tcl_FindHashEntry(&iPtr->limit.callbacks, (char *) &key); + hPtr = Tcl_FindHashEntry(&iPtr->limit.callbacks, &key); if (hPtr != NULL) { limitCBPtr = (ScriptLimitCallback *)Tcl_GetHashValue(hPtr); if (limitCBPtr != NULL && limitCBPtr->scriptObj != NULL) { @@ -4786,7 +4790,8 @@ ChildTimeLimitCmd( Tcl_WrongNumArgs(interp, consumedObjc, objv, "?-option value ...?"); return TCL_ERROR; } else { - int i, scriptLen = 0, milliLen = 0, secLen = 0; + int i; + size_t scriptLen = 0, milliLen = 0, secLen = 0; Tcl_Obj *scriptObj = NULL, *granObj = NULL; Tcl_Obj *milliObj = NULL, *secObj = NULL; int gran = 0; @@ -4799,10 +4804,10 @@ ChildTimeLimitCmd( &index) != TCL_OK) { return TCL_ERROR; } - switch ((enum Options) index) { + switch (index) { case OPT_CMD: scriptObj = objv[i+1]; - (void) TclGetStringFromObj(objv[i+1], &scriptLen); + (void) Tcl_GetStringFromObj(objv[i+1], &scriptLen); break; case OPT_GRAN: granObj = objv[i+1]; @@ -4819,7 +4824,7 @@ ChildTimeLimitCmd( break; case OPT_MILLI: milliObj = objv[i+1]; - (void) TclGetStringFromObj(objv[i+1], &milliLen); + (void) Tcl_GetStringFromObj(objv[i+1], &milliLen); if (milliLen == 0) { break; } @@ -4837,7 +4842,7 @@ ChildTimeLimitCmd( break; case OPT_SEC: secObj = objv[i+1]; - (void) TclGetStringFromObj(objv[i+1], &secLen); + (void) Tcl_GetStringFromObj(objv[i+1], &secLen); if (secLen == 0) { break; } diff --git a/generic/tclLink.c b/generic/tclLink.c index f478a00..e0e82dd 100644 --- a/generic/tclLink.c +++ b/generic/tclLink.c @@ -25,7 +25,7 @@ * variable. */ -typedef struct Link { +typedef struct { Tcl_Interp *interp; /* Interpreter containing Tcl variable. */ Namespace *nsPtr; /* Namespace containing Tcl variable */ Tcl_Obj *varName; /* Name of variable (must be global). This is @@ -33,10 +33,10 @@ typedef struct Link { * actual variable may be aliased at that time * via upvar. */ void *addr; /* Location of C variable. */ - int bytes; /* Size of C variable array. This is 0 when + size_t bytes; /* Size of C variable array. This is 0 when * single variables, and >0 used for array * variables. */ - int numElems; /* Number of elements in C variable array. + size_t numElems; /* Number of elements in C variable array. * Zero for single variables. */ int type; /* Type of link (TCL_LINK_INT, etc.). */ union { @@ -114,7 +114,8 @@ static Tcl_ObjType invalidRealType = { NULL, /* freeIntRepProc */ NULL, /* dupIntRepProc */ NULL, /* updateStringProc */ - NULL /* setFromAnyProc */ + NULL, /* setFromAnyProc */ + TCL_OBJTYPE_V0 }; /* @@ -171,7 +172,7 @@ Tcl_LinkVar( return TCL_ERROR; } - linkPtr = (Link *)ckalloc(sizeof(Link)); + linkPtr = (Link *)Tcl_Alloc(sizeof(Link)); linkPtr->interp = interp; linkPtr->nsPtr = NULL; linkPtr->varName = Tcl_NewStringObj(varName, -1); @@ -245,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. */ - int size) /* Size of C variable array, >1 if array */ + size_t size) /* Size of C variable array, >1 if array */ { Tcl_Obj *objPtr; Link *linkPtr; @@ -259,7 +260,7 @@ Tcl_LinkArray( return TCL_ERROR; } - linkPtr = (Link *)ckalloc(sizeof(Link)); + linkPtr = (Link *)Tcl_Alloc(sizeof(Link)); linkPtr->type = type & ~TCL_LINK_READ_ONLY; #if !defined(TCL_NO_DEPRECATED) && (defined(TCL_WIDE_INT_IS_LONG) \ || defined(_WIN32) || defined(__CYGWIN__)) @@ -327,7 +328,7 @@ Tcl_LinkArray( */ if (addr == NULL) { - linkPtr->lastValue.aryPtr = ckalloc(linkPtr->bytes); + linkPtr->lastValue.aryPtr = Tcl_Alloc(linkPtr->bytes); linkPtr->flags |= LINK_ALLOC_LAST; addr = (char *) &linkPtr->lastValue.cPtr; } @@ -348,7 +349,7 @@ Tcl_LinkArray( */ if (addr == NULL) { - linkPtr->addr = ckalloc(linkPtr->bytes); + linkPtr->addr = Tcl_Alloc(linkPtr->bytes); linkPtr->flags |= LINK_ALLOC_ADDR; } else { linkPtr->addr = addr; @@ -359,7 +360,7 @@ Tcl_LinkArray( */ if (size > 1) { - linkPtr->lastValue.aryPtr = ckalloc(linkPtr->bytes); + linkPtr->lastValue.aryPtr = Tcl_Alloc(linkPtr->bytes); linkPtr->flags |= LINK_ALLOC_LAST; } @@ -591,9 +592,9 @@ SetInvalidRealFromAny( { const char *str; const char *endPtr; - int length; + size_t length; - str = TclGetStringFromObj(objPtr, &length); + str = Tcl_GetStringFromObj(objPtr, &length); if ((length == 1) && (str[0] == '.')) { objPtr->typePtr = &invalidRealType; objPtr->internalRep.doubleValue = 0.0; @@ -637,8 +638,8 @@ GetInvalidIntFromObj( Tcl_Obj *objPtr, int *intPtr) { - int length; - const char *str = TclGetStringFromObj(objPtr, &length); + size_t length; + const char *str = Tcl_GetStringFromObj(objPtr, &length); if ((length == 0) || ((length == 2) && (str[0] == '0') && strchr("xXbBoOdD", str[1]))) { @@ -714,7 +715,7 @@ LinkTraceProc( { Link *linkPtr = (Link *)clientData; int changed; - int valueLength; + size_t valueLength = 0; const char *value; char **pp; Tcl_Obj *valueObj; @@ -722,9 +723,8 @@ LinkTraceProc( Tcl_WideInt valueWide; Tcl_WideUInt valueUWide; double valueDouble; - int objc; + size_t objc, i; Tcl_Obj **objv; - int i; /* * If the variable is being unset, then just re-create it (with a trace) @@ -738,7 +738,7 @@ LinkTraceProc( } else if (flags & TCL_TRACE_DESTROYED) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); - Tcl_TraceVar2(interp, Tcl_GetString(linkPtr->varName), NULL, + Tcl_TraceVar2(interp, TclGetString(linkPtr->varName), NULL, TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES |TCL_TRACE_UNSETS, LinkTraceProc, linkPtr); } @@ -856,16 +856,15 @@ LinkTraceProc( switch (linkPtr->type) { case TCL_LINK_STRING: - value = TclGetStringFromObj(valueObj, &valueLength); - valueLength++; /* include end of string char */ + value = Tcl_GetStringFromObj(valueObj, &valueLength); pp = (char **) linkPtr->addr; - *pp = (char *)ckrealloc(*pp, valueLength); + *pp = (char *)Tcl_Realloc(*pp, ++valueLength); memcpy(*pp, value, valueLength); return NULL; case TCL_LINK_CHARS: - value = (char *) TclGetStringFromObj(valueObj, &valueLength); + value = (char *) Tcl_GetStringFromObj(valueObj, &valueLength); valueLength++; /* include end of string char */ if (valueLength > linkPtr->bytes) { return (char *) "wrong size of char* value"; @@ -881,7 +880,9 @@ LinkTraceProc( case TCL_LINK_BINARY: value = (char *) Tcl_GetByteArrayFromObj(valueObj, &valueLength); - if (valueLength != linkPtr->bytes) { + if (value == NULL) { + return (char *) "invalid binary value"; + } else if (valueLength != linkPtr->bytes) { return (char *) "wrong size of binary value"; } if (linkPtr->flags & LINK_ALLOC_LAST) { @@ -916,7 +917,7 @@ LinkTraceProc( switch (linkPtr->type) { case TCL_LINK_INT: if (linkPtr->flags & LINK_ALLOC_LAST) { - for (i=0; i < objc; i++) { + for (i = 0; i < objc; i++) { int *varPtr = &linkPtr->lastValue.iPtr[i]; if (GetInt(objv[i], varPtr)) { @@ -1248,18 +1249,18 @@ ObjValue( { char *p; Tcl_Obj *resultObj, **objv; - int i; + size_t i; switch (linkPtr->type) { case TCL_LINK_INT: if (linkPtr->flags & LINK_ALLOC_LAST) { memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes); - objv = (Tcl_Obj **)ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *)); + objv = (Tcl_Obj **)Tcl_Alloc(linkPtr->numElems * sizeof(Tcl_Obj *)); for (i=0; i < linkPtr->numElems; i++) { TclNewIntObj(objv[i], linkPtr->lastValue.iPtr[i]); } resultObj = Tcl_NewListObj(linkPtr->numElems, objv); - ckfree(objv); + Tcl_Free(objv); return resultObj; } linkPtr->lastValue.i = LinkedVar(int); @@ -1267,12 +1268,12 @@ ObjValue( case TCL_LINK_WIDE_INT: if (linkPtr->flags & LINK_ALLOC_LAST) { memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes); - objv = (Tcl_Obj **)ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *)); + objv = (Tcl_Obj **)Tcl_Alloc(linkPtr->numElems * sizeof(Tcl_Obj *)); for (i=0; i < linkPtr->numElems; i++) { TclNewIntObj(objv[i], linkPtr->lastValue.wPtr[i]); } resultObj = Tcl_NewListObj(linkPtr->numElems, objv); - ckfree(objv); + Tcl_Free(objv); return resultObj; } linkPtr->lastValue.w = LinkedVar(Tcl_WideInt); @@ -1280,12 +1281,12 @@ ObjValue( case TCL_LINK_DOUBLE: if (linkPtr->flags & LINK_ALLOC_LAST) { memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes); - objv = (Tcl_Obj **)ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *)); + objv = (Tcl_Obj **)Tcl_Alloc(linkPtr->numElems * sizeof(Tcl_Obj *)); for (i=0; i < linkPtr->numElems; i++) { TclNewDoubleObj(objv[i], linkPtr->lastValue.dPtr[i]); } resultObj = Tcl_NewListObj(linkPtr->numElems, objv); - ckfree(objv); + Tcl_Free(objv); return resultObj; } linkPtr->lastValue.d = LinkedVar(double); @@ -1293,12 +1294,12 @@ ObjValue( case TCL_LINK_BOOLEAN: if (linkPtr->flags & LINK_ALLOC_LAST) { memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes); - objv = (Tcl_Obj **)ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *)); + objv = (Tcl_Obj **)Tcl_Alloc(linkPtr->numElems * sizeof(Tcl_Obj *)); for (i=0; i < linkPtr->numElems; i++) { objv[i] = Tcl_NewBooleanObj(linkPtr->lastValue.iPtr[i] != 0); } resultObj = Tcl_NewListObj(linkPtr->numElems, objv); - ckfree(objv); + Tcl_Free(objv); return resultObj; } linkPtr->lastValue.i = LinkedVar(int); @@ -1306,12 +1307,12 @@ ObjValue( case TCL_LINK_CHAR: if (linkPtr->flags & LINK_ALLOC_LAST) { memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes); - objv = (Tcl_Obj **)ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *)); + objv = (Tcl_Obj **)Tcl_Alloc(linkPtr->numElems * sizeof(Tcl_Obj *)); for (i=0; i < linkPtr->numElems; i++) { TclNewIntObj(objv[i], linkPtr->lastValue.cPtr[i]); } resultObj = Tcl_NewListObj(linkPtr->numElems, objv); - ckfree(objv); + Tcl_Free(objv); return resultObj; } linkPtr->lastValue.c = LinkedVar(char); @@ -1319,12 +1320,12 @@ ObjValue( case TCL_LINK_UCHAR: if (linkPtr->flags & LINK_ALLOC_LAST) { memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes); - objv = (Tcl_Obj **)ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *)); + objv = (Tcl_Obj **)Tcl_Alloc(linkPtr->numElems * sizeof(Tcl_Obj *)); for (i=0; i < linkPtr->numElems; i++) { TclNewIntObj(objv[i], linkPtr->lastValue.ucPtr[i]); } resultObj = Tcl_NewListObj(linkPtr->numElems, objv); - ckfree(objv); + Tcl_Free(objv); return resultObj; } linkPtr->lastValue.uc = LinkedVar(unsigned char); @@ -1332,12 +1333,12 @@ ObjValue( case TCL_LINK_SHORT: if (linkPtr->flags & LINK_ALLOC_LAST) { memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes); - objv = (Tcl_Obj **)ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *)); + objv = (Tcl_Obj **)Tcl_Alloc(linkPtr->numElems * sizeof(Tcl_Obj *)); for (i=0; i < linkPtr->numElems; i++) { TclNewIntObj(objv[i], linkPtr->lastValue.sPtr[i]); } resultObj = Tcl_NewListObj(linkPtr->numElems, objv); - ckfree(objv); + Tcl_Free(objv); return resultObj; } linkPtr->lastValue.s = LinkedVar(short); @@ -1345,12 +1346,12 @@ ObjValue( case TCL_LINK_USHORT: if (linkPtr->flags & LINK_ALLOC_LAST) { memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes); - objv = (Tcl_Obj **)ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *)); + objv = (Tcl_Obj **)Tcl_Alloc(linkPtr->numElems * sizeof(Tcl_Obj *)); for (i=0; i < linkPtr->numElems; i++) { TclNewIntObj(objv[i], linkPtr->lastValue.usPtr[i]); } resultObj = Tcl_NewListObj(linkPtr->numElems, objv); - ckfree(objv); + Tcl_Free(objv); return resultObj; } linkPtr->lastValue.us = LinkedVar(unsigned short); @@ -1358,12 +1359,12 @@ ObjValue( case TCL_LINK_UINT: if (linkPtr->flags & LINK_ALLOC_LAST) { memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes); - objv = (Tcl_Obj **)ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *)); + objv = (Tcl_Obj **)Tcl_Alloc(linkPtr->numElems * sizeof(Tcl_Obj *)); for (i=0; i < linkPtr->numElems; i++) { TclNewIntObj(objv[i], linkPtr->lastValue.uiPtr[i]); } resultObj = Tcl_NewListObj(linkPtr->numElems, objv); - ckfree(objv); + Tcl_Free(objv); return resultObj; } linkPtr->lastValue.ui = LinkedVar(unsigned int); @@ -1372,12 +1373,12 @@ ObjValue( case TCL_LINK_LONG: if (linkPtr->flags & LINK_ALLOC_LAST) { memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes); - objv = (Tcl_Obj **)ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *)); + objv = (Tcl_Obj **)Tcl_Alloc(linkPtr->numElems * sizeof(Tcl_Obj *)); for (i=0; i < linkPtr->numElems; i++) { TclNewIntObj(objv[i], linkPtr->lastValue.lPtr[i]); } resultObj = Tcl_NewListObj(linkPtr->numElems, objv); - ckfree(objv); + Tcl_Free(objv); return resultObj; } linkPtr->lastValue.l = LinkedVar(long); @@ -1385,12 +1386,12 @@ ObjValue( case TCL_LINK_ULONG: if (linkPtr->flags & LINK_ALLOC_LAST) { memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes); - objv = (Tcl_Obj **)ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *)); + objv = (Tcl_Obj **)Tcl_Alloc(linkPtr->numElems * sizeof(Tcl_Obj *)); for (i=0; i < linkPtr->numElems; i++) { TclNewIntObj(objv[i], linkPtr->lastValue.ulPtr[i]); } resultObj = Tcl_NewListObj(linkPtr->numElems, objv); - ckfree(objv); + Tcl_Free(objv); return resultObj; } linkPtr->lastValue.ul = LinkedVar(unsigned long); @@ -1399,12 +1400,12 @@ ObjValue( case TCL_LINK_FLOAT: if (linkPtr->flags & LINK_ALLOC_LAST) { memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes); - objv = (Tcl_Obj **)ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *)); + objv = (Tcl_Obj **)Tcl_Alloc(linkPtr->numElems * sizeof(Tcl_Obj *)); for (i=0; i < linkPtr->numElems; i++) { TclNewDoubleObj(objv[i], linkPtr->lastValue.fPtr[i]); } resultObj = Tcl_NewListObj(linkPtr->numElems, objv); - ckfree(objv); + Tcl_Free(objv); return resultObj; } linkPtr->lastValue.f = LinkedVar(float); @@ -1412,12 +1413,12 @@ ObjValue( case TCL_LINK_WIDE_UINT: { if (linkPtr->flags & LINK_ALLOC_LAST) { memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes); - objv = (Tcl_Obj **)ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *)); + objv = (Tcl_Obj **)Tcl_Alloc(linkPtr->numElems * sizeof(Tcl_Obj *)); for (i=0; i < linkPtr->numElems; i++) { TclNewUIntObj(objv[i], linkPtr->lastValue.uwPtr[i]); } resultObj = Tcl_NewListObj(linkPtr->numElems, objv); - ckfree(objv); + Tcl_Free(objv); return resultObj; } linkPtr->lastValue.uw = LinkedVar(Tcl_WideUInt); @@ -1488,12 +1489,12 @@ LinkFree( TclNsDecrRefCount(linkPtr->nsPtr); } if (linkPtr->flags & LINK_ALLOC_ADDR) { - ckfree(linkPtr->addr); + Tcl_Free(linkPtr->addr); } if (linkPtr->flags & LINK_ALLOC_LAST) { - ckfree(linkPtr->lastValue.aryPtr); + Tcl_Free(linkPtr->lastValue.aryPtr); } - ckfree((char *) linkPtr); + Tcl_Free(linkPtr); } /* diff --git a/generic/tclListObj.c b/generic/tclListObj.c index 776ff0e..93e4478 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_ >= 0 && idx_ < LIST_MAX); \ + LIST_ASSERT(idx_ != TCL_INDEX_NONE && 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_ >= 0 && count_ <= LIST_MAX); \ + LIST_ASSERT(count_ != TCL_INDEX_NONE && count_ <= LIST_MAX); \ } while (0) #else @@ -120,7 +120,7 @@ /* * Prototypes for non-inline static functions defined later in this file: */ -static int MemoryAllocationError(Tcl_Interp *, size_t size); +static int MemoryAllocationError(Tcl_Interp *, Tcl_Size size); static int ListLimitExceededError(Tcl_Interp *); static ListStore *ListStoreNew(Tcl_Size objc, Tcl_Obj *const objv[], int flags); static int ListRepInit(Tcl_Size objc, Tcl_Obj *const objv[], int flags, ListRep *); @@ -156,7 +156,8 @@ const Tcl_ObjType tclListType = { FreeListInternalRep, /* freeIntRepProc */ DupListInternalRep, /* dupIntRepProc */ UpdateStringOfList, /* updateStringProc */ - SetListFromAny /* setFromAnyProc */ + SetListFromAny, /* setFromAnyProc */ + TCL_OBJTYPE_V0 }; /* Macros to manipulate the List internal rep */ @@ -241,7 +242,7 @@ ListSpanNew( Tcl_Size firstSlot, /* Starting slot index of the span */ Tcl_Size numSlots) /* Number of slots covered by the span */ { - ListSpan *spanPtr = (ListSpan *) ckalloc(sizeof(*spanPtr)); + ListSpan *spanPtr = (ListSpan *) Tcl_Alloc(sizeof(*spanPtr)); spanPtr->refCount = 0; spanPtr->spanStart = firstSlot; spanPtr->spanLength = numSlots; @@ -268,7 +269,7 @@ static inline void ListSpanDecrRefs(ListSpan *spanPtr) { if (spanPtr->refCount <= 1) { - ckfree(spanPtr); + Tcl_Free(spanPtr); } else { spanPtr->refCount -= 1; } @@ -487,7 +488,7 @@ ObjArrayCopy( static int MemoryAllocationError( Tcl_Interp *interp, /* Interpreter for error message. May be NULL */ - size_t size) /* Size of attempted allocation that failed */ + Tcl_Size size) /* Size of attempted allocation that failed */ { if (interp != NULL) { Tcl_SetObjResult( @@ -666,11 +667,8 @@ ListRepValidate(const ListRep *repPtr, const char *file, int lineNum) /* Separate each condition so line number gives exact reason for failure */ INVARIANT(storePtr != NULL); - INVARIANT(storePtr->numAllocated >= 0); INVARIANT(storePtr->numAllocated <= LIST_MAX); - INVARIANT(storePtr->firstUsed >= 0); INVARIANT(storePtr->firstUsed < storePtr->numAllocated); - INVARIANT(storePtr->numUsed >= 0); INVARIANT(storePtr->numUsed <= storePtr->numAllocated); INVARIANT(storePtr->firstUsed <= (storePtr->numAllocated - storePtr->numUsed)); @@ -775,14 +773,14 @@ ListStoreNew( capacity = objc; } - storePtr = (ListStore *)attemptckalloc(LIST_SIZE(capacity)); + storePtr = (ListStore *)Tcl_AttemptAlloc(LIST_SIZE(capacity)); if (storePtr == NULL && capacity != objc) { capacity = objc; /* Try allocating exact size */ - storePtr = (ListStore *)attemptckalloc(LIST_SIZE(capacity)); + storePtr = (ListStore *)Tcl_AttemptAlloc(LIST_SIZE(capacity)); } if (storePtr == NULL) { if (flags & LISTREP_PANIC_ON_FAIL) { - Tcl_Panic("list creation failed: unable to alloc %u bytes", + Tcl_Panic("list creation failed: unable to alloc %" TCL_Z_MODIFIER "u bytes", LIST_SIZE(objc)); } return NULL; @@ -848,10 +846,10 @@ ListStoreReallocate (ListStore *storePtr, Tcl_Size numSlots) newCapacity = ListStoreUpSize(numSlots); newStorePtr = - (ListStore *)attemptckrealloc(storePtr, LIST_SIZE(newCapacity)); + (ListStore *)Tcl_AttemptRealloc(storePtr, LIST_SIZE(newCapacity)); if (newStorePtr == NULL) { newCapacity = numSlots; - newStorePtr = (ListStore *)attemptckrealloc(storePtr, + newStorePtr = (ListStore *)Tcl_AttemptRealloc(storePtr, LIST_SIZE(newCapacity)); if (newStorePtr == NULL) return NULL; @@ -1110,7 +1108,7 @@ Tcl_NewListObj( TclNewObj(listObj); - if (objc <= 0) { + if (objc + 1 <= 1) { return listObj; } @@ -1166,7 +1164,7 @@ Tcl_DbNewListObj( TclDbNewObj(listObj, file, line); - if (objc <= 0) { + if (objc + 1 <= 1) { return listObj; } @@ -1328,7 +1326,7 @@ Tcl_SetListObj( * not be called with objc == 0! */ - if (objc > 0) { + if (objc + 1 > 1) { ListRep listRep; /* TODO - perhaps ask for extra space? */ ListRepInit(objc, objv, LISTREP_PANIC_ON_FAIL, &listRep); @@ -1435,13 +1433,13 @@ ListRepRange( ListRepFreeUnreferenced(srcRepPtr); } /* else T:listrep-2.{4.2,4.3,5.2,5.3,6.2,7.2,8.1} */ - if (rangeStart < 0) { + if (rangeStart == TCL_INDEX_NONE) { rangeStart = 0; } - if (rangeEnd >= numSrcElems) { + if ((rangeEnd != TCL_INDEX_NONE) && (rangeEnd >= numSrcElems)) { rangeEnd = numSrcElems - 1; } - if (rangeStart > rangeEnd) { + if (rangeStart + 1 > rangeEnd + 1) { /* Empty list of capacity 1. */ ListRepInit(1, NULL, LISTREP_PANIC_ON_FAIL, rangeRepPtr); return; @@ -1477,7 +1475,6 @@ ListRepRange( ListRepElements(srcRepPtr, numSrcElems, srcElems); numAfterRangeEnd = numSrcElems - (rangeEnd + 1); /* Assert: Because numSrcElems > rangeEnd earlier */ - LIST_ASSERT(numAfterRangeEnd >= 0); if (numAfterRangeEnd != 0) { /* T:listrep-1.{8,9} */ ObjArrayDecrRefs(srcElems, rangeEnd + 1, numAfterRangeEnd); @@ -1550,7 +1547,6 @@ ListRepRange( /* Ditto for trailing */ numAfterRangeEnd = numSrcElems - (rangeEnd + 1); /* Assert: Because numSrcElems > rangeEnd earlier */ - LIST_ASSERT(numAfterRangeEnd >= 0); if (numAfterRangeEnd != 0) { /* T:listrep-3.17 */ ObjArrayDecrRefs(srcElems, rangeEnd + 1, numAfterRangeEnd); @@ -1958,7 +1954,7 @@ Tcl_ListObjIndex( != TCL_OK) { return TCL_ERROR; } - if ((index < 0) || (index >= numElems)) { + if (index >= numElems) { *objPtrPtr = NULL; } else { *objPtrPtr = elemObjs[index]; @@ -2065,12 +2061,12 @@ Tcl_ListObjReplace( { ListRep listRep; Tcl_Size origListLen; - int lenChange; - int leadSegmentLen; - int tailSegmentLen; + ptrdiff_t lenChange; + ptrdiff_t leadSegmentLen; + ptrdiff_t tailSegmentLen; Tcl_Size numFreeSlots; - int leadShift; - int tailShift; + ptrdiff_t leadShift; + ptrdiff_t tailShift; Tcl_Obj **listObjs; int favor; @@ -2085,13 +2081,13 @@ Tcl_ListObjReplace( /* Make limits sane */ origListLen = ListRepLength(&listRep); - if (first < 0) { + if (first == TCL_INDEX_NONE) { first = 0; } if (first > origListLen) { first = origListLen; /* So we'll insert after last element. */ } - if (numToDelete < 0) { + if (numToDelete == TCL_INDEX_NONE) { numToDelete = 0; } else if (first > ListSizeT_MAX - numToDelete /* Handle integer overflow */ || origListLen < first + numToDelete) { @@ -2231,7 +2227,7 @@ Tcl_ListObjReplace( * be an explicit alloc and memmove which would let us redistribute * free space. */ - if (numFreeSlots < lenChange && !ListRepIsShared(&listRep)) { + if ((ptrdiff_t)numFreeSlots < lenChange && !ListRepIsShared(&listRep)) { /* T:listrep-1.{1,3,14,18,21},3.{3,10,11,14,27,32,41} */ ListStore *newStorePtr = ListStoreReallocate(listRep.storePtr, origListLen + lenChange); @@ -2258,7 +2254,7 @@ Tcl_ListObjReplace( * TODO - for unshared case ONLY, consider a "move" based implementation */ if (ListRepIsShared(&listRep) || /* 3a */ - numFreeSlots < lenChange || /* 3b */ + (ptrdiff_t)numFreeSlots < lenChange || /* 3b */ (origListLen + lenChange) < (listRep.storePtr->numAllocated / 4) /* 3c */ ) { ListRep newRep; @@ -2373,9 +2369,9 @@ Tcl_ListObjReplace( * or need to shift both. In the former case, favor shifting the * smaller segment. */ - int leadSpace = ListRepNumFreeHead(&listRep); - int tailSpace = ListRepNumFreeTail(&listRep); - int finalFreeSpace = leadSpace + tailSpace - lenChange; + ptrdiff_t leadSpace = ListRepNumFreeHead(&listRep); + ptrdiff_t tailSpace = ListRepNumFreeTail(&listRep); + ptrdiff_t finalFreeSpace = leadSpace + tailSpace - lenChange; LIST_ASSERT((leadSpace + tailSpace) >= lenChange); if (leadSpace >= lenChange @@ -2392,7 +2388,7 @@ Tcl_ListObjReplace( * insertions. */ if (finalFreeSpace > 1 && (tailSpace == 0 || tailSegmentLen == 0)) { - int postShiftLeadSpace = leadSpace - lenChange; + ptrdiff_t postShiftLeadSpace = leadSpace - lenChange; if (postShiftLeadSpace > (finalFreeSpace/2)) { Tcl_Size extraShift = postShiftLeadSpace - (finalFreeSpace / 2); leadShift -= extraShift; @@ -2409,7 +2405,7 @@ Tcl_ListObjReplace( * See comments above. This is analogous. */ if (finalFreeSpace > 1 && (leadSpace == 0 || leadSegmentLen == 0)) { - int postShiftTailSpace = tailSpace - lenChange; + ptrdiff_t postShiftTailSpace = tailSpace - lenChange; if (postShiftTailSpace > (finalFreeSpace/2)) { /* T:listrep-1.{1,3,14,18,21},3.{2,3,26,27} */ Tcl_Size extraShift = postShiftTailSpace - (finalFreeSpace / 2); @@ -2677,7 +2673,7 @@ TclLindexFlat( if (TclGetIntForIndexM(interp, indexArray[i], /*endValue*/ listLen-1, &index) == TCL_OK) { - if (index<0 || index>=listLen) { + if (index >= listLen) { /* * Index is out of range. Break out of loop with empty result. * First check remaining indices for validity @@ -2868,7 +2864,7 @@ TclLsetFlat( if (indexCount > (int) (sizeof(pendingInvalidates) / sizeof(pendingInvalidates[0]))) { pendingInvalidatesPtr = - (Tcl_Obj **) ckalloc(indexCount * sizeof(*pendingInvalidatesPtr)); + (Tcl_Obj **) Tcl_Alloc(indexCount * sizeof(*pendingInvalidatesPtr)); } /* @@ -2905,7 +2901,7 @@ TclLsetFlat( } indexArray++; - if (index < 0 || index > elemCount + if (index > elemCount || (valueObj == NULL && index >= elemCount)) { /* ...the index points outside the sublist. */ if (interp != NULL) { @@ -3013,7 +3009,7 @@ TclLsetFlat( } if (pendingInvalidatesPtr != pendingInvalidates) - ckfree(pendingInvalidatesPtr); + Tcl_Free(pendingInvalidatesPtr); if (result != TCL_OK) { /* @@ -3102,10 +3098,10 @@ TclListObjSetElement( elemCount = ListRepLength(&listRep); /* Ensure that the index is in bounds. */ - if (index<0 || index>=elemCount) { + if (index>=elemCount) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "index \"%d\" out of range", index)); + "index \"%" TCL_Z_MODIFIER "u\" out of range", index)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", "OUTOFRANGE", NULL); } @@ -3172,7 +3168,7 @@ FreeListInternalRep( ObjArrayDecrRefs( listRep.storePtr->slots, listRep.storePtr->firstUsed, listRep.storePtr->numUsed); - ckfree(listRep.storePtr); + Tcl_Free(listRep.storePtr); } if (listRep.spanPtr) { ListSpanDecrRefs(listRep.spanPtr); @@ -3285,7 +3281,7 @@ SetListFromAny( * because it can be done an order of magnitude faster * and may occur frequently. */ - Tcl_Size j, size = TclArithSeriesObjLength(objPtr); + Tcl_Size j, size = TclArithSeriesObjLength(objPtr); /* TODO - leave space in front and/or back? */ if (ListRepInitAttempt( @@ -3308,7 +3304,7 @@ SetListFromAny( } else { Tcl_Size estCount, length; - const char *limit, *nextElem = TclGetStringFromObj(objPtr, &length); + const char *limit, *nextElem = Tcl_GetStringFromObj(objPtr, &length); /* * Allocate enough space to hold a (Tcl_Obj *) for each @@ -3343,7 +3339,7 @@ fail: while (--elemPtrs >= listRep.storePtr->slots) { Tcl_DecrRefCount(*elemPtrs); } - ckfree(listRep.storePtr); + Tcl_Free(listRep.storePtr); return TCL_ERROR; } if (elemStart == limit) { @@ -3461,19 +3457,16 @@ UpdateStringOfList( flagPtr = localFlags; } else { /* We know numElems <= LIST_MAX, so this is safe. */ - flagPtr = (char *)ckalloc(numElems); + flagPtr = (char *)Tcl_Alloc(numElems); } for (i = 0; i < numElems; i++) { flagPtr[i] = (i ? TCL_DONT_QUOTE_HASH : 0); - elem = TclGetStringFromObj(elemPtrs[i], &length); + elem = Tcl_GetStringFromObj(elemPtrs[i], &length); bytesNeeded += TclScanElement(elem, length, flagPtr+i); - if (bytesNeeded > INT_MAX) { - Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); + if (bytesNeeded > SIZE_MAX - numElems) { + Tcl_Panic("max size for a Tcl value (%" TCL_Z_MODIFIER "u bytes) exceeded", SIZE_MAX); } } - if (bytesNeeded + numElems > INT_MAX + 1U) { - Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); - } bytesNeeded += numElems - 1; /* @@ -3484,7 +3477,7 @@ UpdateStringOfList( TclOOM(dst, bytesNeeded); for (i = 0; i < numElems; i++) { flagPtr[i] |= (i ? TCL_DONT_QUOTE_HASH : 0); - elem = TclGetStringFromObj(elemPtrs[i], &length); + elem = Tcl_GetStringFromObj(elemPtrs[i], &length); dst += TclConvertElement(elem, length, dst, flagPtr[i]); *dst++ = ' '; } @@ -3493,7 +3486,7 @@ UpdateStringOfList( (void) Tcl_InitStringRep(listObj, NULL, dst - 1 - start); if (flagPtr != localFlags) { - ckfree(flagPtr); + Tcl_Free(flagPtr); } } diff --git a/generic/tclLiteral.c b/generic/tclLiteral.c index 0c2c545..dfb92cb 100644 --- a/generic/tclLiteral.c +++ b/generic/tclLiteral.c @@ -28,10 +28,10 @@ * Function prototypes for static functions in this file: */ -static int AddLocalLiteralEntry(CompileEnv *envPtr, +static size_t AddLocalLiteralEntry(CompileEnv *envPtr, Tcl_Obj *objPtr, int localHash); static void ExpandLocalLiteralArray(CompileEnv *envPtr); -static unsigned HashString(const char *string, int length); +static size_t HashString(const char *string, size_t length); #ifdef TCL_COMPILE_DEBUG static LiteralEntry * LookupLiteralEntry(Tcl_Interp *interp, Tcl_Obj *objPtr); @@ -133,7 +133,7 @@ TclDeleteLiteralTable( objPtr = entryPtr->objPtr; TclDecrRefCount(objPtr); nextPtr = entryPtr->nextPtr; - ckfree(entryPtr); + Tcl_Free(entryPtr); entryPtr = nextPtr; } } @@ -143,7 +143,7 @@ TclDeleteLiteralTable( */ if (tablePtr->buckets != tablePtr->staticBuckets) { - ckfree(tablePtr->buckets); + Tcl_Free(tablePtr->buckets); } } @@ -178,8 +178,8 @@ TclCreateLiteral( Interp *iPtr, const char *bytes, /* The start of the string. Note that this is * not a NUL-terminated string. */ - int length, /* Number of bytes in the string. */ - unsigned hash, /* The string's hash. If -1, it will be + size_t length, /* Number of bytes in the string. */ + size_t hash, /* The string's hash. If -1, it will be * computed here. */ int *newPtr, Namespace *nsPtr, @@ -188,14 +188,14 @@ TclCreateLiteral( { LiteralTable *globalTablePtr = &iPtr->literalTable; LiteralEntry *globalPtr; - unsigned int globalHash; + size_t globalHash; Tcl_Obj *objPtr; /* * Is it in the interpreter's global literal table? */ - if (hash == (unsigned) -1) { + if (hash == TCL_INDEX_NONE) { hash = HashString(bytes, length); } globalHash = (hash & globalTablePtr->mask); @@ -210,8 +210,8 @@ TclCreateLiteral( * https://stackoverflow.com/q/54337750/301832 */ - int objLength; - const char *objBytes = TclGetStringFromObj(objPtr, &objLength); + size_t objLength; + const char *objBytes = Tcl_GetStringFromObj(objPtr, &objLength); if ((objLength == length) && ((length == 0) || ((objBytes[0] == bytes[0]) @@ -227,7 +227,7 @@ TclCreateLiteral( *globalPtrPtr = globalPtr; } if (flags & LITERAL_ON_HEAP) { - ckfree(bytes); + Tcl_Free((void *)bytes); } if (globalPtr->refCount != TCL_INDEX_NONE) { globalPtr->refCount++; @@ -238,7 +238,7 @@ TclCreateLiteral( } if (!newPtr) { if ((flags & LITERAL_ON_HEAP)) { - ckfree(bytes); + Tcl_Free((void *)bytes); } return NULL; } @@ -274,11 +274,11 @@ TclCreateLiteral( #ifdef TCL_COMPILE_DEBUG if (LookupLiteralEntry((Tcl_Interp *) iPtr, objPtr) != NULL) { Tcl_Panic("%s: literal \"%.*s\" found globally but shouldn't be", - "TclRegisterLiteral", (length>60? 60 : length), bytes); + "TclRegisterLiteral", (length>60? 60 : (int)length), bytes); } #endif - globalPtr = (LiteralEntry *)ckalloc(sizeof(LiteralEntry)); + globalPtr = (LiteralEntry *)Tcl_Alloc(sizeof(LiteralEntry)); globalPtr->objPtr = objPtr; Tcl_IncrRefCount(objPtr); globalPtr->refCount = 1; @@ -314,7 +314,7 @@ TclCreateLiteral( } if (!found) { Tcl_Panic("%s: literal \"%.*s\" wasn't global", - "TclRegisterLiteral", (length>60? 60 : length), bytes); + "TclRegisterLiteral", (length>60? 60 : (int)length), bytes); } } #endif /*TCL_COMPILE_DEBUG*/ @@ -351,10 +351,10 @@ Tcl_Obj * TclFetchLiteral( CompileEnv *envPtr, /* Points to the CompileEnv from which to * fetch the registered literal value. */ - unsigned int index) /* Index of the desired literal, as returned + size_t index) /* Index of the desired literal, as returned * by prior call to TclRegisterLiteral() */ { - if (index >= (unsigned int) envPtr->literalArrayNext) { + if (index >= envPtr->literalArrayNext) { return NULL; } return envPtr->literalArrayPtr[index].objPtr; @@ -387,14 +387,14 @@ TclFetchLiteral( *---------------------------------------------------------------------- */ -int +size_t 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. */ - int length, /* Number of bytes in the string. If < 0, the + size_t 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 @@ -408,12 +408,11 @@ TclRegisterLiteral( LiteralTable *localTablePtr = &envPtr->localLitTable; LiteralEntry *globalPtr, *localPtr; Tcl_Obj *objPtr; - unsigned hash; - unsigned int localHash; - int objIndex, isNew; + size_t hash, localHash, objIndex; + int isNew; Namespace *nsPtr; - if (length < 0) { + if (length == TCL_INDEX_NONE) { length = (bytes ? strlen(bytes) : 0); } hash = HashString(bytes, length); @@ -431,7 +430,7 @@ TclRegisterLiteral( || ((objPtr->bytes[0] == bytes[0]) && (memcmp(objPtr->bytes, bytes, length) == 0)))) { if ((flags & LITERAL_ON_HEAP)) { - ckfree(bytes); + Tcl_Free((void *)bytes); } objIndex = (localPtr - envPtr->literalArrayPtr); #ifdef TCL_COMPILE_DEBUG @@ -469,9 +468,9 @@ TclRegisterLiteral( objIndex = AddLocalLiteralEntry(envPtr, objPtr, localHash); #ifdef TCL_COMPILE_DEBUG - if (globalPtr != NULL && globalPtr->refCount + 1 < 2) { - Tcl_Panic("%s: global literal \"%.*s\" had bad refCount %d", - "TclRegisterLiteral", (length>60? 60 : length), bytes, + if (globalPtr != NULL && (globalPtr->refCount + 1 < 2)) { + Tcl_Panic("%s: global literal \"%.*s\" had bad refCount %" TCL_Z_MODIFIER "u", + "TclRegisterLiteral", (length>60? 60 : (int)length), bytes, globalPtr->refCount); } TclVerifyLocalLiteralTable(envPtr); @@ -509,9 +508,9 @@ LookupLiteralEntry( LiteralTable *globalTablePtr = &iPtr->literalTable; LiteralEntry *entryPtr; const char *bytes; - int length, globalHash; + size_t globalHash, length; - bytes = TclGetStringFromObj(objPtr, &length); + bytes = Tcl_GetStringFromObj(objPtr, &length); globalHash = (HashString(bytes, length) & globalTablePtr->mask); for (entryPtr=globalTablePtr->buckets[globalHash] ; entryPtr!=NULL; entryPtr=entryPtr->nextPtr) { @@ -554,8 +553,7 @@ TclHideLiteral( { LiteralEntry **nextPtrPtr, *entryPtr, *lPtr; LiteralTable *localTablePtr = &envPtr->localLitTable; - unsigned int localHash; - int length; + size_t localHash, length; const char *bytes; Tcl_Obj *newObjPtr; @@ -573,7 +571,7 @@ TclHideLiteral( TclReleaseLiteral(interp, lPtr->objPtr); lPtr->objPtr = newObjPtr; - bytes = TclGetStringFromObj(newObjPtr, &length); + bytes = Tcl_GetStringFromObj(newObjPtr, &length); localHash = HashString(bytes, length) & localTablePtr->mask; nextPtrPtr = &localTablePtr->buckets[localHash]; @@ -609,7 +607,7 @@ TclHideLiteral( *---------------------------------------------------------------------- */ -int +size_t TclAddLiteralObj( CompileEnv *envPtr,/* Points to CompileEnv in whose literal array * the object is to be inserted. */ @@ -619,7 +617,7 @@ TclAddLiteralObj( * NULL. */ { LiteralEntry *lPtr; - int objIndex; + size_t objIndex; if (envPtr->literalArrayNext >= envPtr->literalArrayEnd) { ExpandLocalLiteralArray(envPtr); @@ -658,7 +656,7 @@ TclAddLiteralObj( *---------------------------------------------------------------------- */ -static int +static size_t AddLocalLiteralEntry( CompileEnv *envPtr,/* Points to CompileEnv in whose literal array * the object is to be inserted. */ @@ -667,7 +665,7 @@ AddLocalLiteralEntry( { LiteralTable *localTablePtr = &envPtr->localLitTable; LiteralEntry *localPtr; - int objIndex; + size_t objIndex; objIndex = TclAddLiteralObj(envPtr, objPtr, &localPtr); @@ -692,8 +690,8 @@ AddLocalLiteralEntry( TclVerifyLocalLiteralTable(envPtr); { char *bytes; - int length, found; - size_t i; + int found; + size_t length, i; found = 0; for (i=0 ; i<localTablePtr->numBuckets ; i++) { @@ -706,9 +704,9 @@ AddLocalLiteralEntry( } if (!found) { - bytes = TclGetStringFromObj(objPtr, &length); + bytes = Tcl_GetStringFromObj(objPtr, &length); Tcl_Panic("%s: literal \"%.*s\" wasn't found locally", - "AddLocalLiteralEntry", (length>60? 60 : length), bytes); + "AddLocalLiteralEntry", (length>60? 60 : (int)length), bytes); } } #endif /*TCL_COMPILE_DEBUG*/ @@ -760,14 +758,14 @@ ExpandLocalLiteralArray( } if (envPtr->mallocedLiteralArray) { - newArrayPtr = (LiteralEntry *)ckrealloc(currArrayPtr, newSize); + newArrayPtr = (LiteralEntry *)Tcl_Realloc(currArrayPtr, newSize); } else { /* - * envPtr->literalArrayPtr isn't a ckalloc'd pointer, so we must - * code a ckrealloc equivalent for ourselves. + * envPtr->literalArrayPtr isn't a Tcl_Alloc'd pointer, so we must + * code a Tcl_Realloc equivalent for ourselves. */ - newArrayPtr = (LiteralEntry *)ckalloc(newSize); + newArrayPtr = (LiteralEntry *)Tcl_Alloc(newSize); memcpy(newArrayPtr, currArrayPtr, currBytes); envPtr->mallocedLiteralArray = 1; } @@ -828,16 +826,15 @@ TclReleaseLiteral( LiteralTable *globalTablePtr; LiteralEntry *entryPtr, *prevPtr; const char *bytes; - int length; - unsigned int index; + size_t length, index; if (iPtr == NULL) { goto done; } globalTablePtr = &iPtr->literalTable; - bytes = TclGetStringFromObj(objPtr, &length); - index = (HashString(bytes, length) & globalTablePtr->mask); + bytes = Tcl_GetStringFromObj(objPtr, &length); + index = HashString(bytes, length) & globalTablePtr->mask; /* * Check to see if the object is in the global literal table and remove @@ -860,7 +857,7 @@ TclReleaseLiteral( } else { prevPtr->nextPtr = entryPtr->nextPtr; } - ckfree(entryPtr); + Tcl_Free(entryPtr); globalTablePtr->numEntries--; TclDecrRefCount(objPtr); @@ -898,12 +895,12 @@ TclReleaseLiteral( *---------------------------------------------------------------------- */ -static unsigned +static size_t HashString( const char *string, /* String for which to compute hash value. */ - int length) /* Number of bytes in the string. */ + size_t length) /* Number of bytes in the string. */ { - unsigned int result = 0; + size_t result = 0; /* * I tried a zillion different hash functions and asked many other people @@ -972,8 +969,7 @@ RebuildLiteralTable( LiteralEntry *entryPtr; LiteralEntry **bucketPtr; const char *bytes; - unsigned int oldSize, index; - int count, length; + size_t oldSize, count, index, length; oldSize = tablePtr->numBuckets; oldBuckets = tablePtr->buckets; @@ -994,7 +990,7 @@ RebuildLiteralTable( } tablePtr->numBuckets *= 4; - tablePtr->buckets = (LiteralEntry **)ckalloc( + tablePtr->buckets = (LiteralEntry **)Tcl_Alloc( tablePtr->numBuckets * sizeof(LiteralEntry*)); for (count=tablePtr->numBuckets, newChainPtr=tablePtr->buckets; count>0 ; count--, newChainPtr++) { @@ -1009,7 +1005,7 @@ RebuildLiteralTable( for (oldChainPtr=oldBuckets ; oldSize>0 ; oldSize--,oldChainPtr++) { for (entryPtr=*oldChainPtr ; entryPtr!=NULL ; entryPtr=*oldChainPtr) { - bytes = TclGetStringFromObj(entryPtr->objPtr, &length); + bytes = Tcl_GetStringFromObj(entryPtr->objPtr, &length); index = (HashString(bytes, length) & tablePtr->mask); *oldChainPtr = entryPtr->nextPtr; @@ -1024,7 +1020,7 @@ RebuildLiteralTable( */ if (oldBuckets != tablePtr->staticBuckets) { - ckfree(oldBuckets); + Tcl_Free(oldBuckets); } } @@ -1097,9 +1093,7 @@ TclLiteralStats( LiteralTable *tablePtr) /* Table for which to produce stats. */ { #define NUM_COUNTERS 10 - size_t count[NUM_COUNTERS]; - int overflow; - size_t i, j; + size_t count[NUM_COUNTERS], overflow, i, j; double average, tmp; LiteralEntry *entryPtr; char *result, *p; @@ -1133,8 +1127,8 @@ TclLiteralStats( * Print out the histogram and a few other pieces of information. */ - result = (char *)ckalloc(NUM_COUNTERS*60 + 300); - sprintf(result, "%d entries in table, %d buckets\n", + result = (char *)Tcl_Alloc(NUM_COUNTERS*60 + 300); + sprintf(result, "%" 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++) { @@ -1142,7 +1136,7 @@ TclLiteralStats( i, count[i]); p += strlen(p); } - sprintf(p, "number of buckets with %d or more entries: %d\n", + sprintf(p, "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); @@ -1175,19 +1169,17 @@ TclVerifyLocalLiteralTable( LiteralTable *localTablePtr = &envPtr->localLitTable; LiteralEntry *localPtr; char *bytes; - size_t i, count; - int length; + size_t i, length, count = 0; - count = 0; for (i=0 ; i<localTablePtr->numBuckets ; i++) { for (localPtr=localTablePtr->buckets[i] ; localPtr!=NULL; localPtr=localPtr->nextPtr) { count++; if (localPtr->refCount != TCL_INDEX_NONE) { - bytes = TclGetStringFromObj(localPtr->objPtr, &length); - Tcl_Panic("%s: local literal \"%.*s\" had bad refCount %u", + bytes = Tcl_GetStringFromObj(localPtr->objPtr, &length); + Tcl_Panic("%s: local literal \"%.*s\" had bad refCount %" TCL_Z_MODIFIER "u", "TclVerifyLocalLiteralTable", - (length>60? 60 : length), bytes, localPtr->refCount); + (length>60? 60 : (int) length), bytes, localPtr->refCount); } if (localPtr->objPtr->bytes == NULL) { Tcl_Panic("%s: literal has NULL string rep", @@ -1196,7 +1188,7 @@ TclVerifyLocalLiteralTable( } } if (count != localTablePtr->numEntries) { - Tcl_Panic("%s: local literal table had %" TCL_Z_MODIFIER "u entries, should be %u", + Tcl_Panic("%s: local literal table had %" TCL_Z_MODIFIER "u entries, should be %" TCL_Z_MODIFIER "u", "TclVerifyLocalLiteralTable", count, localTablePtr->numEntries); } @@ -1226,19 +1218,17 @@ TclVerifyGlobalLiteralTable( LiteralTable *globalTablePtr = &iPtr->literalTable; LiteralEntry *globalPtr; char *bytes; - size_t i, count; - int length; + size_t i, length, count = 0; - count = 0; for (i=0 ; i<globalTablePtr->numBuckets ; i++) { for (globalPtr=globalTablePtr->buckets[i] ; globalPtr!=NULL; globalPtr=globalPtr->nextPtr) { count++; if (globalPtr->refCount + 1 < 2) { - bytes = TclGetStringFromObj(globalPtr->objPtr, &length); - Tcl_Panic("%s: global literal \"%.*s\" had bad refCount %d", + bytes = Tcl_GetStringFromObj(globalPtr->objPtr, &length); + Tcl_Panic("%s: global literal \"%.*s\" had bad refCount %" TCL_Z_MODIFIER "u", "TclVerifyGlobalLiteralTable", - (length>60? 60 : length), bytes, globalPtr->refCount); + (length>60? 60 : (int)length), bytes, globalPtr->refCount); } if (globalPtr->objPtr->bytes == NULL) { Tcl_Panic("%s: literal has NULL string rep", @@ -1247,7 +1237,7 @@ TclVerifyGlobalLiteralTable( } } if (count != globalTablePtr->numEntries) { - Tcl_Panic("%s: global literal table had %" TCL_Z_MODIFIER "u entries, should be %u", + Tcl_Panic("%s: global literal table had %" TCL_Z_MODIFIER "u entries, should be %" TCL_Z_MODIFIER "u", "TclVerifyGlobalLiteralTable", count, globalTablePtr->numEntries); } diff --git a/generic/tclLoad.c b/generic/tclLoad.c index ee1862d..fa0b584 100644 --- a/generic/tclLoad.c +++ b/generic/tclLoad.c @@ -17,18 +17,14 @@ * The following structure describes a library that has been loaded either * dynamically (with the "load" command) or statically (as indicated by a call * to Tcl_StaticLibrary). All such libraries are linked together into a - * single list for the process. Library are never unloaded, until the - * application exits, when TclFinalizeLoad is called, and these structures are - * freed. + * single list for the process. */ typedef struct LoadedLibrary { char *fileName; /* Name of the file from which the library was * loaded. An empty string means the library * is loaded statically. Malloc-ed. */ - char *prefix; /* Prefix for the library, - * properly capitalized (first letter UC, - * others LC), as in "Net". + char *prefix; /* Prefix for the library. * Malloc-ed. */ Tcl_LoadHandle loadHandle; /* Token for the loaded file which should be * passed to (*unLoadProcPtr)() when the file @@ -94,7 +90,7 @@ typedef struct InterpLibrary { * Prototypes for functions that are private to this file: */ -static void LoadCleanupProc(ClientData clientData, +static void LoadCleanupProc(void *clientData, Tcl_Interp *interp); static int IsStatic (LoadedLibrary *libraryPtr); static int UnloadLibrary(Tcl_Interp *interp, Tcl_Interp *target, @@ -144,15 +140,15 @@ Tcl_LoadObjCmd( const char *p, *fullFileName, *prefix; Tcl_LoadHandle loadHandle; Tcl_UniChar ch = 0; - unsigned len; - int index, flags = 0; + size_t len; + int flags = 0; Tcl_Obj *const *savedobjv = objv; static const char *const options[] = { "-global", "-lazy", "--", NULL }; enum loadOptionsEnum { LOAD_GLOBAL, LOAD_LAZY, LOAD_LAST - }; + } index; while (objc > 2) { if (TclGetString(objv[1])[0] != '-') { @@ -163,9 +159,9 @@ Tcl_LoadObjCmd( return TCL_ERROR; } ++objv; --objc; - if (LOAD_GLOBAL == (enum loadOptionsEnum) index) { + if (LOAD_GLOBAL == index) { flags |= TCL_LOAD_GLOBAL; - } else if (LOAD_LAZY == (enum loadOptionsEnum) index) { + } else if (LOAD_LAZY == index) { flags |= TCL_LOAD_LAZY; } else { break; @@ -178,7 +174,7 @@ Tcl_LoadObjCmd( if (Tcl_FSConvertToPathType(interp, objv[1]) != TCL_OK) { return TCL_ERROR; } - fullFileName = Tcl_GetString(objv[1]); + fullFileName = TclGetString(objv[1]); Tcl_DStringInit(&pfx); Tcl_DStringInit(&initName); @@ -189,7 +185,7 @@ Tcl_LoadObjCmd( prefix = NULL; if (objc >= 3) { - prefix = Tcl_GetString(objv[2]); + prefix = TclGetString(objv[2]); if (prefix[0] == '\0') { prefix = NULL; } @@ -209,7 +205,7 @@ Tcl_LoadObjCmd( target = interp; if (objc == 4) { - const char *childIntName = Tcl_GetString(objv[3]); + const char *childIntName = TclGetString(objv[3]); target = Tcl_GetChild(interp, childIntName); if (target == NULL) { @@ -239,8 +235,6 @@ Tcl_LoadObjCmd( Tcl_DStringAppend(&pfx, prefix, -1); TclDStringClear(&tmp); Tcl_DStringAppend(&tmp, libraryPtr->prefix, -1); - Tcl_UtfToLower(Tcl_DStringValue(&pfx)); - Tcl_UtfToLower(Tcl_DStringValue(&tmp)); if (strcmp(Tcl_DStringValue(&tmp), Tcl_DStringValue(&pfx)) == 0) { namesMatch = 1; @@ -316,7 +310,7 @@ Tcl_LoadObjCmd( Tcl_DStringAppend(&pfx, prefix, -1); } else { Tcl_Obj *splitPtr, *pkgGuessPtr; - int pElements; + size_t pElements; const char *pkgGuess; /* @@ -326,14 +320,14 @@ Tcl_LoadObjCmd( /* * The platform-specific code couldn't figure out the prefix. * Make a guess by taking the last element of the file - * name, stripping off any leading "lib" and/or "tcl", and + * name, stripping off any leading "lib" and/or "tcl9", and * then using all of the alphabetic and underline characters * that follow that. */ splitPtr = Tcl_FSSplitPath(objv[1], &pElements); Tcl_ListObjIndex(NULL, splitPtr, pElements -1, &pkgGuessPtr); - pkgGuess = Tcl_GetString(pkgGuessPtr); + pkgGuess = TclGetString(pkgGuessPtr); if ((pkgGuess[0] == 'l') && (pkgGuess[1] == 'i') && (pkgGuess[2] == 'b')) { pkgGuess += 3; @@ -349,14 +343,13 @@ Tcl_LoadObjCmd( || (pkgGuess[0] == 'T') #endif ) && (pkgGuess[1] == 'c') - && (pkgGuess[2] == 'l')) { - pkgGuess += 3; + && (pkgGuess[2] == 'l') && (pkgGuess[3] == '9')) { + pkgGuess += 4; } for (p = pkgGuess; *p != 0; p += offset) { offset = TclUtfToUniChar(p, &ch); - if ((ch > 0x100) - || !(isalpha(UCHAR(ch)) /* INTL: ISO only */ - || (UCHAR(ch) == '_'))) { + if (!Tcl_UniCharIsWordChar(UCHAR(ch)) + || Tcl_UniCharIsDigit(UCHAR(ch))) { break; } } @@ -372,16 +365,17 @@ Tcl_LoadObjCmd( } Tcl_DStringAppend(&pfx, pkgGuess, p - pkgGuess); Tcl_DecrRefCount(splitPtr); - } - /* - * Fix the capitalization in the prefix so that the first - * character is in caps (or title case) but the others are all - * lower-case. - */ + /* + * Fix the capitalization in the prefix so that the first + * character is in caps (or title case) but the others are all + * lower-case. + */ - Tcl_DStringSetLength(&pfx, - Tcl_UtfToTitle(Tcl_DStringValue(&pfx))); + Tcl_DStringSetLength(&pfx, + Tcl_UtfToTitle(Tcl_DStringValue(&pfx))); + + } /* * Compute the names of the two initialization functions, based on the @@ -417,12 +411,12 @@ Tcl_LoadObjCmd( * Create a new record to describe this library. */ - libraryPtr = (LoadedLibrary *)ckalloc(sizeof(LoadedLibrary)); + libraryPtr = (LoadedLibrary *)Tcl_Alloc(sizeof(LoadedLibrary)); len = strlen(fullFileName) + 1; - libraryPtr->fileName = (char *)ckalloc(len); + libraryPtr->fileName = (char *)Tcl_Alloc(len); memcpy(libraryPtr->fileName, fullFileName, len); len = Tcl_DStringLength(&pfx) + 1; - libraryPtr->prefix = (char *)ckalloc(len); + libraryPtr->prefix = (char *)Tcl_Alloc(len); memcpy(libraryPtr->prefix, Tcl_DStringValue(&pfx), len); libraryPtr->loadHandle = loadHandle; libraryPtr->initProc = initProc; @@ -486,19 +480,17 @@ Tcl_LoadObjCmd( */ if (code != TCL_OK) { -#if defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8 Interp *iPtr = (Interp *) target; - if (iPtr->result && *(iPtr->result) && !iPtr->freeProc) { + if (iPtr->legacyResult && *(iPtr->legacyResult) && !iPtr->legacyFreeProc) { /* * A call to Tcl_InitStubs() determined the caller extension and * this interp are incompatible in their stubs mechanisms, and * recorded the error in the oldest legacy place we have to do so. */ - Tcl_SetObjResult(target, Tcl_NewStringObj(iPtr->result, -1)); - iPtr->result = &tclEmptyString; - iPtr->freeProc = NULL; + Tcl_SetObjResult(target, Tcl_NewStringObj(iPtr->legacyResult, -1)); + iPtr->legacyResult = NULL; + iPtr->legacyFreeProc = (void (*) (void))-1; } -#endif /* defined(TCL_NO_DEPRECATED) */ Tcl_TransferResult(target, code, interp); goto done; } @@ -524,7 +516,7 @@ Tcl_LoadObjCmd( */ ipFirstPtr = (InterpLibrary *)Tcl_GetAssocData(target, "tclLoad", NULL); - ipPtr = (InterpLibrary *)ckalloc(sizeof(InterpLibrary)); + ipPtr = (InterpLibrary *)Tcl_Alloc(sizeof(InterpLibrary)); ipPtr->libraryPtr = libraryPtr; ipPtr->nextPtr = ipFirstPtr; Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc, ipPtr); @@ -567,7 +559,7 @@ Tcl_UnloadObjCmd( LoadedLibrary *libraryPtr; Tcl_DString pfx, tmp; InterpLibrary *ipFirstPtr, *ipPtr; - int i, index, code, complain = 1, keepLibrary = 0; + int i, code, complain = 1, keepLibrary = 0; const char *fullFileName = ""; const char *prefix; static const char *const options[] = { @@ -575,12 +567,12 @@ Tcl_UnloadObjCmd( }; enum unloadOptionsEnum { UNLOAD_NOCOMPLAIN, UNLOAD_KEEPLIB, UNLOAD_LAST - }; + } index; for (i = 1; i < objc; i++) { if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, &index) != TCL_OK) { - fullFileName = Tcl_GetString(objv[i]); + fullFileName = TclGetString(objv[i]); if (fullFileName[0] == '-') { /* * It looks like the command contains an option so signal an @@ -598,7 +590,7 @@ Tcl_UnloadObjCmd( break; } } - switch ((enum unloadOptionsEnum)index) { + switch (index) { case UNLOAD_NOCOMPLAIN: /* -nocomplain */ complain = 0; break; @@ -620,13 +612,13 @@ Tcl_UnloadObjCmd( return TCL_ERROR; } - fullFileName = Tcl_GetString(objv[i]); + fullFileName = TclGetString(objv[i]); Tcl_DStringInit(&pfx); Tcl_DStringInit(&tmp); prefix = NULL; if (objc - i >= 2) { - prefix = Tcl_GetString(objv[i+1]); + prefix = TclGetString(objv[i+1]); if (prefix[0] == '\0') { prefix = NULL; } @@ -646,7 +638,7 @@ Tcl_UnloadObjCmd( target = interp; if (objc - i == 3) { - const char *childIntName = Tcl_GetString(objv[i + 2]); + const char *childIntName = TclGetString(objv[i + 2]); target = Tcl_GetChild(interp, childIntName); if (target == NULL) { @@ -676,8 +668,6 @@ Tcl_UnloadObjCmd( Tcl_DStringAppend(&pfx, prefix, -1); TclDStringClear(&tmp); Tcl_DStringAppend(&tmp, libraryPtr->prefix, -1); - Tcl_UtfToLower(Tcl_DStringValue(&pfx)); - Tcl_UtfToLower(Tcl_DStringValue(&tmp)); if (strcmp(Tcl_DStringValue(&tmp), Tcl_DStringValue(&pfx)) == 0) { namesMatch = 1; @@ -892,7 +882,7 @@ UnloadLibrary( } } } - ckfree(ipPtr); + Tcl_Free(ipPtr); Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc, ipFirstPtr); @@ -965,9 +955,9 @@ UnloadLibrary( } } - ckfree(iterLibraryPtr->fileName); - ckfree(iterLibraryPtr->prefix); - ckfree(iterLibraryPtr); + Tcl_Free(iterLibraryPtr->fileName); + Tcl_Free(iterLibraryPtr->prefix); + Tcl_Free(iterLibraryPtr); Tcl_MutexUnlock(&libraryMutex); } else { code = TCL_ERROR; @@ -1011,9 +1001,7 @@ Tcl_StaticLibrary( * already been loaded into the given * interpreter by calling the appropriate init * proc. */ - const char *prefix, /* Prefix (must be properly - * capitalized: first letter upper case, - * others lower case). */ + const char *prefix, /* Prefix. */ Tcl_LibraryInitProc *initProc, /* Function to call to incorporate this * library into a trusted interpreter. */ @@ -1048,10 +1036,10 @@ Tcl_StaticLibrary( */ if (libraryPtr == NULL) { - libraryPtr = (LoadedLibrary *)ckalloc(sizeof(LoadedLibrary)); - libraryPtr->fileName = (char *)ckalloc(1); + libraryPtr = (LoadedLibrary *)Tcl_Alloc(sizeof(LoadedLibrary)); + libraryPtr->fileName = (char *)Tcl_Alloc(1); libraryPtr->fileName[0] = 0; - libraryPtr->prefix = (char *)ckalloc(strlen(prefix) + 1); + libraryPtr->prefix = (char *)Tcl_Alloc(strlen(prefix) + 1); strcpy(libraryPtr->prefix, prefix); libraryPtr->loadHandle = NULL; libraryPtr->initProc = initProc; @@ -1083,7 +1071,7 @@ Tcl_StaticLibrary( * loaded. */ - ipPtr = (InterpLibrary *)ckalloc(sizeof(InterpLibrary)); + ipPtr = (InterpLibrary *)Tcl_Alloc(sizeof(InterpLibrary)); ipPtr->libraryPtr = libraryPtr; ipPtr->nextPtr = ipFirstPtr; Tcl_SetAssocData(interp, "tclLoad", LoadCleanupProc, ipPtr); @@ -1206,7 +1194,7 @@ TclGetLoadedLibraries( static void LoadCleanupProc( - TCL_UNUSED(ClientData), /* Pointer to first InterpLibrary structure + TCL_UNUSED(void *), /* Pointer to first InterpLibrary structure * for interp. */ Tcl_Interp *interp) { @@ -1269,9 +1257,9 @@ TclFinalizeLoad(void) } #endif - ckfree(libraryPtr->fileName); - ckfree(libraryPtr->prefix); - ckfree(libraryPtr); + Tcl_Free(libraryPtr->fileName); + Tcl_Free(libraryPtr->prefix); + Tcl_Free(libraryPtr); } } diff --git a/generic/tclMain.c b/generic/tclMain.c index 628deaa..bb77e28 100644 --- a/generic/tclMain.c +++ b/generic/tclMain.c @@ -53,7 +53,7 @@ NewNativeObj( Tcl_DStringInit(&ds); Tcl_WCharToUtfDString(string, -1, &ds); #else - Tcl_ExternalToUtfDString(NULL, (char *)string, -1, &ds); + (void)Tcl_ExternalToUtfDString(NULL, (char *)string, -1, &ds); #endif return Tcl_DStringToObj(&ds); } @@ -110,8 +110,8 @@ typedef struct { MODULE_SCOPE Tcl_MainLoopProc *TclGetMainLoop(void); static void Prompt(Tcl_Interp *interp, InteractiveState *isPtr); -static void StdinProc(ClientData clientData, int mask); -static void FreeMainInterp(ClientData clientData); +static void StdinProc(void *clientData, int mask); +static void FreeMainInterp(void *clientData); #if !defined(_WIN32) || defined(UNICODE) && !defined(TCL_ASCII_MAIN) static Tcl_ThreadDataKey dataKey; @@ -194,7 +194,7 @@ Tcl_GetStartupScript( if (tsdPtr->encoding == NULL) { *encodingPtr = NULL; } else { - *encodingPtr = Tcl_GetString(tsdPtr->encoding); + *encodingPtr = TclGetString(tsdPtr->encoding); } } return tsdPtr->path; @@ -245,7 +245,7 @@ Tcl_SourceRCFile( c = Tcl_OpenFileChannel(NULL, fullName, "r", 0); if (c != NULL) { - Tcl_Close(NULL, c); + Tcl_CloseEx(NULL, c, 0); if (Tcl_EvalFile(interp, fullName) != TCL_OK) { chan = Tcl_GetStdChannel(TCL_STDERR); if (chan) { @@ -278,9 +278,9 @@ Tcl_SourceRCFile( *---------------------------------------------------------------------- */ -void +TCL_NORETURN void Tcl_MainEx( - int argc, /* Number of arguments. */ + size_t 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) { - int i=0; /* argv[i] index */ + size_t i=0; /* argv[i] index */ Tcl_Obj *path, *resultPtr, *argvPtr, *appName; const char *encodingName = NULL; int code, exitCode = 0; @@ -297,8 +297,8 @@ Tcl_MainEx( InteractiveState is; TclpSetInitialEncodings(); - if (0 < argc) { - --argc; /* "consume" argv[0] */ + if (argc + 1 > 1) { + --argc; /* consume argv[0] */ ++i; } TclpFindExecutable ((const char *)argv [0]); /* nb: this could be NULL @@ -326,15 +326,15 @@ Tcl_MainEx( */ /* mind argc is being adjusted as we proceed */ - if ((argc >= 3) && (0 == _tcscmp(TEXT("-encoding"), argv[1])) + if ((argc >= 3) && argv[1] && argv[2] && argv[3] && (0 == _tcscmp(TEXT("-encoding"), argv[1])) && ('-' != argv[3][0])) { Tcl_Obj *value = NewNativeObj(argv[2]); Tcl_SetStartupScript(NewNativeObj(argv[3]), - Tcl_GetString(value)); + TclGetString(value)); Tcl_DecrRefCount(value); argc -= 3; i += 3; - } else if ((argc >= 1) && ('-' != argv[1][0])) { + } else if ((argc >= 1) && argv[1] && ('-' != argv[1][0])) { Tcl_SetStartupScript(NewNativeObj(argv[1]), NULL); argc--; i++; @@ -342,17 +342,19 @@ Tcl_MainEx( } path = Tcl_GetStartupScript(&encodingName); - if (path == NULL) { + if (path != NULL) { + appName = path; + } else if (argv[0]) { appName = NewNativeObj(argv[0]); } else { - appName = path; + appName = Tcl_NewStringObj("tclsh", -1); } Tcl_SetVar2Ex(interp, "argv0", NULL, appName, TCL_GLOBAL_ONLY); Tcl_SetVar2Ex(interp, "argc", NULL, Tcl_NewWideIntObj(argc), TCL_GLOBAL_ONLY); argvPtr = Tcl_NewListObj(0, NULL); - while (argc--) { + while (argc-- && argv[i]) { Tcl_ListObjAppendElement(NULL, argvPtr, NewNativeObj(argv[i++])); } Tcl_SetVar2Ex(interp, "argv", NULL, argvPtr, TCL_GLOBAL_ONLY); @@ -452,7 +454,7 @@ Tcl_MainEx( while ((is.input != NULL) && !Tcl_InterpDeleted(interp)) { mainLoopProc = TclGetMainLoop(); if (mainLoopProc == NULL) { - int length; + size_t length; if (is.tty) { Prompt(interp, &is); @@ -473,7 +475,7 @@ Tcl_MainEx( Tcl_IncrRefCount(is.commandPtr); } length = Tcl_GetsObj(is.input, is.commandPtr); - if (length < 0) { + if (length == TCL_INDEX_NONE) { if (Tcl_InputBlocked(is.input)) { /* * This can only happen if stdin has been set to @@ -734,11 +736,11 @@ TclFullFinalizationRequested(void) static void StdinProc( - ClientData clientData, /* The state of interactive cmd line */ + void *clientData, /* The state of interactive cmd line */ TCL_UNUSED(int) /*mask*/) { int code; - int length; + size_t length; InteractiveState *isPtr = (InteractiveState *)clientData; Tcl_Channel chan = isPtr->input; Tcl_Obj *commandPtr = isPtr->commandPtr; @@ -750,7 +752,7 @@ StdinProc( Tcl_IncrRefCount(commandPtr); } length = Tcl_GetsObj(chan, commandPtr); - if (length < 0) { + if (length == TCL_INDEX_NONE) { if (Tcl_InputBlocked(chan)) { return; } @@ -910,7 +912,7 @@ Prompt( static void FreeMainInterp( - ClientData clientData) + void *clientData) { Tcl_Interp *interp = (Tcl_Interp *)clientData; diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index 6269bbe..1882e0a 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -33,7 +33,7 @@ */ typedef struct { - unsigned long numNsCreated; /* Count of the number of namespaces created + size_t numNsCreated; /* Count of the number of namespaces created * within the thread. This value is used as a * unique id for each namespace. Cannot be * per-interp because the nsId is used to @@ -53,7 +53,7 @@ static Tcl_ThreadDataKey dataKey; * with some information that is used to check the cached pointer's validity. */ -typedef struct ResolvedNsName { +typedef struct { Namespace *nsPtr; /* A cached pointer to the Namespace that the * name resolved to. */ Namespace *refNsPtr; /* Points to the namespace context in which @@ -130,7 +130,8 @@ static const Tcl_ObjType nsNameType = { FreeNsNameInternalRep, /* freeIntRepProc */ DupNsNameInternalRep, /* dupIntRepProc */ NULL, /* updateStringProc */ - SetNsNameFromAny /* setFromAnyProc */ + SetNsNameFromAny, /* setFromAnyProc */ + TCL_OBJTYPE_V0 }; #define NsNameSetInternalRep(objPtr, nnPtr) \ @@ -326,7 +327,7 @@ Tcl_PushCallFrame( framePtr->callerPtr = iPtr->framePtr; framePtr->callerVarPtr = iPtr->varFramePtr; if (iPtr->varFramePtr != NULL) { - framePtr->level = (iPtr->varFramePtr->level + 1); + framePtr->level = iPtr->varFramePtr->level + 1U; } else { framePtr->level = 0; } @@ -391,10 +392,10 @@ Tcl_PopCallFrame( if (framePtr->varTablePtr != NULL) { TclDeleteVars(iPtr, framePtr->varTablePtr); - ckfree(framePtr->varTablePtr); + Tcl_Free(framePtr->varTablePtr); framePtr->varTablePtr = NULL; } - if (framePtr->numCompiledLocals > 0) { + if (framePtr->numCompiledLocals + 1 > 1) { TclDeleteCompiledLocalVars(iPtr, framePtr); if (framePtr->localCachePtr->refCount-- <= 1) { TclFreeLocalCache(interp, framePtr->localCachePtr); @@ -409,9 +410,8 @@ Tcl_PopCallFrame( */ nsPtr = framePtr->nsPtr; - nsPtr->activationCount--; - if ((nsPtr->flags & NS_DYING) - && (nsPtr->activationCount - (nsPtr == iPtr->globalNsPtr) == 0)) { + if ((--nsPtr->activationCount <= (unsigned)(nsPtr == iPtr->globalNsPtr)) + && (nsPtr->flags & NS_DYING)) { Tcl_DeleteNamespace((Tcl_Namespace *) nsPtr); } framePtr->nsPtr = NULL; @@ -493,7 +493,7 @@ TclPopStackFrame( static char * EstablishErrorCodeTraces( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, TCL_UNUSED(const char *) /*name1*/, TCL_UNUSED(const char *) /*name2*/, @@ -525,7 +525,7 @@ EstablishErrorCodeTraces( static char * ErrorCodeRead( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, TCL_UNUSED(const char *) /*name1*/, TCL_UNUSED(const char *) /*name2*/, @@ -567,7 +567,7 @@ ErrorCodeRead( static char * EstablishErrorInfoTraces( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, TCL_UNUSED(const char *) /*name1*/, TCL_UNUSED(const char *) /*name2*/, @@ -599,7 +599,7 @@ EstablishErrorInfoTraces( static char * ErrorInfoRead( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, TCL_UNUSED(const char *) /*name1*/, TCL_UNUSED(const char *) /*name2*/, @@ -665,7 +665,8 @@ Tcl_CreateNamespace( Tcl_HashEntry *entryPtr; Tcl_DString buffer1, buffer2; Tcl_DString *namePtr, *buffPtr; - int newEntry, nameLen; + int newEntry; + size_t nameLen; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); const char *nameStr; Tcl_DString tmpBuffer; @@ -764,9 +765,9 @@ Tcl_CreateNamespace( */ doCreate: - nsPtr = (Namespace *)ckalloc(sizeof(Namespace)); + nsPtr = (Namespace *)Tcl_Alloc(sizeof(Namespace)); nameLen = strlen(simpleName) + 1; - nsPtr->name = (char *)ckalloc(nameLen); + nsPtr->name = (char *)Tcl_Alloc(nameLen); memcpy(nsPtr->name, simpleName, nameLen); nsPtr->fullName = NULL; /* Set below. */ nsPtr->clientData = clientData; @@ -854,7 +855,7 @@ Tcl_CreateNamespace( name = Tcl_DStringValue(namePtr); nameLen = Tcl_DStringLength(namePtr); - nsPtr->fullName = (char *)ckalloc(nameLen + 1); + nsPtr->fullName = (char *)Tcl_Alloc(nameLen + 1); memcpy(nsPtr->fullName, name, nameLen + 1); Tcl_DStringFree(&buffer1); @@ -1003,7 +1004,7 @@ Tcl_DeleteNamespace( * FreeNsNameInternalRep when its refCount reaches 0. */ - if (nsPtr->activationCount - (nsPtr == globalNsPtr) > 0) { + if (nsPtr->activationCount > (unsigned)(nsPtr == globalNsPtr)) { nsPtr->flags |= NS_DYING; if (nsPtr->parentPtr != NULL) { entryPtr = Tcl_FindHashEntry( @@ -1042,7 +1043,7 @@ Tcl_DeleteNamespace( #else if (nsPtr->childTablePtr != NULL) { Tcl_DeleteHashTable(nsPtr->childTablePtr); - ckfree(nsPtr->childTablePtr); + Tcl_Free(nsPtr->childTablePtr); } #endif Tcl_DeleteHashTable(&nsPtr->cmdTable); @@ -1081,7 +1082,8 @@ TclDeleteNamespaceChildren( { Interp *iPtr = (Interp *) nsPtr->interp; Tcl_HashEntry *entryPtr; - int i, unchecked; + size_t i; + int unchecked; Tcl_HashSearch search; /* * Delete all the child namespaces. @@ -1099,7 +1101,7 @@ TclDeleteNamespaceChildren( #ifndef BREAK_NAMESPACE_COMPAT unchecked = (nsPtr->childTable.numEntries > 0); while (nsPtr->childTable.numEntries > 0 && unchecked) { - int length = nsPtr->childTable.numEntries; + size_t length = nsPtr->childTable.numEntries; Namespace **children = (Namespace **)TclStackAlloc((Tcl_Interp *) iPtr, sizeof(Namespace *) * length); @@ -1125,7 +1127,7 @@ TclDeleteNamespaceChildren( if (nsPtr->childTablePtr != NULL) { unchecked = (nsPtr->childTable.numEntries > 0); while (nsPtr->childTable.numEntries > 0 && unchecked) { - int length = nsPtr->childTablePtr->numEntries; + size_t length = nsPtr->childTablePtr->numEntries; Namespace **children = (Namespace **)TclStackAlloc((Tcl_Interp *) iPtr, sizeof(Namespace *) * length); @@ -1181,7 +1183,7 @@ TclTeardownNamespace( Interp *iPtr = (Interp *) nsPtr->interp; Tcl_HashEntry *entryPtr; Tcl_HashSearch search; - int i; + size_t i; /* * Start by destroying the namespace's variable table, since variables @@ -1202,7 +1204,7 @@ TclTeardownNamespace( */ while (nsPtr->cmdTable.numEntries > 0) { - int length = nsPtr->cmdTable.numEntries; + size_t length = nsPtr->cmdTable.numEntries; Command **cmds = (Command **)TclStackAlloc((Tcl_Interp *) iPtr, sizeof(Command *) * length); @@ -1267,9 +1269,9 @@ TclTeardownNamespace( if (nsPtr->exportArrayPtr != NULL) { for (i = 0; i < nsPtr->numExportPatterns; i++) { - ckfree(nsPtr->exportArrayPtr[i]); + Tcl_Free(nsPtr->exportArrayPtr[i]); } - ckfree(nsPtr->exportArrayPtr); + Tcl_Free(nsPtr->exportArrayPtr); nsPtr->exportArrayPtr = NULL; nsPtr->numExportPatterns = 0; nsPtr->maxExportPatterns = 0; @@ -1321,9 +1323,9 @@ NamespaceFree( * (for error messages), and the structure itself. */ - ckfree(nsPtr->name); - ckfree(nsPtr->fullName); - ckfree(nsPtr); + Tcl_Free(nsPtr->name); + Tcl_Free(nsPtr->fullName); + Tcl_Free(nsPtr); } /* @@ -1392,7 +1394,7 @@ Tcl_Export( Namespace *currNsPtr = (Namespace *) TclGetCurrentNamespace(interp); const char *simplePattern; char *patternCpy; - int neededElems, len, i; + size_t neededElems, len, i; /* * If the specified namespace is NULL, use the current namespace. @@ -1412,9 +1414,9 @@ Tcl_Export( if (resetListFirst) { if (nsPtr->exportArrayPtr != NULL) { for (i = 0; i < nsPtr->numExportPatterns; i++) { - ckfree(nsPtr->exportArrayPtr[i]); + Tcl_Free(nsPtr->exportArrayPtr[i]); } - ckfree(nsPtr->exportArrayPtr); + Tcl_Free(nsPtr->exportArrayPtr); nsPtr->exportArrayPtr = NULL; TclInvalidateNsCmdLookup(nsPtr); nsPtr->numExportPatterns = 0; @@ -1461,7 +1463,7 @@ Tcl_Export( if (neededElems > nsPtr->maxExportPatterns) { nsPtr->maxExportPatterns = nsPtr->maxExportPatterns ? 2 * nsPtr->maxExportPatterns : INIT_EXPORT_PATTERNS; - nsPtr->exportArrayPtr = (char **)ckrealloc(nsPtr->exportArrayPtr, + nsPtr->exportArrayPtr = (char **)Tcl_Realloc(nsPtr->exportArrayPtr, sizeof(char *) * nsPtr->maxExportPatterns); } @@ -1470,7 +1472,7 @@ Tcl_Export( */ len = strlen(pattern); - patternCpy = (char *)ckalloc(len + 1); + patternCpy = (char *)Tcl_Alloc(len + 1); memcpy(patternCpy, pattern, len + 1); nsPtr->exportArrayPtr[nsPtr->numExportPatterns] = patternCpy; @@ -1519,7 +1521,8 @@ Tcl_AppendExportList( * export pattern list is appended. */ { Namespace *nsPtr; - int i, result; + size_t i; + int result; /* * If the specified namespace is NULL, use the current namespace. @@ -1721,7 +1724,7 @@ DoImport( Namespace *importNsPtr, int allowOverwrite) { - int i = 0, exported = 0; + size_t i = 0, exported = 0; Tcl_HashEntry *found; /* @@ -1788,7 +1791,7 @@ DoImport( } } - dataPtr = (ImportedCmdData *)ckalloc(sizeof(ImportedCmdData)); + dataPtr = (ImportedCmdData *)Tcl_Alloc(sizeof(ImportedCmdData)); importedCmd = Tcl_NRCreateCommand(interp, Tcl_DStringValue(&ds), TclInvokeImportedCmd, InvokeImportedNRCmd, dataPtr, DeleteImportedCmd); @@ -1804,7 +1807,7 @@ DoImport( * and add it to the import ref list in the "real" command. */ - refPtr = (ImportRef *)ckalloc(sizeof(ImportRef)); + refPtr = (ImportRef *)Tcl_Alloc(sizeof(ImportRef)); refPtr->importedCmdPtr = (Command *) importedCmd; refPtr->nextPtr = cmdPtr->importRefPtr; cmdPtr->importRefPtr = refPtr; @@ -2101,9 +2104,9 @@ DeleteImportedCmd( } else { prevPtr->nextPtr = refPtr->nextPtr; } - ckfree(refPtr); + Tcl_Free(refPtr); TclCleanupCommandMacro(realCmdPtr); - ckfree(dataPtr); + Tcl_Free(dataPtr); return; } prevPtr = refPtr; @@ -2633,7 +2636,7 @@ Tcl_FindCommand( cmdPtr = NULL; if (cxtNsPtr->commandPathLength!=0 && strncmp(name, "::", 2) && !(flags & TCL_NAMESPACE_ONLY)) { - int i; + size_t i; Namespace *pathNsPtr, *realNsPtr, *dummyNsPtr; (void) TclGetNamespaceForQualName(interp, name, cxtNsPtr, @@ -3003,7 +3006,7 @@ TclInitNamespaceCmd( static int NamespaceChildrenCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -3060,7 +3063,7 @@ NamespaceChildrenCmd( listPtr = Tcl_NewListObj(0, NULL); if ((pattern != NULL) && TclMatchIsTrivial(pattern)) { - unsigned int length = strlen(nsPtr->fullName); + size_t length = strlen(nsPtr->fullName); if (strncmp(pattern, nsPtr->fullName, length) != 0) { goto searchDone; @@ -3132,7 +3135,7 @@ NamespaceChildrenCmd( static int NamespaceCodeCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -3140,7 +3143,7 @@ NamespaceCodeCmd( Namespace *currNsPtr; Tcl_Obj *listPtr, *objPtr; const char *arg; - int length; + size_t length; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "arg"); @@ -3155,7 +3158,7 @@ NamespaceCodeCmd( " "namespace" command. [Bug 3202171]. */ - arg = TclGetStringFromObj(objv[1], &length); + arg = Tcl_GetStringFromObj(objv[1], &length); if (*arg==':' && length > 20 && strncmp(arg, "::namespace inscope ", 20) == 0) { Tcl_SetObjResult(interp, objv[1]); @@ -3213,7 +3216,7 @@ NamespaceCodeCmd( static int NamespaceCurrentCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -3276,7 +3279,7 @@ NamespaceCurrentCmd( static int NamespaceDeleteCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -3364,7 +3367,7 @@ NamespaceEvalCmd( static int NRNamespaceEvalCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -3453,15 +3456,15 @@ NsEval_Callback( Tcl_Namespace *namespacePtr = (Tcl_Namespace *)data[0]; if (result == TCL_ERROR) { - int length = strlen(namespacePtr->fullName); - int limit = 200; + size_t length = strlen(namespacePtr->fullName); + unsigned limit = 200; int overflow = (length > limit); char *cmd = (char *)data[1]; Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (in namespace %s \"%.*s%s\" script line %d)", cmd, - (overflow ? limit : length), namespacePtr->fullName, + (overflow ? limit : (unsigned)length), namespacePtr->fullName, (overflow ? "..." : ""), Tcl_GetErrorLine(interp))); } @@ -3496,7 +3499,7 @@ NsEval_Callback( static int NamespaceExistsCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -3551,7 +3554,7 @@ NamespaceExistsCmd( static int NamespaceExportCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -3582,7 +3585,7 @@ NamespaceExportCmd( */ firstArg = 1; - if (strcmp("-clear", Tcl_GetString(objv[firstArg])) == 0) { + if (strcmp("-clear", TclGetString(objv[firstArg])) == 0) { Tcl_Export(interp, NULL, "::", 1); Tcl_ResetResult(interp); firstArg++; @@ -3593,7 +3596,7 @@ NamespaceExportCmd( */ for (i = firstArg; i < objc; i++) { - int result = Tcl_Export(interp, NULL, Tcl_GetString(objv[i]), 0); + int result = Tcl_Export(interp, NULL, TclGetString(objv[i]), 0); if (result != TCL_OK) { return result; } @@ -3633,7 +3636,7 @@ NamespaceExportCmd( static int NamespaceForgetCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -3698,7 +3701,7 @@ NamespaceForgetCmd( static int NamespaceImportCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -3813,7 +3816,7 @@ NamespaceInscopeCmd( static int NRNamespaceInscopeCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -3910,7 +3913,7 @@ NRNamespaceInscopeCmd( static int NamespaceOriginCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -3970,7 +3973,7 @@ NamespaceOriginCmd( static int NamespaceParentCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -4028,13 +4031,14 @@ NamespaceParentCmd( static int NamespacePathCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Namespace *nsPtr = (Namespace *) TclGetCurrentNamespace(interp); - int i, nsObjc, result = TCL_ERROR; + size_t nsObjc, i; + int result = TCL_ERROR; Tcl_Obj **nsObjv; Tcl_Namespace **namespaceList = NULL; @@ -4072,7 +4076,7 @@ NamespacePathCmd( namespaceList = (Tcl_Namespace **)TclStackAlloc(interp, sizeof(Tcl_Namespace *) * nsObjc); - for (i=0 ; i<nsObjc ; i++) { + for (i = 0; i < nsObjc; i++) { if (TclGetNamespaceFromObj(interp, nsObjv[i], &namespaceList[i]) != TCL_OK) { goto badNamespace; @@ -4117,13 +4121,13 @@ NamespacePathCmd( void TclSetNsPath( Namespace *nsPtr, /* Namespace whose path is to be set. */ - int pathLength, /* Length of pathAry. */ + size_t pathLength, /* Length of pathAry. */ Tcl_Namespace *pathAry[]) /* Array of namespaces that are the path. */ { if (pathLength != 0) { NamespacePathEntry *tmpPathArray = - (NamespacePathEntry *)ckalloc(sizeof(NamespacePathEntry) * pathLength); - int i; + (NamespacePathEntry *)Tcl_Alloc(sizeof(NamespacePathEntry) * pathLength); + size_t i; for (i=0 ; i<pathLength ; i++) { tmpPathArray[i].nsPtr = (Namespace *) pathAry[i]; @@ -4174,7 +4178,7 @@ static void UnlinkNsPath( Namespace *nsPtr) { - int i; + size_t i; for (i=0 ; i<nsPtr->commandPathLength ; i++) { NamespacePathEntry *nsPathPtr = &nsPtr->commandPathArray[i]; @@ -4190,7 +4194,7 @@ UnlinkNsPath( } } } - ckfree(nsPtr->commandPathArray); + Tcl_Free(nsPtr->commandPathArray); } /* @@ -4254,13 +4258,13 @@ TclInvalidateNsPath( static int NamespaceQualifiersCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *name, *p; - int length; + size_t length; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "string"); @@ -4322,7 +4326,7 @@ NamespaceQualifiersCmd( static int NamespaceUnknownCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -4425,7 +4429,7 @@ Tcl_SetNamespaceUnknownHandler( Tcl_Namespace *nsPtr, /* Namespace which is being updated. */ Tcl_Obj *handlerPtr) /* The new handler, or NULL to reset. */ { - int lstlen = 0; + size_t lstlen = 0; Namespace *currNsPtr = (Namespace *) nsPtr; /* @@ -4509,7 +4513,7 @@ Tcl_SetNamespaceUnknownHandler( static int NamespaceTailCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -4567,7 +4571,7 @@ NamespaceTailCmd( static int NamespaceUpvarCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -4641,7 +4645,7 @@ NamespaceUpvarCmd( static int NamespaceWhichCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -4738,7 +4742,7 @@ FreeNsNameInternalRep( */ TclNsDecrRefCount(resNamePtr->nsPtr); - ckfree(resNamePtr); + Tcl_Free(resNamePtr); } } @@ -4825,7 +4829,7 @@ SetNsNameFromAny( */ nsPtr->refCount++; - resNamePtr = (ResolvedNsName *)ckalloc(sizeof(ResolvedNsName)); + resNamePtr = (ResolvedNsName *)Tcl_Alloc(sizeof(ResolvedNsName)); resNamePtr->nsPtr = nsPtr; if ((name[0] == ':') && (name[1] == ':')) { resNamePtr->refNsPtr = NULL; @@ -4885,7 +4889,7 @@ TclGetNamespaceChildTable( return &nPtr->childTable; #else if (nPtr->childTablePtr == NULL) { - nPtr->childTablePtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable)); + nPtr->childTablePtr = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(nPtr->childTablePtr, TCL_STRING_KEYS); } return nPtr->childTablePtr; @@ -4897,11 +4901,11 @@ TclGetNamespaceChildTable( * * TclLogCommandInfo -- * - * This function is invoked after an error occurs in an interpreter. It - * adds information to iPtr->errorInfo/errorStack fields to describe the + * Invoked after an error occurs in an interpreter. + * Adds information to iPtr->errorInfo/errorStack fields to describe the * command that was being executed when the error occurred. When pc and * tosPtr are non-NULL, conveying a bytecode execution "inner context", - * and the offending instruction is suitable, that inner context is + * and the offending instruction is suitable, and that inner context is * recorded in errorStack. * * Results: @@ -4921,7 +4925,7 @@ TclLogCommandInfo( * command (must be <= command). */ const char *command, /* First character in command that generated * the error. */ - int length, /* Number of bytes in command (TCL_INDEX_NONE + size_t length, /* Number of bytes in command (TCL_INDEX_NONE * means use all bytes up to first null byte). */ const unsigned char *pc, /* Current pc of bytecode execution context */ @@ -4935,8 +4939,8 @@ TclLogCommandInfo( if (iPtr->flags & ERR_ALREADY_LOGGED) { /* - * Someone else has already logged error information for this command; - * we shouldn't add anything more. + * Someone else has already logged error information for this command. + * Don't add anything more. */ return; @@ -4954,14 +4958,14 @@ TclLogCommandInfo( } } - if (length < 0) { + if (length == TCL_INDEX_NONE) { length = strlen(command); } - overflow = (length > limit); + overflow = (length > (size_t)limit); Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n %s\n\"%.*s%s\"", ((iPtr->errorInfo == NULL) ? "while executing" : "invoked from within"), - (overflow ? limit : length), command, + (overflow ? limit : (int)length), command, (overflow ? "..." : ""))); varPtr = TclObjLookupVarEx(interp, iPtr->eiVar, NULL, TCL_GLOBAL_ONLY, @@ -4974,7 +4978,7 @@ TclLogCommandInfo( return; } else { Tcl_HashEntry *hPtr - = Tcl_FindHashEntry(&iPtr->varTraces, (char *) varPtr); + = Tcl_FindHashEntry(&iPtr->varTraces, varPtr); VarTrace *tracePtr = (VarTrace *)Tcl_GetHashValue(hPtr); if (tracePtr->traceProc != EstablishErrorInfoTraces) { @@ -5007,7 +5011,7 @@ TclLogCommandInfo( iPtr->errorStack = newObj; } if (iPtr->resetErrorStack) { - int len; + size_t len; iPtr->resetErrorStack = 0; TclListObjLengthM(interp, iPtr->errorStack, &len); @@ -5045,7 +5049,7 @@ TclLogCommandInfo( Tcl_ListObjAppendElement(NULL, iPtr->errorStack, iPtr->upLiteral); Tcl_ListObjAppendElement(NULL, iPtr->errorStack, Tcl_NewWideIntObj( - iPtr->framePtr->level - iPtr->varFramePtr->level)); + (int)(iPtr->framePtr->level - iPtr->varFramePtr->level))); } else if (iPtr->framePtr != iPtr->rootFramePtr) { /* * normal case, [lappend errorstack CALL [info level 0]] @@ -5079,7 +5083,7 @@ void TclErrorStackResetIf( Tcl_Interp *interp, const char *msg, - int length) + size_t length) { Interp *iPtr = (Interp *) interp; @@ -5092,7 +5096,7 @@ TclErrorStackResetIf( iPtr->errorStack = newObj; } if (iPtr->resetErrorStack) { - int len; + size_t len; iPtr->resetErrorStack = 0; TclListObjLengthM(interp, iPtr->errorStack, &len); @@ -5134,7 +5138,7 @@ Tcl_LogCommandInfo( * command (must be <= command). */ const char *command, /* First character in command that generated * the error. */ - int length) /* Number of bytes in command (-1 means use + size_t 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 e17819e..24aa5cc 100644 --- a/generic/tclNotify.c +++ b/generic/tclNotify.c @@ -35,7 +35,7 @@ static Tcl_NotifierProcs tclNotifierHooks = { typedef struct EventSource { Tcl_EventSetupProc *setupProc; Tcl_EventCheckProc *checkProc; - ClientData clientData; + void *clientData; struct EventSource *nextPtr; } EventSource; @@ -71,7 +71,7 @@ typedef struct ThreadSpecificData { /* Pointer to first event source in list of * event sources for this thread. */ Tcl_ThreadId threadId; /* Thread that owns this notifier instance. */ - ClientData clientData; /* Opaque handle for platform specific + void *clientData; /* Opaque handle for platform specific * notifier. */ int initialized; /* 1 if notifier has been initialized. */ struct ThreadSpecificData *nextPtr; @@ -182,7 +182,7 @@ TclFinalizeNotifier(void) for (evPtr = tsdPtr->firstEventPtr; evPtr != NULL; ) { hold = evPtr; evPtr = evPtr->nextPtr; - ckfree(hold); + Tcl_Free(hold); } tsdPtr->firstEventPtr = NULL; tsdPtr->lastEventPtr = NULL; @@ -288,7 +288,7 @@ Tcl_SetNotifier( * Tcl_QueueEvent to queue any events that are ready. * * Each of these functions is passed two arguments, e.g. - * (*checkProc)(ClientData clientData, int flags)); + * (*checkProc)(void *clientData, int flags)); * ClientData is the same as the clientData argument here, and flags is a * combination of things like TCL_FILE_EVENTS that indicates what events * are of interest: setupProc and checkProc use flags to figure out @@ -305,11 +305,11 @@ Tcl_CreateEventSource( Tcl_EventCheckProc *checkProc, /* Function to call after waiting to see what * happened. */ - ClientData clientData) /* One-word argument to pass to setupProc and + void *clientData) /* One-word argument to pass to setupProc and * checkProc. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - EventSource *sourcePtr = (EventSource *)ckalloc(sizeof(EventSource)); + EventSource *sourcePtr = (EventSource *)Tcl_Alloc(sizeof(EventSource)); sourcePtr->setupProc = setupProc; sourcePtr->checkProc = checkProc; @@ -344,7 +344,7 @@ Tcl_DeleteEventSource( Tcl_EventCheckProc *checkProc, /* Function to call after waiting to see what * happened. */ - ClientData clientData) /* One-word argument to pass to setupProc and + void *clientData) /* One-word argument to pass to setupProc and * checkProc. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -363,7 +363,7 @@ Tcl_DeleteEventSource( } else { prevPtr->nextPtr = sourcePtr->nextPtr; } - ckfree(sourcePtr); + Tcl_Free(sourcePtr); return; } } @@ -388,7 +388,7 @@ void Tcl_QueueEvent( Tcl_Event *evPtr, /* Event to add to queue. The storage space * must have been allocated the caller with - * malloc (ckalloc), and it becomes the + * malloc (Tcl_Alloc), and it becomes the * property of the event queue. It will be * freed after the event has been handled. */ int position) /* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD, TCL_QUEUE_MARK, @@ -420,7 +420,7 @@ Tcl_ThreadQueueEvent( Tcl_ThreadId threadId, /* Identifier for thread to use. */ Tcl_Event *evPtr, /* Event to add to queue. The storage space * must have been allocated the caller with - * malloc (ckalloc), and it becomes the + * malloc (Tcl_Alloc), and it becomes the * property of the event queue. It will be * freed after the event has been handled. */ int position) /* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD, TCL_QUEUE_MARK, @@ -447,7 +447,7 @@ Tcl_ThreadQueueEvent( Tcl_AlertNotifier(tsdPtr->clientData); } } else { - ckfree(evPtr); + Tcl_Free(evPtr); } Tcl_MutexUnlock(&listLock); } @@ -480,7 +480,7 @@ QueueEvent( * which event queue to use. */ Tcl_Event *evPtr, /* Event to add to queue. The storage space * must have been allocated the caller with - * malloc (ckalloc), and it becomes the + * malloc (Tcl_Alloc), and it becomes the * property of the event queue. It will be * freed after the event has been handled. */ int position) /* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD, TCL_QUEUE_MARK, @@ -556,7 +556,7 @@ QueueEvent( void Tcl_DeleteEvents( Tcl_EventDeleteProc *proc, /* The function to call. */ - ClientData clientData) /* The type-specific data. */ + void *clientData) /* The type-specific data. */ { Tcl_Event *evPtr; /* Pointer to the event being examined */ Tcl_Event *prevPtr; /* Pointer to evPtr's predecessor, or NULL if @@ -603,7 +603,7 @@ Tcl_DeleteEvents( hold = evPtr; evPtr = evPtr->nextPtr; - ckfree(hold); + Tcl_Free(hold); } else { /* * Event is to be retained. @@ -742,7 +742,7 @@ Tcl_ServiceEvent( } } if (evPtr) { - ckfree(evPtr); + Tcl_Free(evPtr); } Tcl_MutexUnlock(&(tsdPtr->queueMutex)); return 1; @@ -1189,7 +1189,7 @@ Tcl_ThreadAlert( *---------------------------------------------------------------------- */ -ClientData +void * Tcl_InitNotifier(void) { if (tclNotifierHooks.initNotifierProc) { @@ -1220,7 +1220,7 @@ Tcl_InitNotifier(void) void Tcl_FinalizeNotifier( - ClientData clientData) + void *clientData) { if (tclNotifierHooks.finalizeNotifierProc) { tclNotifierHooks.finalizeNotifierProc(clientData); @@ -1253,7 +1253,7 @@ Tcl_FinalizeNotifier( void Tcl_AlertNotifier( - ClientData clientData) /* Pointer to thread data. */ + void *clientData) /* Pointer to thread data. */ { if (tclNotifierHooks.alertNotifierProc) { tclNotifierHooks.alertNotifierProc(clientData); @@ -1380,7 +1380,7 @@ Tcl_CreateFileHandler( * called. */ Tcl_FileProc *proc, /* Function to call for each selected * event. */ - ClientData clientData) /* Arbitrary data to pass to proc. */ + void *clientData) /* Arbitrary data to pass to proc. */ { if (tclNotifierHooks.createFileHandlerProc) { tclNotifierHooks.createFileHandlerProc(fd, mask, proc, clientData); diff --git a/generic/tclOO.c b/generic/tclOO.c index 5bd687a..0d9c7da 100644 --- a/generic/tclOO.c +++ b/generic/tclOO.c @@ -304,11 +304,11 @@ InitFoundation( static Tcl_ThreadDataKey tsdKey; ThreadLocalData *tsdPtr = (ThreadLocalData *)Tcl_GetThreadData(&tsdKey, sizeof(ThreadLocalData)); - Foundation *fPtr = (Foundation *)ckalloc(sizeof(Foundation)); + Foundation *fPtr = (Foundation *)Tcl_Alloc(sizeof(Foundation)); Tcl_Obj *namePtr; Tcl_DString buffer; Command *cmdPtr; - int i; + size_t i; /* * Initialize the structure that holds the OO system core. This is @@ -327,7 +327,7 @@ InitFoundation( DeletedObjdefNamespace); fPtr->helpersNs = Tcl_CreateNamespace(interp, "::oo::Helpers", fPtr, DeletedHelpersNamespace); - fPtr->epoch = 0; + fPtr->epoch = 1; fPtr->tsdPtr = tsdPtr; TclNewLiteralStringObj(fPtr->unknownMethodNameObj, "unknown"); TclNewLiteralStringObj(fPtr->constructorName, "<constructor>"); @@ -469,7 +469,7 @@ InitClassSystemRoots( */ fPtr->objectCls->superclasses.num = 0; - ckfree(fPtr->objectCls->superclasses.list); + Tcl_Free(fPtr->objectCls->superclasses.list); fPtr->objectCls->superclasses.list = NULL; /* @@ -587,7 +587,7 @@ KillFoundation( TclOODecrRefCount(fPtr->objectCls->thisPtr); TclOODecrRefCount(fPtr->classCls->thisPtr); - ckfree(fPtr); + Tcl_Free(fPtr); } /* @@ -625,9 +625,9 @@ AllocObject( Object *oPtr; Command *cmdPtr; CommandTrace *tracePtr; - int creationEpoch; + size_t creationEpoch; - oPtr = (Object *)ckalloc(sizeof(Object)); + oPtr = (Object *)Tcl_Alloc(sizeof(Object)); memset(oPtr, 0, sizeof(Object)); /* @@ -654,7 +654,7 @@ AllocObject( while (1) { char objName[10 + TCL_INTEGER_SPACE]; - sprintf(objName, "::oo::Obj%d", ++fPtr->tsdPtr->nsCount); + sprintf(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; @@ -738,7 +738,7 @@ AllocObject( cmdPtr = (Command *) oPtr->command; cmdPtr->nreProc = PublicNRObjectCmd; - cmdPtr->tracePtr = tracePtr = (CommandTrace *)ckalloc(sizeof(CommandTrace)); + cmdPtr->tracePtr = tracePtr = (CommandTrace *)Tcl_Alloc(sizeof(CommandTrace)); tracePtr->traceProc = ObjectRenamedTrace; tracePtr->clientData = oPtr; tracePtr->flags = TCL_TRACE_RENAME|TCL_TRACE_DELETE; @@ -892,7 +892,7 @@ TclOODeleteDescendants( } } if (clsPtr->mixinSubs.size > 0) { - ckfree(clsPtr->mixinSubs.list); + Tcl_Free(clsPtr->mixinSubs.list); clsPtr->mixinSubs.size = 0; } @@ -912,7 +912,7 @@ TclOODeleteDescendants( } } if (clsPtr->subclasses.size > 0) { - ckfree(clsPtr->subclasses.list); + Tcl_Free(clsPtr->subclasses.list); clsPtr->subclasses.list = NULL; clsPtr->subclasses.size = 0; } @@ -937,7 +937,7 @@ TclOODeleteDescendants( } } if (clsPtr->instances.size > 0) { - ckfree(clsPtr->instances.list); + Tcl_Free(clsPtr->instances.list); clsPtr->instances.list = NULL; clsPtr->instances.size = 0; } @@ -960,7 +960,7 @@ TclOOReleaseClassContents( Object *oPtr) /* The object representing the class. */ { FOREACH_HASH_DECLS; - int i; + size_t i; Class *clsPtr = oPtr->classPtr, *tmpClsPtr; Method *mPtr; Foundation *fPtr = oPtr->fPtr; @@ -1013,7 +1013,7 @@ TclOOReleaseClassContents( TclOODeleteChain(callPtr); } Tcl_DeleteHashTable(clsPtr->classChainCache); - ckfree(clsPtr->classChainCache); + Tcl_Free(clsPtr->classChainCache); clsPtr->classChainCache = NULL; } @@ -1027,7 +1027,7 @@ TclOOReleaseClassContents( FOREACH(filterObj, clsPtr->filters) { TclDecrRefCount(filterObj); } - ckfree(clsPtr->filters.list); + Tcl_Free(clsPtr->filters.list); clsPtr->filters.list = NULL; clsPtr->filters.num = 0; } @@ -1044,7 +1044,7 @@ TclOOReleaseClassContents( metadataTypePtr->deleteProc(value); } Tcl_DeleteHashTable(clsPtr->metadataPtr); - ckfree(clsPtr->metadataPtr); + Tcl_Free(clsPtr->metadataPtr); clsPtr->metadataPtr = NULL; } @@ -1053,7 +1053,7 @@ TclOOReleaseClassContents( TclOORemoveFromMixinSubs(clsPtr, tmpClsPtr); TclOODecrRefCount(tmpClsPtr->thisPtr); } - ckfree(clsPtr->mixins.list); + Tcl_Free(clsPtr->mixins.list); clsPtr->mixins.list = NULL; clsPtr->mixins.num = 0; } @@ -1063,7 +1063,7 @@ TclOOReleaseClassContents( TclOORemoveFromSubclasses(clsPtr, tmpClsPtr); TclOODecrRefCount(tmpClsPtr->thisPtr); } - ckfree(clsPtr->superclasses.list); + Tcl_Free(clsPtr->superclasses.list); clsPtr->superclasses.num = 0; clsPtr->superclasses.list = NULL; } @@ -1079,7 +1079,7 @@ TclOOReleaseClassContents( TclDecrRefCount(variableObj); } if (i) { - ckfree(clsPtr->variables.list); + Tcl_Free(clsPtr->variables.list); } FOREACH_STRUCT(privateVariable, clsPtr->privateVariables) { @@ -1087,7 +1087,7 @@ TclOOReleaseClassContents( TclDecrRefCount(privateVariable->fullNameObj); } if (i) { - ckfree(clsPtr->privateVariables.list); + Tcl_Free(clsPtr->privateVariables.list); } if (IsRootClass(oPtr) && !Destructing(fPtr->objectCls->thisPtr)) { @@ -1121,7 +1121,7 @@ ObjectNamespaceDeleted( Tcl_Obj *filterObj, *variableObj; PrivateVariableMapping *privateVariable; Tcl_Interp *interp = oPtr->fPtr->interp; - int i; + size_t i; if (Destructing(oPtr)) { /* @@ -1219,7 +1219,7 @@ ObjectNamespaceDeleted( TclOODecrRefCount(mixinPtr->thisPtr); } if (oPtr->mixins.list != NULL) { - ckfree(oPtr->mixins.list); + Tcl_Free(oPtr->mixins.list); } } @@ -1227,7 +1227,7 @@ ObjectNamespaceDeleted( TclDecrRefCount(filterObj); } if (i) { - ckfree(oPtr->filters.list); + Tcl_Free(oPtr->filters.list); } if (oPtr->methodsPtr) { @@ -1235,14 +1235,14 @@ ObjectNamespaceDeleted( TclOODelMethodRef(mPtr); } Tcl_DeleteHashTable(oPtr->methodsPtr); - ckfree(oPtr->methodsPtr); + Tcl_Free(oPtr->methodsPtr); } FOREACH(variableObj, oPtr->variables) { TclDecrRefCount(variableObj); } if (i) { - ckfree(oPtr->variables.list); + Tcl_Free(oPtr->variables.list); } FOREACH_STRUCT(privateVariable, oPtr->privateVariables) { @@ -1250,7 +1250,7 @@ ObjectNamespaceDeleted( TclDecrRefCount(privateVariable->fullNameObj); } if (i) { - ckfree(oPtr->privateVariables.list); + Tcl_Free(oPtr->privateVariables.list); } if (oPtr->chainCache) { @@ -1267,7 +1267,7 @@ ObjectNamespaceDeleted( metadataTypePtr->deleteProc(value); } Tcl_DeleteHashTable(oPtr->metadataPtr); - ckfree(oPtr->metadataPtr); + Tcl_Free(oPtr->metadataPtr); oPtr->metadataPtr = NULL; } @@ -1323,9 +1323,9 @@ TclOODecrRefCount( if (oPtr->refCount-- <= 1) { if (oPtr->classPtr != NULL) { - ckfree(oPtr->classPtr); + Tcl_Free(oPtr->classPtr); } - ckfree(oPtr); + Tcl_Free(oPtr); return 1; } return 0; @@ -1362,7 +1362,8 @@ TclOORemoveFromInstances( Class *clsPtr) /* The class (possibly) containing the * reference to the instance. */ { - int i, res = 0; + size_t i; + int res = 0; Object *instPtr; FOREACH(instPtr, clsPtr->instances) { @@ -1397,9 +1398,9 @@ TclOOAddToInstances( if (clsPtr->instances.num >= clsPtr->instances.size) { clsPtr->instances.size += ALLOC_CHUNK; if (clsPtr->instances.size == ALLOC_CHUNK) { - clsPtr->instances.list = (Object **)ckalloc(sizeof(Object *) * ALLOC_CHUNK); + clsPtr->instances.list = (Object **)Tcl_Alloc(sizeof(Object *) * ALLOC_CHUNK); } else { - clsPtr->instances.list = (Object **)ckrealloc(clsPtr->instances.list, + clsPtr->instances.list = (Object **)Tcl_Realloc(clsPtr->instances.list, sizeof(Object *) * clsPtr->instances.size); } } @@ -1424,7 +1425,8 @@ TclOORemoveFromMixins( Object *oPtr) /* The object (possibly) containing the * reference to the mixin. */ { - int i, res = 0; + size_t i; + int res = 0; Class *mixPtr; FOREACH(mixPtr, oPtr->mixins) { @@ -1436,7 +1438,7 @@ TclOORemoveFromMixins( } } if (oPtr->mixins.num == 0) { - ckfree(oPtr->mixins.list); + Tcl_Free(oPtr->mixins.list); oPtr->mixins.list = NULL; } return res; @@ -1459,7 +1461,8 @@ TclOORemoveFromSubclasses( Class *superPtr) /* The superclass to possibly remove the * subclass reference from. */ { - int i, res = 0; + size_t i; + int res = 0; Class *subclsPtr; FOREACH(subclsPtr, superPtr->subclasses) { @@ -1496,9 +1499,9 @@ TclOOAddToSubclasses( if (superPtr->subclasses.num >= superPtr->subclasses.size) { superPtr->subclasses.size += ALLOC_CHUNK; if (superPtr->subclasses.size == ALLOC_CHUNK) { - superPtr->subclasses.list = (Class **)ckalloc(sizeof(Class *) * ALLOC_CHUNK); + superPtr->subclasses.list = (Class **)Tcl_Alloc(sizeof(Class *) * ALLOC_CHUNK); } else { - superPtr->subclasses.list = (Class **)ckrealloc(superPtr->subclasses.list, + superPtr->subclasses.list = (Class **)Tcl_Realloc(superPtr->subclasses.list, sizeof(Class *) * superPtr->subclasses.size); } } @@ -1523,7 +1526,8 @@ TclOORemoveFromMixinSubs( Class *superPtr) /* The superclass to possibly remove the * subclass reference from. */ { - int i, res = 0; + size_t i; + int res = 0; Class *subclsPtr; FOREACH(subclsPtr, superPtr->mixinSubs) { @@ -1561,9 +1565,9 @@ TclOOAddToMixinSubs( if (superPtr->mixinSubs.num >= superPtr->mixinSubs.size) { superPtr->mixinSubs.size += ALLOC_CHUNK; if (superPtr->mixinSubs.size == ALLOC_CHUNK) { - superPtr->mixinSubs.list = (Class **)ckalloc(sizeof(Class *) * ALLOC_CHUNK); + superPtr->mixinSubs.list = (Class **)Tcl_Alloc(sizeof(Class *) * ALLOC_CHUNK); } else { - superPtr->mixinSubs.list = (Class **)ckrealloc(superPtr->mixinSubs.list, + superPtr->mixinSubs.list = (Class **)Tcl_Realloc(superPtr->mixinSubs.list, sizeof(Class *) * superPtr->mixinSubs.size); } } @@ -1609,7 +1613,7 @@ TclOOAllocClass( * representation. */ { Foundation *fPtr = GetFoundation(interp); - Class *clsPtr = (Class *)ckalloc(sizeof(Class)); + Class *clsPtr = (Class *)Tcl_Alloc(sizeof(Class)); memset(clsPtr, 0, sizeof(Class)); clsPtr->thisPtr = useThisObj; @@ -1626,7 +1630,7 @@ TclOOAllocClass( */ clsPtr->superclasses.num = 1; - clsPtr->superclasses.list = (Class **)ckalloc(sizeof(Class *)); + clsPtr->superclasses.list = (Class **)Tcl_Alloc(sizeof(Class *)); clsPtr->superclasses.list[0] = fPtr->objectCls; AddRef(fPtr->objectCls->thisPtr); @@ -1663,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. */ - int objc, /* Number of arguments. Negative value means + size_t objc, /* Number of arguments. Negative value means * do not call constructor. */ Tcl_Obj *const *objv, /* Argument list. */ - int skip) /* Number of arguments to _not_ pass to the + size_t skip) /* Number of arguments to _not_ pass to the * constructor. */ { Class *classPtr = (Class *) cls; @@ -1683,7 +1687,7 @@ Tcl_NewObjectInstance( * used for object cloning only. */ - if (objc >= 0) { + if (objc != TCL_INDEX_NONE) { CallContext *contextPtr = TclOOGetCallContext(oPtr, NULL, CONSTRUCTOR, NULL, NULL, NULL); @@ -1731,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. */ - int objc, /* Number of arguments. Negative value means + size_t objc, /* Number of arguments. Negative value means * do not call constructor. */ Tcl_Obj *const *objv, /* Argument list. */ - int skip, /* Number of arguments to _not_ pass to the + size_t skip, /* Number of arguments to _not_ pass to the * constructor. */ Tcl_Object *objectPtr) /* Place to write the object reference upon * successful allocation. */ @@ -1750,11 +1754,11 @@ TclNRNewObjectInstance( } /* - * Run constructors, except when objc < 0 (a special flag case used for + * Run constructors, except when objc == TCL_INDEX_NONE (a special flag case used for * object cloning only). If there aren't any constructors, we do nothing. */ - if (objc < 0) { + if (objc == TCL_INDEX_NONE) { *objectPtr = (Tcl_Object) oPtr; return TCL_OK; } @@ -1928,7 +1932,8 @@ Tcl_CopyObjectInstance( CallContext *contextPtr; Tcl_Obj *keyPtr, *filterObj, *variableObj, *args[3]; PrivateVariableMapping *privateVariable; - int i, result; + size_t i; + int result; /* * Sanity check. @@ -1976,7 +1981,7 @@ Tcl_CopyObjectInstance( } TclOODecrRefCount(mixinPtr->thisPtr); } - ckfree(o2Ptr->mixins.list); + Tcl_Free(o2Ptr->mixins.list); } DUPLICATE(o2Ptr->mixins, oPtr->mixins, Class *); FOREACH(mixinPtr, o2Ptr->mixins) { @@ -2077,11 +2082,11 @@ Tcl_CopyObjectInstance( TclOODecrRefCount(superPtr->thisPtr); } if (cls2Ptr->superclasses.num) { - cls2Ptr->superclasses.list = (Class **) ckrealloc(cls2Ptr->superclasses.list, + cls2Ptr->superclasses.list = (Class **)Tcl_Realloc(cls2Ptr->superclasses.list, sizeof(Class *) * clsPtr->superclasses.num); } else { cls2Ptr->superclasses.list = - (Class **)ckalloc(sizeof(Class *) * clsPtr->superclasses.num); + (Class **)Tcl_Alloc(sizeof(Class *) * clsPtr->superclasses.num); } memcpy(cls2Ptr->superclasses.list, clsPtr->superclasses.list, sizeof(Class *) * clsPtr->superclasses.num); @@ -2132,7 +2137,7 @@ Tcl_CopyObjectInstance( TclOORemoveFromMixinSubs(cls2Ptr, mixinPtr); TclOODecrRefCount(mixinPtr->thisPtr); } - ckfree(clsPtr->mixins.list); + Tcl_Free(clsPtr->mixins.list); } DUPLICATE(cls2Ptr->mixins, clsPtr->mixins, Class *); FOREACH(mixinPtr, cls2Ptr->mixins) { @@ -2345,7 +2350,7 @@ Tcl_ClassGetMetadata( * There is a metadata store, so look in it for the given type. */ - hPtr = Tcl_FindHashEntry(clsPtr->metadataPtr, (char *) typePtr); + hPtr = Tcl_FindHashEntry(clsPtr->metadataPtr, typePtr); /* * Return the metadata value if we found it, otherwise NULL. @@ -2375,7 +2380,7 @@ Tcl_ClassSetMetadata( if (metadata == NULL) { return; } - clsPtr->metadataPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable)); + clsPtr->metadataPtr = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(clsPtr->metadataPtr, TCL_ONE_WORD_KEYS); } @@ -2384,7 +2389,7 @@ Tcl_ClassSetMetadata( */ if (metadata == NULL) { - hPtr = Tcl_FindHashEntry(clsPtr->metadataPtr, (char *) typePtr); + hPtr = Tcl_FindHashEntry(clsPtr->metadataPtr, typePtr); if (hPtr != NULL) { typePtr->deleteProc(Tcl_GetHashValue(hPtr)); Tcl_DeleteHashEntry(hPtr); @@ -2397,7 +2402,7 @@ Tcl_ClassSetMetadata( * some metadata attached of this type, we delete that first. */ - hPtr = Tcl_CreateHashEntry(clsPtr->metadataPtr, (char *) typePtr, &isNew); + hPtr = Tcl_CreateHashEntry(clsPtr->metadataPtr, typePtr, &isNew); if (!isNew) { typePtr->deleteProc(Tcl_GetHashValue(hPtr)); } @@ -2425,7 +2430,7 @@ Tcl_ObjectGetMetadata( * There is a metadata store, so look in it for the given type. */ - hPtr = Tcl_FindHashEntry(oPtr->metadataPtr, (char *) typePtr); + hPtr = Tcl_FindHashEntry(oPtr->metadataPtr, typePtr); /* * Return the metadata value if we found it, otherwise NULL. @@ -2455,7 +2460,7 @@ Tcl_ObjectSetMetadata( if (metadata == NULL) { return; } - oPtr->metadataPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable)); + oPtr->metadataPtr = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(oPtr->metadataPtr, TCL_ONE_WORD_KEYS); } @@ -2464,7 +2469,7 @@ Tcl_ObjectSetMetadata( */ if (metadata == NULL) { - hPtr = Tcl_FindHashEntry(oPtr->metadataPtr, (char *) typePtr); + hPtr = Tcl_FindHashEntry(oPtr->metadataPtr, typePtr); if (hPtr != NULL) { typePtr->deleteProc(Tcl_GetHashValue(hPtr)); Tcl_DeleteHashEntry(hPtr); @@ -2477,7 +2482,7 @@ Tcl_ObjectSetMetadata( * some metadata attached of this type, we delete that first. */ - hPtr = Tcl_CreateHashEntry(oPtr->metadataPtr, (char *) typePtr, &isNew); + hPtr = Tcl_CreateHashEntry(oPtr->metadataPtr, typePtr, &isNew); if (!isNew) { typePtr->deleteProc(Tcl_GetHashValue(hPtr)); } @@ -2551,7 +2556,7 @@ TclOOInvokeObject( * (PRIVATE_METHOD), or a *really* private * context (any other value; conventionally * 0). */ - int objc, /* Number of arguments. */ + size_t 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. */ @@ -2622,7 +2627,7 @@ int TclOOObjectCmdCore( Object *oPtr, /* The object being invoked. */ Tcl_Interp *interp, /* The interpreter containing the object. */ - int objc, /* How many arguments are being passed in. */ + size_t 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. */ @@ -2643,7 +2648,7 @@ TclOOObjectCmdCore( * processing. */ - if (objc < 2) { + if (objc + 1 < 3) { flags |= FORCE_UNKNOWN; methodNamePtr = NULL; goto noMapping; @@ -2794,13 +2799,13 @@ int Tcl_ObjectContextInvokeNext( Tcl_Interp *interp, Tcl_ObjectContext context, - int objc, + size_t objc, Tcl_Obj *const *objv, - int skip) + size_t skip) { CallContext *contextPtr = (CallContext *) context; - int savedIndex = contextPtr->index; - int savedSkip = contextPtr->skip; + size_t savedIndex = contextPtr->index; + size_t savedSkip = contextPtr->skip; int result; if (contextPtr->index + 1 >= contextPtr->callPtr->numChain) { @@ -2866,9 +2871,9 @@ int TclNRObjectContextInvokeNext( Tcl_Interp *interp, Tcl_ObjectContext context, - int objc, + size_t objc, Tcl_Obj *const *objv, - int skip) + size_t skip) { CallContext *contextPtr = (CallContext *) context; @@ -2995,7 +3000,7 @@ TclOOIsReachable( Class *targetPtr, Class *startPtr) { - int i; + size_t i; Class *superPtr; tailRecurse: @@ -3088,7 +3093,7 @@ Tcl_ObjectContextObject( return (Tcl_Object) ((CallContext *)context)->oPtr; } -int +size_t Tcl_ObjectContextSkippedArgs( Tcl_ObjectContext context) { diff --git a/generic/tclOO.decls b/generic/tclOO.decls index c933872..3783adf 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, int objc, - Tcl_Obj *const *objv, int skip) + const char *nameStr, const char *nsNameStr, size_t objc, + Tcl_Obj *const *objv, size_t skip) } declare 14 { int Tcl_ObjectDeleted(Tcl_Object object) @@ -84,7 +84,7 @@ declare 17 { Tcl_Object Tcl_ObjectContextObject(Tcl_ObjectContext context) } declare 18 { - int Tcl_ObjectContextSkippedArgs(Tcl_ObjectContext context) + size_t 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, int objc, Tcl_Obj *const *objv, - int skip) + Tcl_ObjectContext context, size_t objc, Tcl_Obj *const *objv, + size_t skip) } declare 24 { Tcl_ObjectMapMethodNameProc *Tcl_ObjectGetMethodNameMapper( @@ -184,7 +184,7 @@ declare 4 { ProcedureMethod **pmPtrPtr) } declare 5 { - int TclOOObjectCmdCore(Object *oPtr, Tcl_Interp *interp, int objc, + int TclOOObjectCmdCore(Object *oPtr, Tcl_Interp *interp, size_t 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, int objc, + Tcl_Class startCls, int publicPrivate, size_t objc, Tcl_Obj *const *objv) } declare 12 { - void TclOOObjectSetFilters(Object *oPtr, int numFilters, + void TclOOObjectSetFilters(Object *oPtr, size_t numFilters, Tcl_Obj *const *filters) } declare 13 { void TclOOClassSetFilters(Tcl_Interp *interp, Class *classPtr, - int numFilters, Tcl_Obj *const *filters) + size_t numFilters, Tcl_Obj *const *filters) } declare 14 { - void TclOOObjectSetMixins(Object *oPtr, int numMixins, + void TclOOObjectSetMixins(Object *oPtr, size_t numMixins, Class *const *mixins) } declare 15 { void TclOOClassSetMixins(Tcl_Interp *interp, Class *classPtr, - int numMixins, Class *const *mixins) + size_t numMixins, Class *const *mixins) } return diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c index 3593193..ef554d7 100644 --- a/generic/tclOOBasic.c +++ b/generic/tclOOBasic.c @@ -15,6 +15,7 @@ #endif #include "tclInt.h" #include "tclOOInt.h" +#include "tclTomMath.h" static inline Tcl_Object *AddConstructionFinalizer(Tcl_Interp *interp); static Tcl_NRPostProc AfterNRDestructor; @@ -76,7 +77,7 @@ FinalizeConstruction( int TclOO_Class_Constructor( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, Tcl_ObjectContext context, int objc, @@ -85,11 +86,11 @@ TclOO_Class_Constructor( Object *oPtr = (Object *) Tcl_ObjectContextObject(context); Tcl_Obj **invoke, *nameObj; - if (objc-1 > Tcl_ObjectContextSkippedArgs(context)) { + if (objc-1 > (int)Tcl_ObjectContextSkippedArgs(context)) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, "?definitionScript?"); return TCL_ERROR; - } else if (objc == Tcl_ObjectContextSkippedArgs(context)) { + } else if (objc == (int)Tcl_ObjectContextSkippedArgs(context)) { return TCL_OK; } @@ -108,7 +109,7 @@ TclOO_Class_Constructor( * Delegate to [oo::define] to do the work. */ - invoke = (Tcl_Obj **)ckalloc(3 * sizeof(Tcl_Obj *)); + invoke = (Tcl_Obj **)Tcl_Alloc(3 * sizeof(Tcl_Obj *)); invoke[0] = oPtr->fPtr->defineName; invoke[1] = TclOOObjectName(interp, oPtr); invoke[2] = objv[objc-1]; @@ -154,7 +155,7 @@ DecrRefsPostClassConstructor( code = Tcl_EvalObjv(interp, 2, invoke, 0); TclDecrRefCount(invoke[0]); TclDecrRefCount(invoke[1]); - ckfree(invoke); + Tcl_Free(invoke); if (code != TCL_OK) { Tcl_DiscardInterpState(saved); return code; @@ -174,7 +175,7 @@ DecrRefsPostClassConstructor( int TclOO_Class_Create( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Interpreter in which to create the object; * also used for error reporting. */ Tcl_ObjectContext context, /* The object/call context. */ @@ -183,7 +184,7 @@ TclOO_Class_Create( { Object *oPtr = (Object *) Tcl_ObjectContextObject(context); const char *objName; - int len; + size_t len; /* * Sanity check; should not be possible to invoke this method on a @@ -239,7 +240,7 @@ TclOO_Class_Create( int TclOO_Class_CreateNs( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Interpreter in which to create the object; * also used for error reporting. */ Tcl_ObjectContext context, /* The object/call context. */ @@ -248,7 +249,7 @@ TclOO_Class_CreateNs( { Object *oPtr = (Object *) Tcl_ObjectContextObject(context); const char *objName, *nsName; - int len; + size_t len; /* * Sanity check; should not be possible to invoke this method on a @@ -312,7 +313,7 @@ TclOO_Class_CreateNs( int TclOO_Class_New( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Interpreter in which to create the object; * also used for error reporting. */ Tcl_ObjectContext context, /* The object/call context. */ @@ -356,7 +357,7 @@ TclOO_Class_New( int TclOO_Object_Destroy( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Interpreter in which to create the object; * also used for error reporting. */ Tcl_ObjectContext context, /* The object/call context. */ @@ -366,7 +367,7 @@ TclOO_Object_Destroy( Object *oPtr = (Object *) Tcl_ObjectContextObject(context); CallContext *contextPtr; - if (objc != Tcl_ObjectContextSkippedArgs(context)) { + if (objc != (int)Tcl_ObjectContextSkippedArgs(context)) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, NULL); return TCL_ERROR; @@ -417,7 +418,7 @@ AfterNRDestructor( int TclOO_Object_Eval( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Interpreter in which to create the object; * also used for error reporting. */ Tcl_ObjectContext context, /* The object/call context. */ @@ -518,7 +519,7 @@ FinalizeEval( int TclOO_Object_Unknown( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Interpreter in which to create the object; * also used for error reporting. */ Tcl_ObjectContext context, /* The object/call context. */ @@ -605,7 +606,7 @@ TclOO_Object_Unknown( Tcl_AppendToObj(errorMsg, " or ", -1); } Tcl_AppendToObj(errorMsg, methodNames[i], -1); - ckfree(methodNames); + Tcl_Free((void *)methodNames); Tcl_SetObjResult(interp, errorMsg); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[skip]), NULL); @@ -624,7 +625,7 @@ TclOO_Object_Unknown( int TclOO_Object_LinkVar( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Interpreter in which to create the object; * also used for error reporting. */ Tcl_ObjectContext context, /* The object/call context. */ @@ -636,7 +637,7 @@ TclOO_Object_LinkVar( Namespace *savedNsPtr; int i; - if (objc-Tcl_ObjectContextSkippedArgs(context) < 0) { + if ((size_t)objc < Tcl_ObjectContextSkippedArgs(context)) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, "?varName ...?"); return TCL_ERROR; @@ -726,7 +727,7 @@ TclOO_Object_LinkVar( int TclOO_Object_VarName( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Interpreter in which to create the object; * also used for error reporting. */ Tcl_ObjectContext context, /* The object/call context. */ @@ -738,13 +739,13 @@ TclOO_Object_VarName( CallFrame *framePtr = ((Interp *) interp)->varFramePtr; const char *arg; - if (Tcl_ObjectContextSkippedArgs(context)+1 != objc) { + if ((int)Tcl_ObjectContextSkippedArgs(context)+1 != objc) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, "varName"); return TCL_ERROR; } argPtr = objv[objc-1]; - arg = Tcl_GetString(argPtr); + arg = TclGetString(argPtr); /* * Convert the variable name to fully-qualified form if it wasn't already. @@ -777,12 +778,12 @@ TclOO_Object_VarName( Method *mPtr = callerContext->callPtr->chain[ callerContext->index].mPtr; PrivateVariableMapping *pvPtr; - int i; + size_t i; if (mPtr->declaringObjectPtr == oPtr) { FOREACH_STRUCT(pvPtr, oPtr->privateVariables) { - if (!strcmp(Tcl_GetString(pvPtr->variableObj), - Tcl_GetString(argPtr))) { + if (!strcmp(TclGetString(pvPtr->variableObj), + TclGetString(argPtr))) { argPtr = pvPtr->fullNameObj; break; } @@ -803,8 +804,8 @@ TclOO_Object_VarName( } if (isInstance) { FOREACH_STRUCT(pvPtr, clsPtr->privateVariables) { - if (!strcmp(Tcl_GetString(pvPtr->variableObj), - Tcl_GetString(argPtr))) { + if (!strcmp(TclGetString(pvPtr->variableObj), + TclGetString(argPtr))) { argPtr = pvPtr->fullNameObj; break; } @@ -864,7 +865,7 @@ TclOO_Object_VarName( int TclOONextObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) @@ -900,7 +901,7 @@ TclOONextObjCmd( int TclOONextToObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) @@ -909,7 +910,7 @@ TclOONextToObjCmd( CallFrame *framePtr = iPtr->varFramePtr; Class *classPtr; CallContext *contextPtr; - int i; + size_t i; Tcl_Object object; const char *methodType; @@ -985,7 +986,7 @@ TclOONextToObjCmd( methodType = "method"; } - for (i=contextPtr->index ; i>=0 ; i--) { + for (i=contextPtr->index ; i != TCL_INDEX_NONE ; i--) { struct MInvoke *miPtr = contextPtr->callPtr->chain + i; if (!miPtr->isFilter && miPtr->mPtr->declaringClassPtr == classPtr) { @@ -1033,7 +1034,7 @@ NextRestoreFrame( int TclOOSelfObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) @@ -1045,12 +1046,11 @@ TclOOSelfObjCmd( enum SelfCmds { SELF_CALL, SELF_CALLER, SELF_CLASS, SELF_FILTER, SELF_METHOD, SELF_NS, SELF_NEXT, SELF_OBJECT, SELF_TARGET - }; + } index; Interp *iPtr = (Interp *) interp; CallFrame *framePtr = iPtr->varFramePtr; CallContext *contextPtr; Tcl_Obj *result[3]; - int index; #define CurrentlyInvoked(contextPtr) \ ((contextPtr)->callPtr->chain[(contextPtr)->index]) @@ -1084,7 +1084,7 @@ TclOOSelfObjCmd( return TCL_ERROR; } - switch ((enum SelfCmds) index) { + switch (index) { case SELF_OBJECT: Tcl_SetObjResult(interp, TclOOObjectName(interp, contextPtr->oPtr)); return TCL_OK; @@ -1218,7 +1218,7 @@ TclOOSelfObjCmd( } else { Method *mPtr; Object *declarerPtr; - int i; + size_t i; for (i=contextPtr->index ; i<contextPtr->callPtr->numChain ; i++){ if (!contextPtr->callPtr->chain[i].isFilter) { @@ -1270,7 +1270,7 @@ TclOOSelfObjCmd( int TclOOCopyObjectCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c index fc36f90..450fc9f 100644 --- a/generic/tclOOCall.c +++ b/generic/tclOOCall.c @@ -24,7 +24,7 @@ struct ChainBuilder { CallChain *callChainPtr; /* The call chain being built. */ - int filterLength; /* Number of entries in the call chain that + size_t filterLength; /* Number of entries in the call chain that * are due to processing filters and not the * main call chain. */ Object *oPtr; /* The object that we are building the chain @@ -137,7 +137,7 @@ static inline int IsStillValid(CallChain *callPtr, Object *oPtr, int flags, int reuseMask); static Tcl_NRPostProc ResetFilterFlags; static Tcl_NRPostProc SetFilterFlags; -static int SortMethodNames(Tcl_HashTable *namesPtr, int flags, +static size_t SortMethodNames(Tcl_HashTable *namesPtr, int flags, const char ***stringsPtr); static inline void StashCallChain(Tcl_Obj *objPtr, CallChain *callPtr); @@ -150,7 +150,8 @@ static const Tcl_ObjType methodNameType = { FreeMethodNameRep, DupMethodNameRep, NULL, - NULL + NULL, + TCL_OBJTYPE_V0 }; @@ -205,7 +206,7 @@ TclOODeleteChainCache( } } Tcl_DeleteHashTable(tablePtr); - ckfree(tablePtr); + Tcl_Free(tablePtr); } /* @@ -226,9 +227,9 @@ TclOODeleteChain( return; } if (callPtr->chain != callPtr->staticChain) { - ckfree(callPtr->chain); + Tcl_Free(callPtr->chain); } - ckfree(callPtr); + Tcl_Free(callPtr); } /* @@ -326,7 +327,7 @@ TclOOInvokeContext( */ if (contextPtr->index == 0) { - int i; + size_t i; for (i = 0 ; i < contextPtr->callPtr->numChain ; i++) { AddRef(contextPtr->callPtr->chain[i].mPtr); @@ -408,7 +409,7 @@ FinalizeMethodRefs( int result) { CallContext *contextPtr = (CallContext *)data[0]; - int i; + size_t i; for (i = 0 ; i < contextPtr->callPtr->numChain ; i++) { TclOODelMethodRef(contextPtr->callPtr->chain[i].mPtr); @@ -449,7 +450,7 @@ TclOOGetSortedMethodList( * at. Is set-like in nature and keyed by * pointer to class. */ FOREACH_HASH_DECLS; - int i, numStrings; + size_t i, numStrings; Class *mixinPtr; Tcl_Obj *namePtr; Method *mPtr; @@ -525,7 +526,7 @@ TclOOGetSortedMethodList( return numStrings; } -int +size_t TclOOGetSortedClassMethodList( Class *clsPtr, /* The class to get the method names for. */ int flags, /* Whether we just want the public method @@ -539,7 +540,7 @@ TclOOGetSortedClassMethodList( /* Used to track what classes have been looked * at. Is set-like in nature and keyed by * pointer to class. */ - int numStrings; + size_t numStrings; Tcl_InitObjHashTable(&names); Tcl_InitHashTable(&examinedClasses, TCL_ONE_WORD_KEYS); @@ -584,7 +585,7 @@ TclOOGetSortedClassMethodList( * ---------------------------------------------------------------------- */ -static int +static size_t SortMethodNames( Tcl_HashTable *namesPtr, /* The table of names; unsorted, but contains * whether the names are wanted and under what @@ -593,13 +594,13 @@ SortMethodNames( * methods. Full private methods are handled * on insertion to the table. */ const char ***stringsPtr) /* Where to store the sorted list of strings - * that we produce. ckalloced() */ + * that we produce. Tcl_Alloced() */ { const char **strings; FOREACH_HASH_DECLS; Tcl_Obj *namePtr; void *isWanted; - int i = 0; + size_t i = 0; /* * See how many (visible) method names there are. If none, we do not (and @@ -617,7 +618,7 @@ SortMethodNames( * sorted when it is long enough to matter. */ - strings = (const char **)ckalloc(sizeof(char *) * namesPtr->numEntries); + strings = (const char **)Tcl_Alloc(sizeof(char *) * namesPtr->numEntries); FOREACH_HASH(namePtr, isWanted, namesPtr) { if (!WANT_PUBLIC(flags) || (PTR2INT(isWanted) & IN_LIST)) { if (PTR2INT(isWanted) & NO_IMPLEMENTATION) { @@ -639,7 +640,7 @@ SortMethodNames( } *stringsPtr = strings; } else { - ckfree(strings); + Tcl_Free((void *)strings); *stringsPtr = NULL; } return i; @@ -690,14 +691,14 @@ AddClassMethodNames( * pointers to the classes, and the values are * immaterial. */ { - int i; + size_t i; /* * If we've already started looking at this class, stop working on it now * to prevent repeated work. */ - if (Tcl_FindHashEntry(examinedClassesPtr, (char *) clsPtr)) { + if (Tcl_FindHashEntry(examinedClassesPtr, clsPtr)) { return; } @@ -714,7 +715,7 @@ AddClassMethodNames( Method *mPtr; int isNew; - (void) Tcl_CreateHashEntry(examinedClassesPtr, (char *) clsPtr, + (void) Tcl_CreateHashEntry(examinedClassesPtr, clsPtr, &isNew); if (!isNew) { break; @@ -773,7 +774,7 @@ AddPrivateMethodNames( if (IS_PRIVATE(mPtr)) { int isNew; - hPtr = Tcl_CreateHashEntry(namesPtr, (char *) namePtr, &isNew); + hPtr = Tcl_CreateHashEntry(namesPtr, namePtr, &isNew); Tcl_SetHashValue(hPtr, INT2PTR(IN_LIST)); } } @@ -789,7 +790,7 @@ AddStandardMethodName( if (!IS_PRIVATE(mPtr)) { int isNew; Tcl_HashEntry *hPtr = - Tcl_CreateHashEntry(namesPtr, (char *) namePtr, &isNew); + Tcl_CreateHashEntry(namesPtr, namePtr, &isNew); if (isNew) { int isWanted = (!WANT_PUBLIC(flags) || IS_PUBLIC(mPtr)) @@ -837,7 +838,7 @@ AddInstancePrivateToCallContext( int donePrivate = 0; if (oPtr->methodsPtr) { - hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) methodName); + hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, methodName); if (hPtr != NULL) { mPtr = (Method *)Tcl_GetHashValue(hPtr); if (IS_PRIVATE(mPtr)) { @@ -881,12 +882,13 @@ AddSimpleChainToCallContext( * NULL, either the filter was declared by the * object or this isn't a filter. */ { - int i, foundPrivate = 0, blockedUnexported = 0; + size_t i; + int foundPrivate = 0, blockedUnexported = 0; Tcl_HashEntry *hPtr; Method *mPtr; if (!(flags & (KNOWN_STATE | SPECIAL)) && oPtr->methodsPtr) { - hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) methodNameObj); + hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, methodNameObj); if (hPtr != NULL) { mPtr = (Method *)Tcl_GetHashValue(hPtr); @@ -917,7 +919,7 @@ AddSimpleChainToCallContext( flags | TRAVERSED_MIXIN, filterDecl); } if (oPtr->methodsPtr && !blockedUnexported) { - hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char*) methodNameObj); + hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, methodNameObj); if (hPtr != NULL) { mPtr = (Method *)Tcl_GetHashValue(hPtr); if (!IS_PRIVATE(mPtr)) { @@ -973,7 +975,7 @@ AddMethodToCallChain( * not passed a mixin. */ { CallChain *callPtr = cbPtr->callChainPtr; - int i; + size_t i; /* * Return if this is just an entry used to record whether this is a public @@ -1041,11 +1043,11 @@ AddMethodToCallChain( if (callPtr->numChain == CALL_CHAIN_STATIC_SIZE) { callPtr->chain = - (struct MInvoke *)ckalloc(sizeof(struct MInvoke) * (callPtr->numChain + 1)); + (struct MInvoke *)Tcl_Alloc(sizeof(struct MInvoke) * (callPtr->numChain + 1)); memcpy(callPtr->chain, callPtr->staticChain, sizeof(struct MInvoke) * callPtr->numChain); } else if (callPtr->numChain > CALL_CHAIN_STATIC_SIZE) { - callPtr->chain = (struct MInvoke *)ckrealloc(callPtr->chain, + callPtr->chain = (struct MInvoke *)Tcl_Realloc(callPtr->chain, sizeof(struct MInvoke) * (callPtr->numChain + 1)); } callPtr->chain[i].mPtr = mPtr; @@ -1153,7 +1155,7 @@ TclOOGetCallContext( CallContext *contextPtr; CallChain *callPtr; struct ChainBuilder cb; - int i, count; + size_t i, count; int doFilters, donePrivate = 0; Tcl_HashEntry *hPtr; Tcl_HashTable doneFilters; @@ -1209,14 +1211,14 @@ TclOOGetCallContext( if (oPtr->flags & USE_CLASS_CACHE) { if (oPtr->selfCls->classChainCache != NULL) { hPtr = Tcl_FindHashEntry(oPtr->selfCls->classChainCache, - (char *) methodNameObj); + methodNameObj); } else { hPtr = NULL; } } else { if (oPtr->chainCache != NULL) { hPtr = Tcl_FindHashEntry(oPtr->chainCache, - (char *) methodNameObj); + methodNameObj); } else { hPtr = NULL; } @@ -1235,7 +1237,7 @@ TclOOGetCallContext( doFilters = 1; } - callPtr = (CallChain *)ckalloc(sizeof(CallChain)); + callPtr = (CallChain *)Tcl_Alloc(sizeof(CallChain)); InitCallChain(callPtr, oPtr, flags); cb.callChainPtr = callPtr; @@ -1253,7 +1255,7 @@ TclOOGetCallContext( AddSimpleChainToCallContext(oPtr, NULL, oPtr->fPtr->unknownMethodNameObj, &cb, NULL, 0, NULL); callPtr->flags |= OO_UNKNOWN_METHOD; - callPtr->epoch = -1; + callPtr->epoch = 0; if (callPtr->numChain == 0) { TclOODeleteChain(callPtr); return NULL; @@ -1330,30 +1332,31 @@ TclOOGetCallContext( AddSimpleChainToCallContext(oPtr, NULL, oPtr->fPtr->unknownMethodNameObj, &cb, NULL, 0, NULL); callPtr->flags |= OO_UNKNOWN_METHOD; - callPtr->epoch = -1; + callPtr->epoch = 0; if (count == callPtr->numChain) { TclOODeleteChain(callPtr); return NULL; } } else if (doFilters && !donePrivate) { if (hPtr == NULL) { + int isNew; if (oPtr->flags & USE_CLASS_CACHE) { if (oPtr->selfCls->classChainCache == NULL) { oPtr->selfCls->classChainCache = - (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable)); + (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_InitObjHashTable(oPtr->selfCls->classChainCache); } hPtr = Tcl_CreateHashEntry(oPtr->selfCls->classChainCache, - (char *) methodNameObj, &i); + methodNameObj, &isNew); } else { if (oPtr->chainCache == NULL) { - oPtr->chainCache = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable)); + oPtr->chainCache = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_InitObjHashTable(oPtr->chainCache); } hPtr = Tcl_CreateHashEntry(oPtr->chainCache, - (char *) methodNameObj, &i); + methodNameObj, &isNew); } } callPtr->refCount++; @@ -1413,7 +1416,7 @@ TclOOGetStereotypeCallChain( { CallChain *callPtr; struct ChainBuilder cb; - int i, count; + size_t count; Foundation *fPtr = clsPtr->thisPtr->fPtr; Tcl_HashEntry *hPtr; Tcl_HashTable doneFilters; @@ -1439,7 +1442,7 @@ TclOOGetStereotypeCallChain( if (clsPtr->classChainCache != NULL) { hPtr = Tcl_FindHashEntry(clsPtr->classChainCache, - (char *) methodNameObj); + methodNameObj); if (hPtr != NULL && Tcl_GetHashValue(hPtr) != NULL) { const int reuseMask = (WANT_PUBLIC(flags) ? ~0 : ~PUBLIC_METHOD); @@ -1455,7 +1458,7 @@ TclOOGetStereotypeCallChain( hPtr = NULL; } - callPtr = (CallChain *)ckalloc(sizeof(CallChain)); + callPtr = (CallChain *)Tcl_Alloc(sizeof(CallChain)); memset(callPtr, 0, sizeof(CallChain)); callPtr->flags = flags & (PUBLIC_METHOD|PRIVATE_METHOD|FILTER_HANDLING); callPtr->epoch = fPtr->epoch; @@ -1502,19 +1505,20 @@ TclOOGetStereotypeCallChain( AddSimpleChainToCallContext(&obj, NULL, fPtr->unknownMethodNameObj, &cb, NULL, 0, NULL); callPtr->flags |= OO_UNKNOWN_METHOD; - callPtr->epoch = -1; + callPtr->epoch = 0; if (count == callPtr->numChain) { TclOODeleteChain(callPtr); return NULL; } } else { if (hPtr == NULL) { + int isNew; if (clsPtr->classChainCache == NULL) { - clsPtr->classChainCache = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable)); + clsPtr->classChainCache = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_InitObjHashTable(clsPtr->classChainCache); } hPtr = Tcl_CreateHashEntry(clsPtr->classChainCache, - (char *) methodNameObj, &i); + methodNameObj, &isNew); } callPtr->refCount++; Tcl_SetHashValue(hPtr, callPtr); @@ -1547,7 +1551,7 @@ AddClassFiltersToCallContext( int flags) /* Whether we've gone along a mixin link * yet. */ { - int i; + size_t i; int clearedFlags = flags & ~(TRAVERSED_MIXIN|OBJECT_MIXIN|BUILDING_MIXINS); Class *superPtr, *mixinPtr; @@ -1578,8 +1582,7 @@ AddClassFiltersToCallContext( FOREACH(filterObj, clsPtr->filters) { int isNew; - (void) Tcl_CreateHashEntry(doneFilters, (char *) filterObj, - &isNew); + (void) Tcl_CreateHashEntry(doneFilters, filterObj, &isNew); if (isNew) { AddSimpleChainToCallContext(oPtr, NULL, filterObj, cbPtr, doneFilters, clearedFlags|BUILDING_MIXINS, clsPtr); @@ -1637,7 +1640,7 @@ AddPrivatesFromClassChainToCallContext( * NULL, either the filter was declared by the * object or this isn't a filter. */ { - int i; + size_t i; Class *superPtr; /* @@ -1715,7 +1718,8 @@ AddSimpleClassChainToCallContext( * NULL, either the filter was declared by the * object or this isn't a filter. */ { - int i, privateDanger = 0; + size_t i; + int privateDanger = 0; Class *superPtr; /* @@ -1741,7 +1745,7 @@ AddSimpleClassChainToCallContext( filterDecl, flags); } else { Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&classPtr->classMethods, - (char *) methodNameObj); + methodNameObj); if (classPtr->flags & HAS_PRIVATE_METHODS) { privateDanger |= 1; @@ -1800,7 +1804,7 @@ TclOORenderCallChain( Tcl_Obj *filterLiteral, *methodLiteral, *objectLiteral, *privateLiteral; Tcl_Obj *resultObj, *descObjs[4], **objv; Foundation *fPtr = TclOOGetFoundation(interp); - int i; + size_t i; /* * Allocate the literals (potentially) used in our description. @@ -1828,7 +1832,7 @@ TclOORenderCallChain( */ objv = (Tcl_Obj **)TclStackAlloc(interp, callPtr->numChain * sizeof(Tcl_Obj *)); - for (i = 0 ; i < callPtr->numChain ; i++) { + for (i = 0 ; i < (size_t)callPtr->numChain ; i++) { struct MInvoke *miPtr = &callPtr->chain[i]; descObjs[0] = @@ -1930,7 +1934,7 @@ TclOOGetDefineContextNamespace( Tcl_ResetResult(interp); } if (define.list != staticSpace) { - ckfree(define.list); + Tcl_Free(define.list); } return nsPtr; } @@ -1956,7 +1960,7 @@ AddSimpleDefineNamespaces( * building. */ { Class *mixinPtr; - int i; + size_t i; FOREACH(mixinPtr, oPtr->mixins) { AddSimpleClassDefineNamespaces(mixinPtr, definePtr, @@ -1985,7 +1989,7 @@ AddSimpleClassDefineNamespaces( int flags) /* What sort of define chain are we * building. */ { - int i; + size_t i; Class *superPtr; /* @@ -2095,11 +2099,11 @@ AddDefinitionNamespaceToChain( DefineEntry *staticList = definePtr->list; definePtr->list = - (DefineEntry *)ckalloc(sizeof(DefineEntry) * definePtr->size); + (DefineEntry *)Tcl_Alloc(sizeof(DefineEntry) * definePtr->size); memcpy(definePtr->list, staticList, sizeof(DefineEntry) * definePtr->num); } else { - definePtr->list = (DefineEntry *)ckrealloc(definePtr->list, + definePtr->list = (DefineEntry *)Tcl_Realloc(definePtr->list, sizeof(DefineEntry) * definePtr->size); } } diff --git a/generic/tclOODecls.h b/generic/tclOODecls.h index 13e07ec..0c141fe 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, int objc, - Tcl_Obj *const *objv, int skip); + const char *nsNameStr, size_t objc, + Tcl_Obj *const *objv, size_t 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 int Tcl_ObjectContextSkippedArgs( +TCLAPI size_t 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, int objc, - Tcl_Obj *const *objv, int skip); + Tcl_ObjectContext context, size_t objc, + Tcl_Obj *const *objv, size_t 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, int objc, Tcl_Obj *const *objv, int skip); /* 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); /* 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 */ - int (*tcl_ObjectContextSkippedArgs) (Tcl_ObjectContext context); /* 18 */ + size_t (*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, int objc, Tcl_Obj *const *objv, int skip); /* 23 */ + int (*tcl_ObjectContextInvokeNext) (Tcl_Interp *interp, Tcl_ObjectContext context, size_t objc, Tcl_Obj *const *objv, size_t 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 686fd00..63aca58 100644 --- a/generic/tclOODefineCmds.c +++ b/generic/tclOODefineCmds.c @@ -249,10 +249,10 @@ RecomputeClassCacheFlag( void TclOOObjectSetFilters( Object *oPtr, - int numFilters, + size_t numFilters, Tcl_Obj *const *filters) { - int i; + size_t i; if (oPtr->filters.num) { Tcl_Obj *filterObj; @@ -267,7 +267,7 @@ TclOOObjectSetFilters( * No list of filters was supplied, so we're deleting filters. */ - ckfree(oPtr->filters.list); + Tcl_Free(oPtr->filters.list); oPtr->filters.list = NULL; oPtr->filters.num = 0; RecomputeClassCacheFlag(oPtr); @@ -280,9 +280,9 @@ TclOOObjectSetFilters( int size = sizeof(Tcl_Obj *) * numFilters; /* should be size_t */ if (oPtr->filters.num == 0) { - filtersList = (Tcl_Obj **)ckalloc(size); + filtersList = (Tcl_Obj **)Tcl_Alloc(size); } else { - filtersList = (Tcl_Obj **)ckrealloc(oPtr->filters.list, size); + filtersList = (Tcl_Obj **)Tcl_Realloc(oPtr->filters.list, size); } for (i = 0 ; i < numFilters ; i++) { filtersList[i] = filters[i]; @@ -309,10 +309,10 @@ void TclOOClassSetFilters( Tcl_Interp *interp, Class *classPtr, - int numFilters, + size_t numFilters, Tcl_Obj *const *filters) { - int i; + size_t i; if (classPtr->filters.num) { Tcl_Obj *filterObj; @@ -327,7 +327,7 @@ TclOOClassSetFilters( * No list of filters was supplied, so we're deleting filters. */ - ckfree(classPtr->filters.list); + Tcl_Free(classPtr->filters.list); classPtr->filters.list = NULL; classPtr->filters.num = 0; } else { @@ -339,9 +339,9 @@ TclOOClassSetFilters( int size = sizeof(Tcl_Obj *) * numFilters; /* should be size_t */ if (classPtr->filters.num == 0) { - filtersList = (Tcl_Obj **)ckalloc(size); + filtersList = (Tcl_Obj **)Tcl_Alloc(size); } else { - filtersList = (Tcl_Obj **)ckrealloc(classPtr->filters.list, size); + filtersList = (Tcl_Obj **)Tcl_Realloc(classPtr->filters.list, size); } for (i = 0 ; i < numFilters ; i++) { filtersList[i] = filters[i]; @@ -371,11 +371,11 @@ TclOOClassSetFilters( void TclOOObjectSetMixins( Object *oPtr, - int numMixins, + size_t numMixins, Class *const *mixins) { Class *mixinPtr; - int i; + size_t i; if (numMixins == 0) { if (oPtr->mixins.num != 0) { @@ -383,7 +383,7 @@ TclOOObjectSetMixins( TclOORemoveFromInstances(oPtr, mixinPtr); TclOODecrRefCount(mixinPtr->thisPtr); } - ckfree(oPtr->mixins.list); + Tcl_Free(oPtr->mixins.list); oPtr->mixins.num = 0; } RecomputeClassCacheFlag(oPtr); @@ -395,10 +395,10 @@ TclOOObjectSetMixins( } TclOODecrRefCount(mixinPtr->thisPtr); } - oPtr->mixins.list = (Class **)ckrealloc(oPtr->mixins.list, + oPtr->mixins.list = (Class **)Tcl_Realloc(oPtr->mixins.list, sizeof(Class *) * numMixins); } else { - oPtr->mixins.list = (Class **)ckalloc(sizeof(Class *) * numMixins); + oPtr->mixins.list = (Class **)Tcl_Alloc(sizeof(Class *) * numMixins); oPtr->flags &= ~USE_CLASS_CACHE; } oPtr->mixins.num = numMixins; @@ -432,11 +432,11 @@ void TclOOClassSetMixins( Tcl_Interp *interp, Class *classPtr, - int numMixins, + size_t numMixins, Class *const *mixins) { Class *mixinPtr; - int i; + size_t i; if (numMixins == 0) { if (classPtr->mixins.num != 0) { @@ -444,7 +444,7 @@ TclOOClassSetMixins( TclOORemoveFromMixinSubs(classPtr, mixinPtr); TclOODecrRefCount(mixinPtr->thisPtr); } - ckfree(classPtr->mixins.list); + Tcl_Free(classPtr->mixins.list); classPtr->mixins.num = 0; } } else { @@ -453,10 +453,10 @@ TclOOClassSetMixins( TclOORemoveFromMixinSubs(classPtr, mixinPtr); TclOODecrRefCount(mixinPtr->thisPtr); } - classPtr->mixins.list = (Class **)ckrealloc(classPtr->mixins.list, + classPtr->mixins.list = (Class **)Tcl_Realloc(classPtr->mixins.list, sizeof(Class *) * numMixins); } else { - classPtr->mixins.list = (Class **)ckalloc(sizeof(Class *) * numMixins); + classPtr->mixins.list = (Class **)Tcl_Alloc(sizeof(Class *) * numMixins); } classPtr->mixins.num = numMixins; memcpy(classPtr->mixins.list, mixins, sizeof(Class *) * numMixins); @@ -485,11 +485,12 @@ TclOOClassSetMixins( static inline void InstallStandardVariableMapping( VariableNameList *vnlPtr, - int varc, + size_t varc, Tcl_Obj *const *varv) { Tcl_Obj *variableObj; - int i, n, created; + size_t i, n; + int created; Tcl_HashTable uniqueTable; for (i=0 ; i<varc ; i++) { @@ -500,11 +501,11 @@ InstallStandardVariableMapping( } if (i != varc) { if (varc == 0) { - ckfree(vnlPtr->list); + Tcl_Free(vnlPtr->list); } else if (i) { - vnlPtr->list = (Tcl_Obj **)ckrealloc(vnlPtr->list, sizeof(Tcl_Obj *) * varc); + vnlPtr->list = (Tcl_Obj **)Tcl_Realloc(vnlPtr->list, sizeof(Tcl_Obj *) * varc); } else { - vnlPtr->list = (Tcl_Obj **)ckalloc(sizeof(Tcl_Obj *) * varc); + vnlPtr->list = (Tcl_Obj **)Tcl_Alloc(sizeof(Tcl_Obj *) * varc); } } vnlPtr->num = 0; @@ -525,7 +526,7 @@ InstallStandardVariableMapping( */ if (n != varc) { - vnlPtr->list = (Tcl_Obj **)ckrealloc(vnlPtr->list, sizeof(Tcl_Obj *) * n); + vnlPtr->list = (Tcl_Obj **)Tcl_Realloc(vnlPtr->list, sizeof(Tcl_Obj *) * n); } Tcl_DeleteHashTable(&uniqueTable); } @@ -534,12 +535,13 @@ InstallStandardVariableMapping( static inline void InstallPrivateVariableMapping( PrivateVariableList *pvlPtr, - int varc, + size_t varc, Tcl_Obj *const *varv, int creationEpoch) { PrivateVariableMapping *privatePtr; - int i, n, created; + size_t i, n; + int created; Tcl_HashTable uniqueTable; for (i=0 ; i<varc ; i++) { @@ -551,12 +553,12 @@ InstallPrivateVariableMapping( } if (i != varc) { if (varc == 0) { - ckfree(pvlPtr->list); + Tcl_Free(pvlPtr->list); } else if (i) { - pvlPtr->list = (PrivateVariableMapping *)ckrealloc(pvlPtr->list, + pvlPtr->list = (PrivateVariableMapping *)Tcl_Realloc(pvlPtr->list, sizeof(PrivateVariableMapping) * varc); } else { - pvlPtr->list = (PrivateVariableMapping *)ckalloc(sizeof(PrivateVariableMapping) * varc); + pvlPtr->list = (PrivateVariableMapping *)Tcl_Alloc(sizeof(PrivateVariableMapping) * varc); } } @@ -570,7 +572,7 @@ InstallPrivateVariableMapping( privatePtr->variableObj = varv[i]; privatePtr->fullNameObj = Tcl_ObjPrintf( PRIVATE_VARIABLE_PATTERN, - creationEpoch, Tcl_GetString(varv[i])); + creationEpoch, TclGetString(varv[i])); Tcl_IncrRefCount(privatePtr->fullNameObj); } else { Tcl_DecrRefCount(varv[i]); @@ -583,7 +585,7 @@ InstallPrivateVariableMapping( */ if (n != varc) { - pvlPtr->list = (PrivateVariableMapping *)ckrealloc(pvlPtr->list, + pvlPtr->list = (PrivateVariableMapping *)Tcl_Realloc(pvlPtr->list, sizeof(PrivateVariableMapping) * n); } Tcl_DeleteHashTable(&uniqueTable); @@ -621,12 +623,12 @@ RenameDeleteMethod( TclGetString(fromPtr), NULL); return TCL_ERROR; } - hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) fromPtr); + hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, fromPtr); if (hPtr == NULL) { goto noSuchMethod; } if (toPtr) { - newHPtr = Tcl_CreateHashEntry(oPtr->methodsPtr, (char *) toPtr, + newHPtr = Tcl_CreateHashEntry(oPtr->methodsPtr, toPtr, &isNew); if (hPtr == newHPtr) { renameToSelf: @@ -644,8 +646,7 @@ RenameDeleteMethod( } } } else { - hPtr = Tcl_FindHashEntry(&oPtr->classPtr->classMethods, - (char *) fromPtr); + hPtr = Tcl_FindHashEntry(&oPtr->classPtr->classMethods, fromPtr); if (hPtr == NULL) { goto noSuchMethod; } @@ -695,7 +696,7 @@ RenameDeleteMethod( int TclOOUnknownDefinition( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) @@ -703,7 +704,7 @@ TclOOUnknownDefinition( Namespace *nsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp); Tcl_HashSearch search; Tcl_HashEntry *hPtr; - int soughtLen; + size_t soughtLen; const char *soughtStr, *matchedStr = NULL; if (objc < 2) { @@ -716,7 +717,7 @@ TclOOUnknownDefinition( return TCL_ERROR; } - soughtStr = TclGetStringFromObj(objv[1], &soughtLen); + soughtStr = Tcl_GetStringFromObj(objv[1], &soughtLen); if (soughtLen == 0) { goto noMatch; } @@ -777,8 +778,8 @@ FindCommand( Tcl_Obj *stringObj, Tcl_Namespace *const namespacePtr) { - int length; - const char *nameStr, *string = TclGetStringFromObj(stringObj, &length); + size_t length; + const char *nameStr, *string = Tcl_GetStringFromObj(stringObj, &length); Namespace *const nsPtr = (Namespace *) namespacePtr; FOREACH_HASH_DECLS; Tcl_Command cmd, cmd2; @@ -996,16 +997,16 @@ GenerateErrorInfo( * an object, class or class-as-object that * was being configured. */ { - int length; + size_t length; Tcl_Obj *realNameObj = Tcl_ObjectDeleted((Tcl_Object) oPtr) ? savedNameObj : TclOOObjectName(interp, oPtr); - const char *objName = TclGetStringFromObj(realNameObj, &length); - int limit = OBJNAME_LENGTH_IN_ERRORINFO_LIMIT; + const char *objName = Tcl_GetStringFromObj(realNameObj, &length); + unsigned 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 : length), objName, + typeOfSubject, (overflow ? limit : (unsigned)length), objName, (overflow ? "..." : ""), Tcl_GetErrorLine(interp))); } @@ -1032,7 +1033,8 @@ MagicDefinitionInvoke( { Tcl_Obj *objPtr, *obj2Ptr, **objs; Tcl_Command cmd; - int isRoot, dummy, result, offset = cmdIndex + 1; + int isRoot, result, offset = cmdIndex + 1; + size_t dummy; /* * More than one argument: fire them through the ensemble processing @@ -1092,7 +1094,7 @@ MagicDefinitionInvoke( int TclOODefineObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) @@ -1168,7 +1170,7 @@ TclOODefineObjCmd( int TclOOObjDefObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) @@ -1237,7 +1239,7 @@ TclOOObjDefObjCmd( int TclOODefineSelfObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) @@ -1308,7 +1310,7 @@ TclOODefineSelfObjCmd( int TclOODefineObjSelfObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) @@ -1415,7 +1417,7 @@ TclOODefinePrivateObjCmd( int TclOODefineClassObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) @@ -1496,8 +1498,8 @@ TclOODefineClassObjCmd( TclOODeleteDescendants(interp, oPtr); oPtr->flags &= ~DONT_DELETE; TclOOReleaseClassContents(interp, oPtr); - ckfree(oPtr->classPtr); - oPtr->classPtr = NULL; + Tcl_Free(oPtr->classPtr); + oPtr->classPtr = NULL; } else if (!wasClass && willBeClass) { TclOOAllocClass(interp, oPtr); } @@ -1524,7 +1526,7 @@ TclOODefineClassObjCmd( int TclOODefineConstructorObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) @@ -1532,7 +1534,7 @@ TclOODefineConstructorObjCmd( Object *oPtr; Class *clsPtr; Tcl_Method method; - int bodyLength; + size_t bodyLength; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "arguments body"); @@ -1550,7 +1552,7 @@ TclOODefineConstructorObjCmd( } clsPtr = oPtr->classPtr; - TclGetStringFromObj(objv[2], &bodyLength); + (void)Tcl_GetStringFromObj(objv[2], &bodyLength); if (bodyLength > 0) { /* * Create the method structure. @@ -1593,7 +1595,7 @@ TclOODefineConstructorObjCmd( int TclOODefineDefnNsObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) @@ -1638,7 +1640,7 @@ TclOODefineDefnNsObjCmd( &kind) != TCL_OK) { return TCL_ERROR; } - if (!Tcl_GetString(objv[objc - 1])[0]) { + if (!TclGetString(objv[objc - 1])[0]) { nsNamePtr = NULL; } else { nsPtr = GetNamespaceInOuterContext(interp, objv[objc - 1]); @@ -1735,7 +1737,7 @@ TclOODefineDeleteMethodObjCmd( int TclOODefineDestructorObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) @@ -1743,7 +1745,7 @@ TclOODefineDestructorObjCmd( Object *oPtr; Class *clsPtr; Tcl_Method method; - int bodyLength; + size_t bodyLength; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "body"); @@ -1756,7 +1758,7 @@ TclOODefineDestructorObjCmd( } clsPtr = oPtr->classPtr; - TclGetStringFromObj(objv[1], &bodyLength); + (void)Tcl_GetStringFromObj(objv[1], &bodyLength); if (bodyLength > 0) { /* * Create the method structure. @@ -1841,19 +1843,19 @@ TclOODefineExportObjCmd( if (isInstanceExport) { if (!oPtr->methodsPtr) { - oPtr->methodsPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable)); + oPtr->methodsPtr = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_InitObjHashTable(oPtr->methodsPtr); oPtr->flags &= ~USE_CLASS_CACHE; } - hPtr = Tcl_CreateHashEntry(oPtr->methodsPtr, (char *) objv[i], + hPtr = Tcl_CreateHashEntry(oPtr->methodsPtr, objv[i], &isNew); } else { - hPtr = Tcl_CreateHashEntry(&clsPtr->classMethods, (char*) objv[i], + hPtr = Tcl_CreateHashEntry(&clsPtr->classMethods, objv[i], &isNew); } if (isNew) { - mPtr = (Method *)ckalloc(sizeof(Method)); + mPtr = (Method *)Tcl_Alloc(sizeof(Method)); memset(mPtr, 0, sizeof(Method)); mPtr->refCount = 1; mPtr->namePtr = objv[i]; @@ -2154,19 +2156,19 @@ TclOODefineUnexportObjCmd( if (isInstanceUnexport) { if (!oPtr->methodsPtr) { - oPtr->methodsPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable)); + oPtr->methodsPtr = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_InitObjHashTable(oPtr->methodsPtr); oPtr->flags &= ~USE_CLASS_CACHE; } - hPtr = Tcl_CreateHashEntry(oPtr->methodsPtr, (char *) objv[i], + hPtr = Tcl_CreateHashEntry(oPtr->methodsPtr, objv[i], &isNew); } else { - hPtr = Tcl_CreateHashEntry(&clsPtr->classMethods, (char*) objv[i], + hPtr = Tcl_CreateHashEntry(&clsPtr->classMethods, objv[i], &isNew); } if (isNew) { - mPtr = (Method *)ckalloc(sizeof(Method)); + mPtr = (Method *)Tcl_Alloc(sizeof(Method)); memset(mPtr, 0, sizeof(Method)); mPtr->refCount = 1; mPtr->namePtr = objv[i]; @@ -2314,7 +2316,7 @@ TclOODefineSlots( static int ClassFilterGet( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, Tcl_ObjectContext context, int objc, @@ -2322,9 +2324,9 @@ ClassFilterGet( { Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); Tcl_Obj *resultObj, *filterObj; - int i; + size_t i; - if (Tcl_ObjectContextSkippedArgs(context) != objc) { + if (Tcl_ObjectContextSkippedArgs(context) != (size_t)objc) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, NULL); return TCL_ERROR; @@ -2348,17 +2350,17 @@ ClassFilterGet( static int ClassFilterSet( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv) { Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); - int filterc; + size_t filterc; Tcl_Obj **filterv; - if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) { + if (Tcl_ObjectContextSkippedArgs(context) + 1 != (size_t)objc) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, "filterList"); return TCL_ERROR; @@ -2394,7 +2396,7 @@ ClassFilterSet( static int ClassMixinGet( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, Tcl_ObjectContext context, int objc, @@ -2403,9 +2405,9 @@ ClassMixinGet( Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); Tcl_Obj *resultObj; Class *mixinPtr; - int i; + size_t i; - if (Tcl_ObjectContextSkippedArgs(context) != objc) { + if (Tcl_ObjectContextSkippedArgs(context) != (size_t)objc) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, NULL); return TCL_ERROR; @@ -2431,18 +2433,18 @@ ClassMixinGet( static int ClassMixinSet( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv) { Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); - int mixinc, i; + size_t mixinc, i; Tcl_Obj **mixinv; Class **mixins; - if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) { + if (Tcl_ObjectContextSkippedArgs(context) + 1 != (size_t)objc) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, "mixinList"); return TCL_ERROR; @@ -2500,7 +2502,7 @@ ClassMixinSet( static int ClassSuperGet( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, Tcl_ObjectContext context, int objc, @@ -2509,9 +2511,9 @@ ClassSuperGet( Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); Tcl_Obj *resultObj; Class *superPtr; - int i; + size_t i; - if (Tcl_ObjectContextSkippedArgs(context) != objc) { + if (Tcl_ObjectContextSkippedArgs(context) != (size_t)objc) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, NULL); return TCL_ERROR; @@ -2536,18 +2538,19 @@ ClassSuperGet( static int ClassSuperSet( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv) { Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); - int superc, i, j; + size_t superc, j; + size_t i; Tcl_Obj **superv; Class **superclasses, *superPtr; - if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) { + if (Tcl_ObjectContextSkippedArgs(context) + 1 != (size_t)objc) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, "superclassList"); return TCL_ERROR; @@ -2575,7 +2578,7 @@ ClassSuperSet( * Allocate some working space. */ - superclasses = (Class **) ckalloc(sizeof(Class *) * superc); + superclasses = (Class **) Tcl_Alloc(sizeof(Class *) * superc); /* * Parse the arguments to get the class to use as superclasses. @@ -2585,7 +2588,7 @@ ClassSuperSet( */ if (superc == 0) { - superclasses = (Class **)ckrealloc(superclasses, sizeof(Class *)); + superclasses = (Class **)Tcl_Realloc(superclasses, sizeof(Class *)); if (TclOOIsReachable(oPtr->fPtr->classCls, oPtr->classPtr)) { superclasses[0] = oPtr->fPtr->classCls; } else { @@ -2617,7 +2620,7 @@ ClassSuperSet( for (; i-- > 0 ;) { TclOODecrRefCount(superclasses[i]->thisPtr); } - ckfree(superclasses); + Tcl_Free(superclasses); return TCL_ERROR; } @@ -2642,7 +2645,7 @@ ClassSuperSet( TclOORemoveFromSubclasses(oPtr->classPtr, superPtr); TclOODecrRefCount(superPtr->thisPtr); } - ckfree(oPtr->classPtr->superclasses.list); + Tcl_Free(oPtr->classPtr->superclasses.list); } oPtr->classPtr->superclasses.list = superclasses; oPtr->classPtr->superclasses.num = superc; @@ -2667,7 +2670,7 @@ ClassSuperSet( static int ClassVarsGet( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, Tcl_ObjectContext context, int objc, @@ -2675,9 +2678,9 @@ ClassVarsGet( { Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); Tcl_Obj *resultObj; - int i; + size_t i; - if (Tcl_ObjectContextSkippedArgs(context) != objc) { + if (Tcl_ObjectContextSkippedArgs(context) != (size_t)objc) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, NULL); return TCL_ERROR; @@ -2711,18 +2714,18 @@ ClassVarsGet( static int ClassVarsSet( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv) { Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); - int varc; + size_t i; + size_t varc; Tcl_Obj **varv; - int i; - if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) { + if (Tcl_ObjectContextSkippedArgs(context) + 1 != (size_t)objc) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, "filterList"); return TCL_ERROR; @@ -2782,7 +2785,7 @@ ClassVarsSet( static int ObjFilterGet( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, Tcl_ObjectContext context, int objc, @@ -2790,9 +2793,9 @@ ObjFilterGet( { Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); Tcl_Obj *resultObj, *filterObj; - int i; + size_t i; - if (Tcl_ObjectContextSkippedArgs(context) != objc) { + if (Tcl_ObjectContextSkippedArgs(context) != (size_t)objc) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, NULL); return TCL_ERROR; @@ -2810,17 +2813,17 @@ ObjFilterGet( static int ObjFilterSet( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv) { Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); - int filterc; + size_t filterc; Tcl_Obj **filterv; - if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) { + if (Tcl_ObjectContextSkippedArgs(context) + 1 != (size_t)objc) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, "filterList"); return TCL_ERROR; @@ -2850,7 +2853,7 @@ ObjFilterSet( static int ObjMixinGet( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, Tcl_ObjectContext context, int objc, @@ -2859,9 +2862,9 @@ ObjMixinGet( Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); Tcl_Obj *resultObj; Class *mixinPtr; - int i; + size_t i; - if (Tcl_ObjectContextSkippedArgs(context) != objc) { + if (Tcl_ObjectContextSkippedArgs(context) != (size_t)objc) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, NULL); return TCL_ERROR; @@ -2882,19 +2885,19 @@ ObjMixinGet( static int ObjMixinSet( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv) { Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); - int mixinc; + size_t i; + size_t mixinc; Tcl_Obj **mixinv; Class **mixins; - int i; - if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) { + if (Tcl_ObjectContextSkippedArgs(context) + 1 != (size_t)objc) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, "mixinList"); return TCL_ERROR; @@ -2936,7 +2939,7 @@ ObjMixinSet( static int ObjVarsGet( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, Tcl_ObjectContext context, int objc, @@ -2944,9 +2947,9 @@ ObjVarsGet( { Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); Tcl_Obj *resultObj; - int i; + size_t i; - if (Tcl_ObjectContextSkippedArgs(context) != objc) { + if (Tcl_ObjectContextSkippedArgs(context) != (size_t)objc) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, NULL); return TCL_ERROR; @@ -2974,17 +2977,17 @@ ObjVarsGet( static int ObjVarsSet( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv) { Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); - int varc, i; + size_t varc, i; Tcl_Obj **varv; - if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) { + if (Tcl_ObjectContextSkippedArgs(context) + 1 != (size_t)objc) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, "variableList"); return TCL_ERROR; @@ -3039,7 +3042,7 @@ ObjVarsSet( static int ResolveClass( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, Tcl_ObjectContext context, int objc, diff --git a/generic/tclOOInfo.c b/generic/tclOOInfo.c index 4e5b55b..b4f9c56 100644 --- a/generic/tclOOInfo.c +++ b/generic/tclOOInfo.c @@ -194,7 +194,7 @@ InfoObjectClassCmd( return TCL_OK; } else { Class *mixinPtr, *o2clsPtr; - int i; + size_t i; o2clsPtr = GetClassFromObj(interp, objv[2]); if (o2clsPtr == NULL) { @@ -252,7 +252,7 @@ InfoObjectDefnCmd( if (!oPtr->methodsPtr) { goto unknownMethod; } - hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) objv[2]); + hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, objv[2]); if (hPtr == NULL) { unknownMethod: Tcl_SetObjResult(interp, Tcl_ObjPrintf( @@ -307,7 +307,7 @@ InfoObjectFiltersCmd( int objc, Tcl_Obj *const objv[]) { - int i; + size_t i; Tcl_Obj *filterObj, *resultObj; Object *oPtr; @@ -363,7 +363,7 @@ InfoObjectForwardCmd( if (!oPtr->methodsPtr) { goto unknownMethod; } - hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) objv[2]); + hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, objv[2]); if (hPtr == NULL) { unknownMethod: Tcl_SetObjResult(interp, Tcl_ObjPrintf( @@ -408,9 +408,10 @@ InfoObjectIsACmd( }; enum IsACats { IsClass, IsMetaclass, IsMixin, IsObject, IsType - }; + } idx; Object *oPtr, *o2Ptr; - int idx, i, result = 0; + int result = 0; + size_t i; if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "category objName ?arg ...?"); @@ -426,7 +427,7 @@ InfoObjectIsACmd( * number of arguments. */ - switch ((enum IsACats) idx) { + switch (idx) { case IsObject: case IsClass: case IsMetaclass: @@ -454,7 +455,7 @@ InfoObjectIsACmd( goto failPrecondition; } - switch ((enum IsACats) idx) { + switch (idx) { case IsObject: result = 1; break; @@ -532,7 +533,7 @@ InfoObjectMethodsCmd( }; enum Options { OPT_ALL, OPT_LOCALPRIVATE, OPT_PRIVATE, OPT_SCOPE - }; + } idx; static const char *const scopes[] = { "private", "public", "unexported" }; @@ -550,14 +551,14 @@ InfoObjectMethodsCmd( return TCL_ERROR; } if (objc != 2) { - int i, idx; + int i; for (i=2 ; i<objc ; i++) { if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, &idx) != TCL_OK) { return TCL_ERROR; } - switch ((enum Options) idx) { + switch (idx) { case OPT_ALL: recurse = 1; break; @@ -612,7 +613,7 @@ InfoObjectMethodsCmd( Tcl_NewStringObj(names[i], -1)); } if (numNames > 0) { - ckfree(names); + Tcl_Free((void *)names); } } else if (oPtr->methodsPtr) { FOREACH_HASH(namePtr, mPtr, oPtr->methodsPtr) { @@ -659,7 +660,7 @@ InfoObjectMethodTypeCmd( if (!oPtr->methodsPtr) { goto unknownMethod; } - hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) objv[2]); + hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, objv[2]); if (hPtr == NULL) { unknownMethod: Tcl_SetObjResult(interp, Tcl_ObjPrintf( @@ -702,7 +703,7 @@ InfoObjectMixinsCmd( Class *mixinPtr; Object *oPtr; Tcl_Obj *resultObj; - int i; + size_t i; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "objName"); @@ -809,14 +810,15 @@ InfoObjectVariablesCmd( { Object *oPtr; Tcl_Obj *resultObj; - int i, isPrivate = 0; + size_t i; + int isPrivate = 0; if (objc != 2 && objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "objName ?-private?"); return TCL_ERROR; } if (objc == 3) { - if (strcmp("-private", Tcl_GetString(objv[2])) != 0) { + if (strcmp("-private", TclGetString(objv[2])) != 0) { return TCL_ERROR; } isPrivate = 1; @@ -997,7 +999,7 @@ InfoClassDefnCmd( if (clsPtr == NULL) { return TCL_ERROR; } - hPtr = Tcl_FindHashEntry(&clsPtr->classMethods, (char *) objv[2]); + hPtr = Tcl_FindHashEntry(&clsPtr->classMethods, objv[2]); if (hPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "unknown method \"%s\"", TclGetString(objv[2]))); @@ -1145,7 +1147,7 @@ InfoClassFiltersCmd( int objc, Tcl_Obj *const objv[]) { - int i; + size_t i; Tcl_Obj *filterObj, *resultObj; Class *clsPtr; @@ -1195,7 +1197,7 @@ InfoClassForwardCmd( if (clsPtr == NULL) { return TCL_ERROR; } - hPtr = Tcl_FindHashEntry(&clsPtr->classMethods, (char *) objv[2]); + hPtr = Tcl_FindHashEntry(&clsPtr->classMethods, objv[2]); if (hPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "unknown method \"%s\"", TclGetString(objv[2]))); @@ -1236,7 +1238,7 @@ InfoClassInstancesCmd( { Object *oPtr; Class *clsPtr; - int i; + size_t i; const char *pattern = NULL; Tcl_Obj *resultObj; @@ -1291,7 +1293,7 @@ InfoClassMethodsCmd( }; enum Options { OPT_ALL, OPT_LOCALPRIVATE, OPT_PRIVATE, OPT_SCOPE - }; + } idx; static const char *const scopes[] = { "private", "public", "unexported" }; @@ -1308,14 +1310,14 @@ InfoClassMethodsCmd( return TCL_ERROR; } if (objc != 2) { - int i, idx; + int i; for (i=2 ; i<objc ; i++) { if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, &idx) != TCL_OK) { return TCL_ERROR; } - switch ((enum Options) idx) { + switch (idx) { case OPT_ALL: recurse = 1; break; @@ -1359,14 +1361,14 @@ InfoClassMethodsCmd( TclNewObj(resultObj); if (recurse) { const char **names; - int i, numNames = TclOOGetSortedClassMethodList(clsPtr, flag, &names); + size_t i, numNames = TclOOGetSortedClassMethodList(clsPtr, flag, &names); for (i=0 ; i<numNames ; i++) { Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj(names[i], -1)); } if (numNames > 0) { - ckfree(names); + Tcl_Free((void *)names); } } else { FOREACH_HASH_DECLS; @@ -1411,7 +1413,7 @@ InfoClassMethodTypeCmd( return TCL_ERROR; } - hPtr = Tcl_FindHashEntry(&clsPtr->classMethods, (char *) objv[2]); + hPtr = Tcl_FindHashEntry(&clsPtr->classMethods, objv[2]); if (hPtr == NULL) { unknownMethod: Tcl_SetObjResult(interp, Tcl_ObjPrintf( @@ -1452,7 +1454,7 @@ InfoClassMixinsCmd( { Class *clsPtr, *mixinPtr; Tcl_Obj *resultObj; - int i; + size_t i; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "className"); @@ -1494,7 +1496,7 @@ InfoClassSubsCmd( { Class *clsPtr, *subclassPtr; Tcl_Obj *resultObj; - int i; + size_t i; const char *pattern = NULL; if (objc != 2 && objc != 3) { @@ -1549,7 +1551,7 @@ InfoClassSupersCmd( { Class *clsPtr, *superPtr; Tcl_Obj *resultObj; - int i; + size_t i; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "className"); @@ -1588,14 +1590,15 @@ InfoClassVariablesCmd( { Class *clsPtr; Tcl_Obj *resultObj; - int i, isPrivate = 0; + size_t i; + int isPrivate = 0; if (objc != 2 && objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "className ?-private?"); return TCL_ERROR; } if (objc == 3) { - if (strcmp("-private", Tcl_GetString(objv[2])) != 0) { + if (strcmp("-private", TclGetString(objv[2])) != 0) { return TCL_ERROR; } isPrivate = 1; diff --git a/generic/tclOOInt.h b/generic/tclOOInt.h index 725c4ce..b7fb34d 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. */ - int refCount; + size_t 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. */ - int refCount; + size_t refCount; void *clientData; TclOO_PmCDDeleteProc *deleteClientdataProc; TclOO_PmCDCloneProc *cloneClientdataProc; @@ -149,9 +149,9 @@ typedef struct { */ #define LIST_STATIC(listType_t) \ - struct { int num; listType_t *list; } + struct { size_t num; listType_t *list; } #define LIST_DYNAMIC(listType_t) \ - struct { int num, size; listType_t *list; } + struct { size_t num, size; listType_t *list; } /* * These types are needed in function arguments. @@ -184,18 +184,18 @@ typedef struct Object { struct Class *classPtr; /* This is non-NULL for all classes, and NULL * for everything else. It points to the class * structure. */ - int refCount; /* Number of strong references to this object. + size_t 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; - int creationEpoch; /* Unique value to make comparisons of objects + size_t creationEpoch; /* Unique value to make comparisons of objects * easier. */ - int epoch; /* Per-object epoch, incremented when the way + size_t 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 - * the ClientData values that are the values + * the void *values that are the values * of each piece of attached metadata. This * field starts out as NULL and is only * allocated if metadata is attached. */ @@ -283,7 +283,7 @@ typedef struct Class { Method *destructorPtr; /* Method record of the class destructor (if * any). */ Tcl_HashTable *metadataPtr; /* Mapping from pointers to metadata type to - * the ClientData values that are the values + * the void *values that are the values * of each piece of attached metadata. This * field starts out as NULL and is only * allocated if metadata is attached. */ @@ -329,7 +329,7 @@ typedef struct Class { */ typedef struct ThreadLocalData { - int nsCount; /* Epoch counter is used for keeping + size_t 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. */ - int epoch; /* Used to invalidate method chains when the + size_t 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 { - int objectCreationEpoch; /* The object's creation epoch. Note that the + size_t objectCreationEpoch; /* The object's creation epoch. Note that the * object reference is not stored in the call * chain; it is in the call context. */ - int objectEpoch; /* Local (object structure) epoch counter + size_t objectEpoch; /* Local (object structure) epoch counter * snapshot. */ - int epoch; /* Global (class structure) epoch counter + size_t epoch; /* Global (class structure) epoch counter * snapshot. */ int flags; /* Assorted flags, see below. */ - int refCount; /* Reference count. */ - int numChain; /* Size of the call chain. */ + size_t refCount; /* Reference count. */ + size_t 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. */ - int index; /* Index into the call chain of the currently + size_t index; /* Index into the call chain of the currently * executing method implementation. */ - int skip; /* Current number of arguments to skip; can + size_t 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, int objc, - Tcl_Obj *const *objv, int skip, + const char *nsNameStr, size_t objc, + Tcl_Obj *const *objv, size_t skip, Tcl_Object *objectPtr); MODULE_SCOPE Object * TclNewObjectInstanceCommon(Tcl_Interp *interp, Class *classPtr, @@ -533,7 +533,7 @@ MODULE_SCOPE Foundation *TclOOGetFoundation(Tcl_Interp *interp); MODULE_SCOPE Tcl_Obj * TclOOGetFwdFromMethod(Method *mPtr); MODULE_SCOPE Proc * TclOOGetProcFromMethod(Method *mPtr); MODULE_SCOPE Tcl_Obj * TclOOGetMethodBody(Method *mPtr); -MODULE_SCOPE int TclOOGetSortedClassMethodList(Class *clsPtr, +MODULE_SCOPE size_t TclOOGetSortedClassMethodList(Class *clsPtr, int flags, const char ***stringsPtr); MODULE_SCOPE int TclOOGetSortedMethodList(Object *oPtr, Object *contextObj, Class *contextCls, int flags, @@ -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, int objc, - Tcl_Obj *const *objv, int skip); + Tcl_ObjectContext context, size_t objc, + Tcl_Obj *const *objv, size_t 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: int i; + * REQUIRES DECLARATION: size_t 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: int i; + * REQUIRES DECLARATION: size_t i; */ #define FOREACH_STRUCT(var,ary) \ @@ -624,7 +624,7 @@ MODULE_SCOPE void TclOOSetupVariableResolver(Tcl_Namespace *nsPtr); do { \ size_t len = sizeof(type) * ((target).num=(source).num);\ if (len != 0) { \ - memcpy(((target).list=(type*)ckalloc(len)), (source).list, len); \ + memcpy(((target).list=(type*)Tcl_Alloc(len)), (source).list, len); \ } else { \ (target).list = NULL; \ } \ diff --git a/generic/tclOOIntDecls.h b/generic/tclOOIntDecls.h index 6a5cfd3..53c2a6f 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, - int objc, Tcl_Obj *const *objv, + size_t 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, int objc, + int publicPrivate, size_t objc, Tcl_Obj *const *objv); /* 12 */ -TCLAPI void TclOOObjectSetFilters(Object *oPtr, int numFilters, - Tcl_Obj *const *filters); +TCLAPI void TclOOObjectSetFilters(Object *oPtr, + size_t numFilters, Tcl_Obj *const *filters); /* 13 */ TCLAPI void TclOOClassSetFilters(Tcl_Interp *interp, - Class *classPtr, int numFilters, + Class *classPtr, size_t numFilters, Tcl_Obj *const *filters); /* 14 */ -TCLAPI void TclOOObjectSetMixins(Object *oPtr, int numMixins, +TCLAPI void TclOOObjectSetMixins(Object *oPtr, size_t numMixins, Class *const *mixins); /* 15 */ TCLAPI void TclOOClassSetMixins(Tcl_Interp *interp, - Class *classPtr, int numMixins, + Class *classPtr, size_t 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, int objc, Tcl_Obj *const *objv, int publicOnly, Class *startCls); /* 5 */ + int (*tclOOObjectCmdCore) (Object *oPtr, Tcl_Interp *interp, size_t 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, int objc, Tcl_Obj *const *objv); /* 11 */ - void (*tclOOObjectSetFilters) (Object *oPtr, int numFilters, Tcl_Obj *const *filters); /* 12 */ - void (*tclOOClassSetFilters) (Tcl_Interp *interp, Class *classPtr, int numFilters, Tcl_Obj *const *filters); /* 13 */ - void (*tclOOObjectSetMixins) (Object *oPtr, int numMixins, Class *const *mixins); /* 14 */ - void (*tclOOClassSetMixins) (Tcl_Interp *interp, Class *classPtr, int numMixins, Class *const *mixins); /* 15 */ + 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 */ } TclOOIntStubs; extern const TclOOIntStubs *tclOOIntStubsPtr; diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c index 73368e4..70f9503 100644 --- a/generic/tclOOMethod.c +++ b/generic/tclOOMethod.c @@ -147,19 +147,19 @@ TclNewInstanceMethod( int isNew; if (nameObj == NULL) { - mPtr = (Method *)ckalloc(sizeof(Method)); + mPtr = (Method *)Tcl_Alloc(sizeof(Method)); mPtr->namePtr = NULL; mPtr->refCount = 1; goto populate; } if (!oPtr->methodsPtr) { - oPtr->methodsPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable)); + oPtr->methodsPtr = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_InitObjHashTable(oPtr->methodsPtr); oPtr->flags &= ~USE_CLASS_CACHE; } - hPtr = Tcl_CreateHashEntry(oPtr->methodsPtr, (char *) nameObj, &isNew); + hPtr = Tcl_CreateHashEntry(oPtr->methodsPtr, nameObj, &isNew); if (isNew) { - mPtr = (Method *)ckalloc(sizeof(Method)); + mPtr = (Method *)Tcl_Alloc(sizeof(Method)); mPtr->namePtr = nameObj; mPtr->refCount = 1; Tcl_IncrRefCount(nameObj); @@ -263,14 +263,14 @@ TclNewMethod( int isNew; if (nameObj == NULL) { - mPtr = (Method *)ckalloc(sizeof(Method)); + mPtr = (Method *)Tcl_Alloc(sizeof(Method)); mPtr->namePtr = NULL; mPtr->refCount = 1; goto populate; } - hPtr = Tcl_CreateHashEntry(&clsPtr->classMethods, (char *)nameObj,&isNew); + hPtr = Tcl_CreateHashEntry(&clsPtr->classMethods, nameObj,&isNew); if (isNew) { - mPtr = (Method *)ckalloc(sizeof(Method)); + mPtr = (Method *)Tcl_Alloc(sizeof(Method)); mPtr->refCount = 1; mPtr->namePtr = nameObj; Tcl_IncrRefCount(nameObj); @@ -364,7 +364,7 @@ TclOODelMethodRef( Tcl_DecrRefCount(mPtr->namePtr); } - ckfree(mPtr); + Tcl_Free(mPtr); } } @@ -421,14 +421,14 @@ TclOONewProcInstanceMethod( * structure's contents. NULL if caller is not * interested. */ { - int argsLen; + size_t argsLen; ProcedureMethod *pmPtr; Tcl_Method method; if (TclListObjLengthM(interp, argsObj, &argsLen) != TCL_OK) { return NULL; } - pmPtr = (ProcedureMethod *)ckalloc(sizeof(ProcedureMethod)); + pmPtr = (ProcedureMethod *)Tcl_Alloc(sizeof(ProcedureMethod)); memset(pmPtr, 0, sizeof(ProcedureMethod)); pmPtr->version = TCLOO_PROCEDURE_METHOD_VERSION; pmPtr->flags = flags & USE_DECLARER_NS; @@ -437,7 +437,7 @@ TclOONewProcInstanceMethod( method = TclOOMakeProcInstanceMethod(interp, oPtr, flags, nameObj, argsObj, bodyObj, &procMethodType, pmPtr, &pmPtr->procPtr); if (method == NULL) { - ckfree(pmPtr); + Tcl_Free(pmPtr); } else if (pmPtrPtr != NULL) { *pmPtrPtr = pmPtr; } @@ -473,13 +473,13 @@ TclOONewProcMethod( * structure's contents. NULL if caller is not * interested. */ { - int argsLen; /* -1 => delete argsObj before exit */ + size_t argsLen; /* TCL_INDEX_NONE => delete argsObj before exit */ ProcedureMethod *pmPtr; const char *procName; Tcl_Method method; if (argsObj == NULL) { - argsLen = -1; + argsLen = TCL_INDEX_NONE; TclNewObj(argsObj); Tcl_IncrRefCount(argsObj); procName = "<destructor>"; @@ -489,7 +489,7 @@ TclOONewProcMethod( procName = (nameObj==NULL ? "<constructor>" : TclGetString(nameObj)); } - pmPtr = (ProcedureMethod *)ckalloc(sizeof(ProcedureMethod)); + pmPtr = (ProcedureMethod *)Tcl_Alloc(sizeof(ProcedureMethod)); memset(pmPtr, 0, sizeof(ProcedureMethod)); pmPtr->version = TCLOO_PROCEDURE_METHOD_VERSION; pmPtr->flags = flags & USE_DECLARER_NS; @@ -498,11 +498,11 @@ TclOONewProcMethod( method = TclOOMakeProcMethod(interp, clsPtr, flags, nameObj, procName, argsObj, bodyObj, &procMethodType, pmPtr, &pmPtr->procPtr); - if (argsLen == -1) { + if (argsLen == TCL_INDEX_NONE) { Tcl_DecrRefCount(argsObj); } if (method == NULL) { - ckfree(pmPtr); + Tcl_Free(pmPtr); } else if (pmPtrPtr != NULL) { *pmPtrPtr = pmPtr; } @@ -583,12 +583,12 @@ TclOOMakeProcInstanceMethod( if (context.line && (context.nline >= 4) && (context.line[3] >= 0)) { int isNew; - CmdFrame *cfPtr = (CmdFrame *)ckalloc(sizeof(CmdFrame)); + CmdFrame *cfPtr = (CmdFrame *)Tcl_Alloc(sizeof(CmdFrame)); Tcl_HashEntry *hPtr; cfPtr->level = -1; cfPtr->type = context.type; - cfPtr->line = (int *)ckalloc(sizeof(int)); + cfPtr->line = (int *)Tcl_Alloc(sizeof(int)); cfPtr->line[0] = context.line[3]; cfPtr->nline = 1; cfPtr->framePtr = NULL; @@ -601,7 +601,7 @@ TclOOMakeProcInstanceMethod( cfPtr->len = 0; hPtr = Tcl_CreateHashEntry(iPtr->linePBodyPtr, - (char *) procPtr, &isNew); + procPtr, &isNew); Tcl_SetHashValue(hPtr, cfPtr); } @@ -696,12 +696,12 @@ TclOOMakeProcMethod( if (context.line && (context.nline >= 4) && (context.line[3] >= 0)) { int isNew; - CmdFrame *cfPtr = (CmdFrame *)ckalloc(sizeof(CmdFrame)); + CmdFrame *cfPtr = (CmdFrame *)Tcl_Alloc(sizeof(CmdFrame)); Tcl_HashEntry *hPtr; cfPtr->level = -1; cfPtr->type = context.type; - cfPtr->line = (int *)ckalloc(sizeof(int)); + cfPtr->line = (int *)Tcl_Alloc(sizeof(int)); cfPtr->line[0] = context.line[3]; cfPtr->nline = 1; cfPtr->framePtr = NULL; @@ -714,7 +714,7 @@ TclOOMakeProcMethod( cfPtr->len = 0; hPtr = Tcl_CreateHashEntry(iPtr->linePBodyPtr, - (char *) procPtr, &isNew); + procPtr, &isNew); Tcl_SetHashValue(hPtr, cfPtr); } @@ -1073,7 +1073,8 @@ ProcedureMethodCompiledVarConnect( Tcl_Obj *variableObj; PrivateVariableMapping *privateVar; Tcl_HashEntry *hPtr; - int i, isNew, cacheIt, varLen, len; + int isNew, cacheIt; + size_t i, varLen, len; const char *match, *varName; /* @@ -1102,12 +1103,12 @@ ProcedureMethodCompiledVarConnect( * either. */ - varName = TclGetStringFromObj(infoPtr->variableObj, &varLen); + varName = Tcl_GetStringFromObj(infoPtr->variableObj, &varLen); if (contextPtr->callPtr->chain[contextPtr->index] .mPtr->declaringClassPtr != NULL) { FOREACH_STRUCT(privateVar, contextPtr->callPtr->chain[contextPtr->index] .mPtr->declaringClassPtr->privateVariables) { - match = TclGetStringFromObj(privateVar->variableObj, &len); + match = Tcl_GetStringFromObj(privateVar->variableObj, &len); if ((len == varLen) && !memcmp(match, varName, len)) { variableObj = privateVar->fullNameObj; cacheIt = 0; @@ -1116,7 +1117,7 @@ ProcedureMethodCompiledVarConnect( } FOREACH(variableObj, contextPtr->callPtr->chain[contextPtr->index] .mPtr->declaringClassPtr->variables) { - match = TclGetStringFromObj(variableObj, &len); + match = Tcl_GetStringFromObj(variableObj, &len); if ((len == varLen) && !memcmp(match, varName, len)) { cacheIt = 0; goto gotMatch; @@ -1124,7 +1125,7 @@ ProcedureMethodCompiledVarConnect( } } else { FOREACH_STRUCT(privateVar, contextPtr->oPtr->privateVariables) { - match = TclGetStringFromObj(privateVar->variableObj, &len); + match = Tcl_GetStringFromObj(privateVar->variableObj, &len); if ((len == varLen) && !memcmp(match, varName, len)) { variableObj = privateVar->fullNameObj; cacheIt = 1; @@ -1132,7 +1133,7 @@ ProcedureMethodCompiledVarConnect( } } FOREACH(variableObj, contextPtr->oPtr->variables) { - match = TclGetStringFromObj(variableObj, &len); + match = Tcl_GetStringFromObj(variableObj, &len); if ((len == varLen) && !memcmp(match, varName, len)) { cacheIt = 1; goto gotMatch; @@ -1147,7 +1148,7 @@ ProcedureMethodCompiledVarConnect( gotMatch: hPtr = Tcl_CreateHashEntry(TclVarTable(contextPtr->oPtr->namespacePtr), - (char *) variableObj, &isNew); + variableObj, &isNew); if (isNew) { TclSetVarNamespaceVar((Var *) TclVarHashGetValue(hPtr)); } @@ -1180,14 +1181,14 @@ ProcedureMethodCompiledVarDelete( TclCleanupVar((Var *) infoPtr->cachedObjectVar, NULL); } Tcl_DecrRefCount(infoPtr->variableObj); - ckfree(infoPtr); + Tcl_Free(infoPtr); } static int ProcedureMethodCompiledVarResolver( TCL_UNUSED(Tcl_Interp *), const char *varName, - int length, + size_t length, TCL_UNUSED(Tcl_Namespace *), Tcl_ResolvedVarInfo **rPtrPtr) { @@ -1199,13 +1200,13 @@ ProcedureMethodCompiledVarResolver( * which look like array accesses. Both will lead us astray. */ - if (strstr(Tcl_GetString(variableObj), "::") != NULL || - Tcl_StringMatch(Tcl_GetString(variableObj), "*(*)")) { + if (strstr(TclGetString(variableObj), "::") != NULL || + Tcl_StringMatch(TclGetString(variableObj), "*(*)")) { Tcl_DecrRefCount(variableObj); return TCL_CONTINUE; } - infoPtr = (OOResVarInfo *)ckalloc(sizeof(OOResVarInfo)); + infoPtr = (OOResVarInfo *)Tcl_Alloc(sizeof(OOResVarInfo)); infoPtr->info.fetchProc = ProcedureMethodCompiledVarConnect; infoPtr->info.deleteProc = ProcedureMethodCompiledVarDelete; infoPtr->cachedObjectVar = NULL; @@ -1260,7 +1261,7 @@ RenderDeclarerName( #define LIMIT 60 #define ELLIPSIFY(str,len) \ - ((len) > LIMIT ? LIMIT : (len)), (str), ((len) > LIMIT ? "..." : "") + ((len) > LIMIT ? LIMIT : (int)(len)), (str), ((len) > LIMIT ? "..." : "") static void MethodErrorHandler( @@ -1268,11 +1269,11 @@ MethodErrorHandler( TCL_UNUSED(Tcl_Obj *) /*methodNameObj*/) /* We pull the method name out of context instead of from argument */ { - int nameLen, objectNameLen; + size_t nameLen, objectNameLen; CallContext *contextPtr = (CallContext *)((Interp *) interp)->varFramePtr->clientData; Method *mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr; const char *objectName, *kindName, *methodName = - TclGetStringFromObj(mPtr->namePtr, &nameLen); + Tcl_GetStringFromObj(mPtr->namePtr, &nameLen); Object *declarerPtr; if (mPtr->declaringObjectPtr != NULL) { @@ -1304,7 +1305,7 @@ ConstructorErrorHandler( Method *mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr; Object *declarerPtr; const char *objectName, *kindName; - int objectNameLen; + size_t objectNameLen; if (mPtr->declaringObjectPtr != NULL) { declarerPtr = mPtr->declaringObjectPtr; @@ -1334,7 +1335,7 @@ DestructorErrorHandler( Method *mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr; Object *declarerPtr; const char *objectName, *kindName; - int objectNameLen; + size_t objectNameLen; if (mPtr->declaringObjectPtr != NULL) { declarerPtr = mPtr->declaringObjectPtr; @@ -1372,7 +1373,7 @@ DeleteProcedureMethodRecord( if (pmPtr->deleteClientdataProc) { pmPtr->deleteClientdataProc(pmPtr->clientData); } - ckfree(pmPtr); + Tcl_Free(pmPtr); } static void @@ -1423,7 +1424,7 @@ CloneProcedureMethod( */ bodyObj = Tcl_DuplicateObj(pmPtr->procPtr->bodyPtr); - Tcl_GetString(bodyObj); + TclGetString(bodyObj); Tcl_StoreInternalRep(pmPtr->procPtr->bodyPtr, &tclByteCodeType, NULL); /* @@ -1431,7 +1432,7 @@ CloneProcedureMethod( * record. */ - pm2Ptr = (ProcedureMethod *)ckalloc(sizeof(ProcedureMethod)); + pm2Ptr = (ProcedureMethod *)Tcl_Alloc(sizeof(ProcedureMethod)); memcpy(pm2Ptr, pmPtr, sizeof(ProcedureMethod)); pm2Ptr->refCount = 1; Tcl_IncrRefCount(argsObj); @@ -1440,7 +1441,7 @@ CloneProcedureMethod( &pm2Ptr->procPtr) != TCL_OK) { Tcl_DecrRefCount(argsObj); Tcl_DecrRefCount(bodyObj); - ckfree(pm2Ptr); + Tcl_Free(pm2Ptr); return TCL_ERROR; } Tcl_DecrRefCount(argsObj); @@ -1472,7 +1473,7 @@ TclOONewForwardInstanceMethod( Tcl_Obj *prefixObj) /* List of arguments that form the command * prefix to forward to. */ { - int prefixLen; + size_t prefixLen; ForwardMethod *fmPtr; if (TclListObjLengthM(interp, prefixObj, &prefixLen) != TCL_OK) { @@ -1485,7 +1486,7 @@ TclOONewForwardInstanceMethod( return NULL; } - fmPtr = (ForwardMethod *)ckalloc(sizeof(ForwardMethod)); + fmPtr = (ForwardMethod *)Tcl_Alloc(sizeof(ForwardMethod)); fmPtr->prefixObj = prefixObj; Tcl_IncrRefCount(prefixObj); return (Method *) TclNewInstanceMethod(interp, (Tcl_Object) oPtr, @@ -1511,7 +1512,7 @@ TclOONewForwardMethod( Tcl_Obj *prefixObj) /* List of arguments that form the command * prefix to forward to. */ { - int prefixLen; + size_t prefixLen; ForwardMethod *fmPtr; if (TclListObjLengthM(interp, prefixObj, &prefixLen) != TCL_OK) { @@ -1524,7 +1525,7 @@ TclOONewForwardMethod( return NULL; } - fmPtr = (ForwardMethod *)ckalloc(sizeof(ForwardMethod)); + fmPtr = (ForwardMethod *)Tcl_Alloc(sizeof(ForwardMethod)); fmPtr->prefixObj = prefixObj; Tcl_IncrRefCount(prefixObj); return (Method *) TclNewMethod(interp, (Tcl_Class) clsPtr, nameObj, @@ -1553,7 +1554,8 @@ InvokeForwardMethod( CallContext *contextPtr = (CallContext *) context; ForwardMethod *fmPtr = (ForwardMethod *)clientData; Tcl_Obj **argObjs, **prefixObjs; - int numPrefixes, len, skip = contextPtr->skip; + size_t numPrefixes, skip = contextPtr->skip; + int len; /* * Build the real list of arguments to use. Note that we know that the @@ -1605,7 +1607,7 @@ DeleteForwardMethod( ForwardMethod *fmPtr = (ForwardMethod *)clientData; Tcl_DecrRefCount(fmPtr->prefixObj); - ckfree(fmPtr); + Tcl_Free(fmPtr); } static int @@ -1615,7 +1617,7 @@ CloneForwardMethod( void **newClientData) { ForwardMethod *fmPtr = (ForwardMethod *)clientData; - ForwardMethod *fm2Ptr = (ForwardMethod *)ckalloc(sizeof(ForwardMethod)); + ForwardMethod *fm2Ptr = (ForwardMethod *)Tcl_Alloc(sizeof(ForwardMethod)); fm2Ptr->prefixObj = fmPtr->prefixObj; Tcl_IncrRefCount(fm2Ptr->prefixObj); diff --git a/generic/tclObj.c b/generic/tclObj.c index e496b1e..76f1627 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -58,7 +58,7 @@ char tclEmptyString = '\0'; * for sanity checking purposes. */ -typedef struct ObjData { +typedef struct { Tcl_Obj *objPtr; /* The pointer to the allocated Tcl_Obj. */ const char *file; /* The name of the source file calling this * function; used for debugging. */ @@ -178,14 +178,14 @@ static Tcl_ThreadDataKey pendingObjDataKey; #define PACK_BIGNUM(bignum, objPtr) \ if ((bignum).used > 0x7FFF) { \ - mp_int *temp = (mp_int *)ckalloc(sizeof(mp_int)); \ + mp_int *temp = (mp_int *)Tcl_Alloc(sizeof(mp_int)); \ *temp = bignum; \ (objPtr)->internalRep.twoPtrValue.ptr1 = temp; \ (objPtr)->internalRep.twoPtrValue.ptr2 = INT2PTR(-1); \ } else if (((bignum).alloc <= 0x7FFF) || (mp_shrink(&(bignum))) == MP_OKAY) { \ - (objPtr)->internalRep.twoPtrValue.ptr1 = (void *)(bignum).dp; \ - (objPtr)->internalRep.twoPtrValue.ptr2 = INT2PTR(((bignum).sign << 30) \ - | ((bignum).alloc << 15) | ((bignum).used)); \ + (objPtr)->internalRep.twoPtrValue.ptr1 = (bignum).dp; \ + (objPtr)->internalRep.twoPtrValue.ptr2 = INT2PTR( ((bignum).sign << 30) \ + | ((bignum).alloc << 15) | ((bignum).used)); \ } /* @@ -197,9 +197,6 @@ static int SetDoubleFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static int SetIntFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static void UpdateStringOfDouble(Tcl_Obj *objPtr); static void UpdateStringOfInt(Tcl_Obj *objPtr); -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 && !defined(TCL_WIDE_INT_IS_LONG) -static void UpdateStringOfOldInt(Tcl_Obj *objPtr); -#endif static void FreeBignum(Tcl_Obj *objPtr); static void DupBignum(Tcl_Obj *objPtr, Tcl_Obj *copyPtr); static void UpdateStringOfBignum(Tcl_Obj *objPtr); @@ -228,55 +225,37 @@ static int SetCmdNameFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); * implementations. */ -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 -static const Tcl_ObjType oldBooleanType = { - "boolean", /* name */ - NULL, /* freeIntRepProc */ - NULL, /* dupIntRepProc */ - NULL, /* updateStringProc */ - TclSetBooleanFromAny /* setFromAnyProc */ -}; -#endif const Tcl_ObjType tclBooleanType = { - "booleanString", /* name */ + "boolean", /* name */ NULL, /* freeIntRepProc */ NULL, /* dupIntRepProc */ NULL, /* updateStringProc */ - TclSetBooleanFromAny /* setFromAnyProc */ + TclSetBooleanFromAny, /* setFromAnyProc */ + TCL_OBJTYPE_V0 }; const Tcl_ObjType tclDoubleType = { "double", /* name */ NULL, /* freeIntRepProc */ NULL, /* dupIntRepProc */ UpdateStringOfDouble, /* updateStringProc */ - SetDoubleFromAny /* setFromAnyProc */ + SetDoubleFromAny, /* setFromAnyProc */ + TCL_OBJTYPE_V0 }; const Tcl_ObjType tclIntType = { -#if defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8 || defined(TCL_WIDE_INT_IS_LONG) "int", /* name */ -#else - "wideInt", /* name, keeping maximum compatibility with Tcl 8.6 on 32-bit platforms*/ -#endif NULL, /* freeIntRepProc */ NULL, /* dupIntRepProc */ UpdateStringOfInt, /* updateStringProc */ - SetIntFromAny /* setFromAnyProc */ + SetIntFromAny, /* setFromAnyProc */ + TCL_OBJTYPE_V0 }; -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 && !defined(TCL_WIDE_INT_IS_LONG) -static const Tcl_ObjType oldIntType = { - "int", /* name */ - NULL, /* freeIntRepProc */ - NULL, /* dupIntRepProc */ - UpdateStringOfOldInt, /* updateStringProc */ - SetIntFromAny /* setFromAnyProc */ -}; -#endif const Tcl_ObjType tclBignumType = { "bignum", /* name */ FreeBignum, /* freeIntRepProc */ DupBignum, /* dupIntRepProc */ UpdateStringOfBignum, /* updateStringProc */ - NULL /* setFromAnyProc */ + NULL, /* setFromAnyProc */ + TCL_OBJTYPE_V0 }; /* @@ -320,7 +299,8 @@ Tcl_ObjType tclCmdNameType = { FreeCmdNameInternalRep, /* freeIntRepProc */ DupCmdNameInternalRep, /* dupIntRepProc */ NULL, /* updateStringProc */ - SetCmdNameFromAny /* setFromAnyProc */ + SetCmdNameFromAny, /* setFromAnyProc */ + TCL_OBJTYPE_V0 }; /* @@ -336,17 +316,17 @@ typedef struct ResolvedCmdName { * reference (not the namespace that contains * the referenced command). NULL if the name * is fully qualified.*/ - unsigned long refNsId; /* refNsPtr's unique namespace id. Used to + size_t refNsId; /* refNsPtr's unique namespace id. Used to * verify that refNsPtr is still valid (e.g., * it's possible that the cmd's containing * namespace was deleted and a new one created * at the same address). */ - int refNsCmdEpoch; /* Value of the referencing namespace's + size_t 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. */ - int cmdEpoch; /* Value of the command's cmdEpoch when this + size_t 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, @@ -385,11 +365,8 @@ TclInitObjSubsystem(void) Tcl_InitHashTable(&typeTable, TCL_STRING_KEYS); Tcl_MutexUnlock(&tableMutex); - Tcl_RegisterObjType(&tclByteArrayType); Tcl_RegisterObjType(&tclDoubleType); -#if (TCL_UTF_MAX < 4) || !defined(TCL_NO_DEPRECATED) Tcl_RegisterObjType(&tclStringType); -#endif Tcl_RegisterObjType(&tclListType); Tcl_RegisterObjType(&tclDictType); Tcl_RegisterObjType(&tclByteCodeType); @@ -397,15 +374,6 @@ TclInitObjSubsystem(void) Tcl_RegisterObjType(&tclRegexpType); Tcl_RegisterObjType(&tclProcBodyType); - /* For backward compatibility only ... */ -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 - Tcl_RegisterObjType(&tclIntType); -#if !defined(TCL_WIDE_INT_IS_LONG) - Tcl_RegisterObjType(&oldIntType); -#endif - Tcl_RegisterObjType(&oldBooleanType); -#endif - #ifdef TCL_COMPILE_STATS Tcl_MutexLock(&tclObjMutex); tclObjsAlloced = 0; @@ -453,12 +421,12 @@ TclFinalizeThreadObjects(void) ObjData *objData = (ObjData *)Tcl_GetHashValue(hPtr); if (objData != NULL) { - ckfree(objData); + Tcl_Free(objData); } } Tcl_DeleteHashTable(tablePtr); - ckfree(tablePtr); + Tcl_Free(tablePtr); tsdPtr->objThreadMap = NULL; } #endif @@ -534,7 +502,7 @@ TclGetContLineTable(void) ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (!tsdPtr->lineCLPtr) { - tsdPtr->lineCLPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable)); + tsdPtr->lineCLPtr = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(tsdPtr->lineCLPtr, TCL_ONE_WORD_KEYS); Tcl_CreateThreadExitHandler(TclThreadFinalizeContLines,NULL); } @@ -562,14 +530,14 @@ TclGetContLineTable(void) ContLineLoc * TclContinuationsEnter( Tcl_Obj *objPtr, - int num, + size_t num, int *loc) { int newEntry; ThreadSpecificData *tsdPtr = TclGetContLineTable(); Tcl_HashEntry *hPtr = Tcl_CreateHashEntry(tsdPtr->lineCLPtr, objPtr, &newEntry); - ContLineLoc *clLocPtr = (ContLineLoc *)ckalloc(offsetof(ContLineLoc, loc) + (num + 1U) *sizeof(int)); + ContLineLoc *clLocPtr = (ContLineLoc *)Tcl_Alloc(offsetof(ContLineLoc, loc) + (num + 1U) *sizeof(int)); if (!newEntry) { /* @@ -593,7 +561,7 @@ TclContinuationsEnter( * doing. */ - ckfree(Tcl_GetHashValue(hPtr)); + Tcl_Free(Tcl_GetHashValue(hPtr)); } clLocPtr->num = num; @@ -629,7 +597,8 @@ TclContinuationsEnterDerived( int start, int *clNext) { - int length, end, num; + size_t length; + int end, num; int *wordCLLast = clNext; /* @@ -656,7 +625,7 @@ TclContinuationsEnterDerived( * better way which doesn't shimmer?) */ - TclGetStringFromObj(objPtr, &length); + (void)Tcl_GetStringFromObj(objPtr, &length); end = start + length; /* First char after the word */ /* @@ -797,11 +766,11 @@ TclThreadFinalizeContLines( for (hPtr = Tcl_FirstHashEntry(tsdPtr->lineCLPtr, &hSearch); hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) { - ckfree(Tcl_GetHashValue(hPtr)); + Tcl_Free(Tcl_GetHashValue(hPtr)); Tcl_DeleteHashEntry(hPtr); } Tcl_DeleteHashTable(tsdPtr->lineCLPtr); - ckfree(tsdPtr->lineCLPtr); + Tcl_Free(tsdPtr->lineCLPtr); tsdPtr->lineCLPtr = NULL; } @@ -871,7 +840,7 @@ Tcl_AppendAllObjTypes( { Tcl_HashEntry *hPtr; Tcl_HashSearch search; - int numElems; + size_t numElems; /* * Get the test for a valid list out of the way first. @@ -1007,7 +976,7 @@ TclDbDumpActiveObjects( tablePtr = tsdPtr->objThreadMap; if (tablePtr != NULL) { - fprintf(outFile, "total objects: %d\n", tablePtr->numEntries); + fprintf(outFile, "total objects: %" TCL_Z_MODIFIER "u\n", tablePtr->numEntries); for (hPtr = Tcl_FirstHashEntry(tablePtr, &hSearch); hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) { ObjData *objData = (ObjData *)Tcl_GetHashValue(hPtr); @@ -1077,7 +1046,7 @@ TclDbInitNewObj( ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (tsdPtr->objThreadMap == NULL) { - tsdPtr->objThreadMap = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable)); + tsdPtr->objThreadMap = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(tsdPtr->objThreadMap, TCL_ONE_WORD_KEYS); } tablePtr = tsdPtr->objThreadMap; @@ -1090,7 +1059,7 @@ TclDbInitNewObj( * Record the debugging information. */ - objData = (ObjData *)ckalloc(sizeof(ObjData)); + objData = (ObjData *)Tcl_Alloc(sizeof(ObjData)); objData->objPtr = objPtr; objData->file = file; objData->line = line; @@ -1213,7 +1182,7 @@ Tcl_DbNewObj( * TclAllocateFreeObjects -- * * Function to allocate a number of free Tcl_Objs. This is done using a - * single ckalloc to reduce the overhead for Tcl_Obj allocation. + * single Tcl_Alloc to reduce the overhead for Tcl_Obj allocation. * * Assumes mutex is held. * @@ -1242,12 +1211,12 @@ TclAllocateFreeObjects(void) * This has been noted by Purify to be a potential leak. The problem is * that Tcl, when not TCL_MEM_DEBUG compiled, keeps around all allocated * Tcl_Obj's, pointed to by tclFreeObjList, when freed instead of actually - * freeing the memory. TclFinalizeObjects() does not ckfree() this memory, + * freeing the memory. TclFinalizeObjects() does not Tcl_Free() this memory, * but leaves it to Tcl's memory subsystem finalization to release it. * Purify apparently can't figure that out, and fires a false alarm. */ - basePtr = (char *)ckalloc(bytesToAlloc); + basePtr = (char *)Tcl_Alloc(bytesToAlloc); prevPtr = NULL; objPtr = (Tcl_Obj *) basePtr; @@ -1313,7 +1282,7 @@ TclFreeObj( if (!tablePtr) { Tcl_Panic("TclFreeObj: object table not initialized"); } - hPtr = Tcl_FindHashEntry(tablePtr, (char *) objPtr); + hPtr = Tcl_FindHashEntry(tablePtr, objPtr); if (hPtr) { /* * As the Tcl_Obj is going to be deleted we remove the entry. @@ -1322,7 +1291,7 @@ TclFreeObj( ObjData *objData = (ObjData *)Tcl_GetHashValue(hPtr); if (objData != NULL) { - ckfree(objData); + Tcl_Free(objData); } Tcl_DeleteHashEntry(hPtr); @@ -1336,7 +1305,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 < -1) { + if (objPtr->refCount == (size_t)-2) { Tcl_Panic("Reference count for %p was negative", objPtr); } /* @@ -1344,16 +1313,16 @@ TclFreeObj( * sure we do not accept a second free when falling from 0 to -1. * Skip that possibility so any double free will trigger the panic. */ - objPtr->refCount = -1; + objPtr->refCount = TCL_INDEX_NONE; /* * Invalidate the string rep first so we can use the bytes value for our * pointer chain, and signal an obj deletion (as opposed to shimmering) - * with 'length == -1'. + * with 'length == TCL_INDEX_NONE'. */ TclInvalidateStringRep(objPtr); - objPtr->length = -1; + objPtr->length = TCL_INDEX_NONE; if (ObjDeletePending(context)) { PushObjToDelete(context, objPtr); @@ -1366,7 +1335,7 @@ TclFreeObj( } Tcl_MutexLock(&tclObjMutex); - ckfree(objPtr); + Tcl_Free(objPtr); Tcl_MutexUnlock(&tclObjMutex); TclIncrObjsFreed(); ObjDeletionLock(context); @@ -1378,7 +1347,7 @@ TclFreeObj( TclFreeInternalRep(objToFree); Tcl_MutexLock(&tclObjMutex); - ckfree(objToFree); + Tcl_Free(objToFree); Tcl_MutexUnlock(&tclObjMutex); TclIncrObjsFreed(); } @@ -1402,7 +1371,7 @@ TclFreeObj( if (tsdPtr->lineCLPtr) { hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr); if (hPtr) { - ckfree(Tcl_GetHashValue(hPtr)); + Tcl_Free(Tcl_GetHashValue(hPtr)); Tcl_DeleteHashEntry(hPtr); } } @@ -1421,7 +1390,7 @@ TclFreeObj( */ TclInvalidateStringRep(objPtr); - objPtr->length = -1; + objPtr->length = TCL_INDEX_NONE; if (!objPtr->typePtr || !objPtr->typePtr->freeIntRepProc) { /* @@ -1493,7 +1462,7 @@ TclFreeObj( if (tsdPtr->lineCLPtr) { hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr); if (hPtr) { - ckfree(Tcl_GetHashValue(hPtr)); + Tcl_Free(Tcl_GetHashValue(hPtr)); Tcl_DeleteHashEntry(hPtr); } } @@ -1523,7 +1492,7 @@ int TclObjBeingDeleted( Tcl_Obj *objPtr) { - return (objPtr->length == -1); + return (objPtr->length == TCL_INDEX_NONE); } /* @@ -1643,7 +1612,7 @@ Tcl_GetString( objPtr->typePtr->name); } objPtr->typePtr->updateStringProc(objPtr); - if (objPtr->bytes == NULL || objPtr->length < 0 + if (objPtr->bytes == NULL || objPtr->length == TCL_INDEX_NONE || objPtr->bytes[objPtr->length] != '\0') { Tcl_Panic("UpdateStringProc for type '%s' " "failed to create a valid string rep", @@ -1676,9 +1645,9 @@ Tcl_GetString( *---------------------------------------------------------------------- */ -#undef Tcl_GetStringFromObj +#undef TclGetStringFromObj char * -Tcl_GetStringFromObj( +TclGetStringFromObj( Tcl_Obj *objPtr, /* Object whose string rep byte pointer should * be returned. */ int *lengthPtr) /* If non-NULL, the location where the string @@ -1703,7 +1672,7 @@ Tcl_GetStringFromObj( objPtr->typePtr->name); } objPtr->typePtr->updateStringProc(objPtr); - if (objPtr->bytes == NULL || objPtr->length < 0 + if (objPtr->bytes == NULL || objPtr->length == TCL_INDEX_NONE || objPtr->bytes[objPtr->length] != '\0') { Tcl_Panic("UpdateStringProc for type '%s' " "failed to create a valid string rep", @@ -1711,14 +1680,18 @@ Tcl_GetStringFromObj( } } if (lengthPtr != NULL) { - *lengthPtr = objPtr->length; + if (objPtr->length > INT_MAX) { + Tcl_Panic("Tcl_GetStringFromObj with 'int' lengthPtr" + "cannot handle such long strings. Please use 'size_t'"); + } + *lengthPtr = (int)objPtr->length; } return objPtr->bytes; } -#undef TclGetStringFromObj +#undef Tcl_GetStringFromObj char * -TclGetStringFromObj( +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 @@ -1743,7 +1716,7 @@ TclGetStringFromObj( objPtr->typePtr->name); } objPtr->typePtr->updateStringProc(objPtr); - if (objPtr->bytes == NULL || objPtr->length < 0 + if (objPtr->bytes == NULL || objPtr->bytes[objPtr->length] != '\0') { Tcl_Panic("UpdateStringProc for type '%s' " "failed to create a valid string rep", @@ -1751,11 +1724,7 @@ TclGetStringFromObj( } } if (lengthPtr != NULL) { -#if TCL_MAJOR_VERSION > 8 *lengthPtr = objPtr->length; -#else - *lengthPtr = ((size_t)(unsigned)(objPtr->length + 1)) - 1; -#endif } return objPtr->bytes; } @@ -1770,15 +1739,15 @@ TclGetStringFromObj( * the tools needed to set an object's string representation. The * function is determined by the arguments. * - * (objPtr->bytes != NULL && bytes != NULL) || (numBytes < 0) + * (objPtr->bytes != NULL && bytes != NULL) || (numBytes == -1) * Invalid call -- panic! * - * objPtr->bytes == NULL && bytes == NULL && numBytes >= 0 + * objPtr->bytes == NULL && bytes == NULL && numBytes != -1 * Allocation only - allocate space for (numBytes+1) chars. * store in objPtr->bytes and return. Also sets * objPtr->length to 0 and objPtr->bytes[0] to NUL. * - * objPtr->bytes == NULL && bytes != NULL && numBytes >= 0 + * objPtr->bytes == NULL && bytes != NULL && numBytes != -1 * Allocate and copy. bytes is assumed to point to chars to * copy into the string rep. objPtr->length = numBytes. Allocate * array of (numBytes + 1) chars. store in objPtr->bytes. Copy @@ -1787,7 +1756,7 @@ TclGetStringFromObj( * Caller must guarantee there are numBytes chars at bytes to * be copied. * - * objPtr->bytes != NULL && bytes == NULL && numBytes >= 0 + * objPtr->bytes != NULL && bytes == NULL && numBytes != -1 * Truncate. Set objPtr->length to numBytes and * objPr->bytes[numBytes] to NUL. Caller has to guarantee * that a prior allocating call allocated enough bytes for @@ -1809,23 +1778,19 @@ char * Tcl_InitStringRep( Tcl_Obj *objPtr, /* Object whose string rep is to be set */ const char *bytes, - unsigned int numBytes) + size_t numBytes) { assert(objPtr->bytes == NULL || bytes == NULL); - if (numBytes > INT_MAX) { - Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); - } - if (objPtr->bytes == NULL) { /* Start with no string rep */ if (numBytes == 0) { TclInitStringRep(objPtr, NULL, 0); return objPtr->bytes; } else { - objPtr->bytes = (char *)attemptckalloc(numBytes + 1); + objPtr->bytes = (char *)Tcl_AttemptAlloc(numBytes + 1); if (objPtr->bytes) { - objPtr->length = (int) numBytes; + objPtr->length = numBytes; if (bytes) { memcpy(objPtr->bytes, bytes, numBytes); } @@ -1837,23 +1802,23 @@ Tcl_InitStringRep( if (numBytes == 0) { return objPtr->bytes; } else { - objPtr->bytes = (char *)attemptckalloc(numBytes + 1); + objPtr->bytes = (char *)Tcl_AttemptAlloc(numBytes + 1); if (objPtr->bytes) { - objPtr->length = (int) numBytes; + objPtr->length = numBytes; objPtr->bytes[objPtr->length] = '\0'; } } } else { /* Start with non-empty string rep (allocated) */ if (numBytes == 0) { - ckfree(objPtr->bytes); + Tcl_Free(objPtr->bytes); TclInitStringRep(objPtr, NULL, 0); return objPtr->bytes; } else { - objPtr->bytes = (char *)attemptckrealloc(objPtr->bytes, + objPtr->bytes = (char *)Tcl_AttemptRealloc(objPtr->bytes, numBytes + 1); if (objPtr->bytes) { - objPtr->length = (int) numBytes; + objPtr->length = numBytes; objPtr->bytes[objPtr->length] = '\0'; } } @@ -1912,12 +1877,11 @@ Tcl_HasStringRep( * * Tcl_StoreInternalRep -- * - * This function is called to set the object's internal - * representation to match a particular type. + * Called to set the object's internal representation to match a + * particular type. * - * It is the caller's responsibility to guarantee that - * the value of the submitted internalrep is in agreement with - * the value of any existing string rep. + * It is the caller's resonsibility to ensure that the given IntRep is + * appropriate for the existing string. * * Results: * None. @@ -1933,14 +1897,16 @@ void Tcl_StoreInternalRep( Tcl_Obj *objPtr, /* Object whose internal rep should be set. */ const Tcl_ObjType *typePtr, /* New type for the object */ - const Tcl_ObjInternalRep *irPtr) /* New internalrep for the object */ + const Tcl_ObjInternalRep *irPtr) /* New IntRep for the object */ { - /* Clear out any existing internalrep ( "shimmer" ) */ + /* Clear out any existing IntRep. This is the point where shimmering, i.e. + * repeated alteration of the type of the internal representation, may + * occur. */ TclFreeInternalRep(objPtr); - /* When irPtr == NULL, just leave objPtr with no internalrep for typePtr */ + /* When irPtr == NULL, just leave objPtr with no IntRep for typePtr */ if (irPtr) { - /* Copy the new internalrep into place */ + /* Copy the new IntRep into place */ objPtr->internalRep = *irPtr; /* Set the type to match */ @@ -2002,145 +1968,6 @@ Tcl_FreeInternalRep( /* *---------------------------------------------------------------------- * - * Tcl_NewBooleanObj -- - * - * This function is normally called when not debugging: i.e., when - * TCL_MEM_DEBUG is not defined. It creates a new Tcl_Obj and - * initializes it from the argument boolean value. A nonzero "intValue" - * is coerced to 1. - * - * When TCL_MEM_DEBUG is defined, this function just returns the result - * of calling the debugging version Tcl_DbNewLongObj. - * - * Results: - * The newly created object is returned. This object will have an invalid - * string representation. The returned object has ref count 0. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -#undef Tcl_NewBooleanObj -#ifdef TCL_MEM_DEBUG - -Tcl_Obj * -Tcl_NewBooleanObj( - int intValue) /* Boolean used to initialize new object. */ -{ - return Tcl_DbNewWideIntObj(intValue!=0, "unknown", 0); -} - -#else /* if not TCL_MEM_DEBUG */ - -Tcl_Obj * -Tcl_NewBooleanObj( - int intValue) /* Boolean used to initialize new object. */ -{ - Tcl_Obj *objPtr; - - TclNewIntObj(objPtr, intValue!=0); - return objPtr; -} -#endif /* TCL_MEM_DEBUG */ - -/* - *---------------------------------------------------------------------- - * - * Tcl_DbNewBooleanObj -- - * - * This function is normally called when debugging: i.e., when - * TCL_MEM_DEBUG is defined. It creates new boolean objects. It is the - * same as the Tcl_NewBooleanObj function above except that it calls - * Tcl_DbCkalloc directly with the file name and line number from its - * caller. This simplifies debugging since then the [memory active] - * command will report the correct file name and line number when - * reporting objects that haven't been freed. - * - * When TCL_MEM_DEBUG is not defined, this function just returns the - * result of calling Tcl_NewBooleanObj. - * - * Results: - * The newly created object is returned. This object will have an invalid - * string representation. The returned object has ref count 0. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -#ifndef TCL_NO_DEPRECATED -#undef Tcl_DbNewBooleanObj -#ifdef TCL_MEM_DEBUG - -Tcl_Obj * -Tcl_DbNewBooleanObj( - int intValue, /* Boolean used to initialize new object. */ - const char *file, /* The name of the source file calling this - * function; used for debugging. */ - int line) /* Line number in the source file; used for - * debugging. */ -{ - Tcl_Obj *objPtr; - - TclDbNewObj(objPtr, file, line); - /* Optimized TclInvalidateStringRep() */ - objPtr->bytes = NULL; - - objPtr->internalRep.wideValue = (intValue != 0); - objPtr->typePtr = &tclIntType; - return objPtr; -} - -#else /* if not TCL_MEM_DEBUG */ - -Tcl_Obj * -Tcl_DbNewBooleanObj( - int intValue, /* Boolean used to initialize new object. */ - TCL_UNUSED(const char *) /*file*/, - TCL_UNUSED(int) /*line*/) -{ - return Tcl_NewBooleanObj(intValue); -} -#endif /* TCL_MEM_DEBUG */ - -/* - *---------------------------------------------------------------------- - * - * Tcl_SetBooleanObj -- - * - * Modify an object to be a boolean object and to have the specified - * boolean value. A nonzero "intValue" is coerced to 1. - * - * Results: - * None. - * - * Side effects: - * The object's old string rep, if any, is freed. Also, any old internal - * rep is freed. - * - *---------------------------------------------------------------------- - */ - -#undef Tcl_SetBooleanObj -void -Tcl_SetBooleanObj( - Tcl_Obj *objPtr, /* Object whose internal rep to init. */ - int intValue) /* Boolean used to set object's value. */ -{ - if (Tcl_IsShared(objPtr)) { - Tcl_Panic("%s called with shared object", "Tcl_SetBooleanObj"); - } - - TclSetIntObj(objPtr, intValue!=0); -} -#endif /* TCL_NO_DEPRECATED */ - -/* - *---------------------------------------------------------------------- - * * Tcl_GetBoolFromObj, Tcl_GetBooleanFromObj -- * * Attempt to return a boolean from the Tcl object "objPtr". This @@ -2180,14 +2007,10 @@ Tcl_GetBoolFromObj( return TCL_ERROR; } do { - if (objPtr->typePtr == &tclIntType) { + if (objPtr->typePtr == &tclIntType || objPtr->typePtr == &tclBooleanType) { result = (objPtr->internalRep.wideValue != 0); goto boolEnd; } - if (objPtr->typePtr == &tclBooleanType) { - result = objPtr->internalRep.longValue != 0; - goto boolEnd; - } if (objPtr->typePtr == &tclDoubleType) { /* * Caution: Don't be tempted to check directly for the "double" @@ -2256,12 +2079,7 @@ Tcl_GetBooleanFromObj( * * Side effects: * If no error occurs, an integer 1 or 0 is stored as "objPtr"s internal - * representation and the type of "objPtr" is set to boolean or int/wideInt. - * - * Warning: If the returned type is "wideInt" (32-bit platforms) and your - * platform is bigendian, you cannot use internalRep.longValue to distinguish - * between false and true. On Windows and most other platforms this still will - * work fine, but basically it is non-portable. + * representation and the type of "objPtr" is set to boolean or int. * *---------------------------------------------------------------------- */ @@ -2300,7 +2118,7 @@ TclSetBooleanFromAny( badBoolean: if (interp != NULL) { - int length; + size_t length; const char *str = Tcl_GetStringFromObj(objPtr, &length); Tcl_Obj *msg; @@ -2319,8 +2137,8 @@ ParseBoolean( { int newBool; char lowerCase[6]; - const char *str = TclGetString(objPtr); - size_t i, length = objPtr->length; + size_t i, length; + const char *str = Tcl_GetStringFromObj(objPtr, &length); if ((length == 0) || (length > 5)) { /* @@ -2419,7 +2237,7 @@ ParseBoolean( goodBoolean: TclFreeInternalRep(objPtr); - objPtr->internalRep.longValue = newBool; + objPtr->internalRep.wideValue = newBool; objPtr->typePtr = &tclBooleanType; return TCL_OK; @@ -2654,8 +2472,7 @@ SetDoubleFromAny( * UpdateStringOfDouble -- * * Update the string representation for a double-precision floating point - * object. This must obey the current tcl_precision value for - * double-to-string conversions. Note: This function does not free an + * object. Note: This function does not free an * existing old string rep so storage will be lost if this has not * already been done. * @@ -2675,7 +2492,7 @@ UpdateStringOfDouble( { char *dst = Tcl_InitStringRep(objPtr, NULL, TCL_DOUBLE_SPACE); - TclOOM(dst, TCL_DOUBLE_SPACE + 1); + TclOOM(dst, (size_t)TCL_DOUBLE_SPACE + 1); Tcl_PrintDouble(NULL, objPtr->internalRep.doubleValue, dst); (void) Tcl_InitStringRep(objPtr, NULL, strlen(dst)); @@ -2684,112 +2501,28 @@ UpdateStringOfDouble( /* *---------------------------------------------------------------------- * - * Tcl_NewIntObj -- - * - * If a client is compiled with TCL_MEM_DEBUG defined, calls to - * Tcl_NewIntObj to create a new integer object end up calling the - * debugging function Tcl_DbNewLongObj instead. - * - * Otherwise, if the client is compiled without TCL_MEM_DEBUG defined, - * calls to Tcl_NewIntObj result in a call to one of the two - * Tcl_NewIntObj implementations below. We provide two implementations so - * that the Tcl core can be compiled to do memory debugging of the core - * even if a client does not request it for itself. - * - * Integer and long integer objects share the same "integer" type - * implementation. We store all integers as longs and Tcl_GetIntFromObj - * checks whether the current value of the long can be represented by an - * int. - * - * Results: - * The newly created object is returned. This object will have an invalid - * string representation. The returned object has ref count 0. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -#ifndef TCL_NO_DEPRECATED -#undef Tcl_NewIntObj -#ifdef TCL_MEM_DEBUG - -Tcl_Obj * -Tcl_NewIntObj( - int intValue) /* Int used to initialize the new object. */ -{ - return Tcl_DbNewWideIntObj(intValue, "unknown", 0); -} - -#else /* if not TCL_MEM_DEBUG */ - -Tcl_Obj * -Tcl_NewIntObj( - int intValue) /* Int used to initialize the new object. */ -{ - Tcl_Obj *objPtr; - - TclNewIntObj(objPtr, intValue); - return objPtr; -} -#endif /* if TCL_MEM_DEBUG */ -#endif /* TCL_NO_DEPRECATED */ - -/* - *---------------------------------------------------------------------- + * Tcl_GetIntFromObj -- * - * Tcl_SetIntObj -- + * Retrieve the integer value of 'objPtr'. * - * Modify an object to be an integer and to have the specified integer - * value. + * Value * - * Results: - * None. - * - * Side effects: - * The object's old string rep, if any, is freed. Also, any old internal - * rep is freed. + * TCL_OK * - *---------------------------------------------------------------------- - */ -#ifndef TCL_NO_DEPRECATED -#undef Tcl_SetIntObj -void -Tcl_SetIntObj( - Tcl_Obj *objPtr, /* Object whose internal rep to init. */ - int intValue) /* Integer used to set object's value. */ -{ - if (Tcl_IsShared(objPtr)) { - Tcl_Panic("%s called with shared object", "Tcl_SetIntObj"); - } - - TclSetIntObj(objPtr, intValue); -} -#endif /* TCL_NO_DEPRECATED */ - -/* - *---------------------------------------------------------------------- + * Success. * - * Tcl_GetIntFromObj -- + * TCL_ERROR * - * Attempt to return an int from the Tcl object "objPtr". If the object - * is not already an int, an attempt will be made to convert it to one. + * An error occurred during conversion or the integral value can not + * be represented as an integer (it might be too large). An error + * message is left in the interpreter's result if 'interp' is not + * NULL. * - * Integer and long integer objects share the same "integer" type - * implementation. We store all integers as longs and Tcl_GetIntFromObj - * checks whether the current value of the long can be represented by an - * int. + * Effect * - * Results: - * The return value is a standard Tcl object result. If an error occurs - * during conversion or if the long integer held by the object can not be - * represented by an int, an error message is left in the interpreter's - * result unless "interp" is NULL. - * - * Side effects: - * If the object is not already an int, the conversion will free any old - * internal representation. + * 'objPtr' is converted to an integer if necessary if it is not one + * already. The conversion frees any previously-existing internal + * representation. * *---------------------------------------------------------------------- */ @@ -2873,184 +2606,10 @@ UpdateStringOfInt( { char *dst = Tcl_InitStringRep( objPtr, NULL, TCL_INTEGER_SPACE); - TclOOM(dst, TCL_INTEGER_SPACE + 1); + TclOOM(dst, (size_t)TCL_INTEGER_SPACE + 1); (void) Tcl_InitStringRep(objPtr, NULL, TclFormatInt(dst, objPtr->internalRep.wideValue)); } - -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 && !defined(TCL_WIDE_INT_IS_LONG) -static void -UpdateStringOfOldInt( - Tcl_Obj *objPtr) /* Int object whose string rep to update. */ -{ - char *dst = Tcl_InitStringRep( objPtr, NULL, TCL_INTEGER_SPACE); - - TclOOM(dst, TCL_INTEGER_SPACE + 1); - (void) Tcl_InitStringRep(objPtr, NULL, - TclFormatInt(dst, objPtr->internalRep.longValue)); -} -#endif - -/* - *---------------------------------------------------------------------- - * - * Tcl_NewLongObj -- - * - * If a client is compiled with TCL_MEM_DEBUG defined, calls to - * Tcl_NewLongObj to create a new long integer object end up calling the - * debugging function Tcl_DbNewLongObj instead. - * - * Otherwise, if the client is compiled without TCL_MEM_DEBUG defined, - * calls to Tcl_NewLongObj result in a call to one of the two - * Tcl_NewLongObj implementations below. We provide two implementations - * so that the Tcl core can be compiled to do memory debugging of the - * core even if a client does not request it for itself. - * - * Integer and long integer objects share the same "integer" type - * implementation. We store all integers as longs and Tcl_GetIntFromObj - * checks whether the current value of the long can be represented by an - * int. - * - * Results: - * The newly created object is returned. This object will have an invalid - * string representation. The returned object has ref count 0. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -#ifndef TCL_NO_DEPRECATED -#undef Tcl_NewLongObj -#ifdef TCL_MEM_DEBUG - -Tcl_Obj * -Tcl_NewLongObj( - long longValue) /* Long integer used to initialize the - * new object. */ -{ - return Tcl_DbNewWideIntObj(longValue, "unknown", 0); -} - -#else /* if not TCL_MEM_DEBUG */ - -Tcl_Obj * -Tcl_NewLongObj( - long longValue) /* Long integer used to initialize the - * new object. */ -{ - Tcl_Obj *objPtr; - - TclNewIntObj(objPtr, longValue); - return objPtr; -} -#endif /* if TCL_MEM_DEBUG */ -#endif /* TCL_NO_DEPRECATED */ - -/* - *---------------------------------------------------------------------- - * - * Tcl_DbNewLongObj -- - * - * If a client is compiled with TCL_MEM_DEBUG defined, calls to - * Tcl_NewIntObj and Tcl_NewLongObj to create new integer or long integer - * objects end up calling the debugging function Tcl_DbNewLongObj - * instead. We provide two implementations of Tcl_DbNewLongObj so that - * whether the Tcl core is compiled to do memory debugging of the core is - * independent of whether a client requests debugging for itself. - * - * When the core is compiled with TCL_MEM_DEBUG defined, Tcl_DbNewLongObj - * calls Tcl_DbCkalloc directly with the file name and line number from - * its caller. This simplifies debugging since then the [memory active] - * command will report the caller's file name and line number when - * reporting objects that haven't been freed. - * - * Otherwise, when the core is compiled without TCL_MEM_DEBUG defined, - * this function just returns the result of calling Tcl_NewLongObj. - * - * Results: - * The newly created long integer object is returned. This object will - * have an invalid string representation. The returned object has ref - * count 0. - * - * Side effects: - * Allocates memory. - * - *---------------------------------------------------------------------- - */ - -#ifndef TCL_NO_DEPRECATED -#undef Tcl_DbNewLongObj -#ifdef TCL_MEM_DEBUG - -Tcl_Obj * -Tcl_DbNewLongObj( - long longValue, /* Long integer used to initialize the new - * object. */ - const char *file, /* The name of the source file calling this - * function; used for debugging. */ - int line) /* Line number in the source file; used for - * debugging. */ -{ - Tcl_Obj *objPtr; - - TclDbNewObj(objPtr, file, line); - /* Optimized TclInvalidateStringRep */ - objPtr->bytes = NULL; - - objPtr->internalRep.wideValue = longValue; - objPtr->typePtr = &tclIntType; - return objPtr; -} - -#else /* if not TCL_MEM_DEBUG */ - -Tcl_Obj * -Tcl_DbNewLongObj( - long longValue, /* Long integer used to initialize the new - * object. */ - TCL_UNUSED(const char *) /*file*/, - TCL_UNUSED(int) /*line*/) -{ - return Tcl_NewWideIntObj(longValue); -} -#endif /* TCL_MEM_DEBUG */ -#endif /* TCL_NO_DEPRECATED */ - -/* - *---------------------------------------------------------------------- - * - * Tcl_SetLongObj -- - * - * Modify an object to be an integer object and to have the specified - * long integer value. - * - * Results: - * None. - * - * Side effects: - * The object's old string rep, if any, is freed. Also, any old internal - * rep is freed. - * - *---------------------------------------------------------------------- - */ - -#ifndef TCL_NO_DEPRECATED -#undef Tcl_SetLongObj -void -Tcl_SetLongObj( - Tcl_Obj *objPtr, /* Object whose internal rep to init. */ - long longValue) /* Long integer used to initialize the - * object's value. */ -{ - if (Tcl_IsShared(objPtr)) { - Tcl_Panic("%s called with shared object", "Tcl_SetLongObj"); - } - - TclSetIntObj(objPtr, longValue); -} -#endif /* TCL_NO_DEPRECATED */ /* *---------------------------------------------------------------------- @@ -3574,7 +3133,7 @@ FreeBignum( TclUnpackBignum(objPtr, toFree); mp_clear(&toFree); if (PTR2INT(objPtr->internalRep.twoPtrValue.ptr2) < 0) { - ckfree(objPtr->internalRep.twoPtrValue.ptr1); + Tcl_Free(objPtr->internalRep.twoPtrValue.ptr1); } objPtr->typePtr = NULL; } @@ -4135,7 +3694,7 @@ int Tcl_IsShared( Tcl_Obj *objPtr) /* The object to test for being shared. */ { - return ((objPtr)->refCount > 1); + return ((objPtr)->refCount + 1 > 2); } /* @@ -4419,7 +3978,7 @@ AllocObjEntry( void *keyPtr) /* Key to store in the hash table entry. */ { Tcl_Obj *objPtr = (Tcl_Obj *)keyPtr; - Tcl_HashEntry *hPtr = (Tcl_HashEntry *)ckalloc(sizeof(Tcl_HashEntry)); + Tcl_HashEntry *hPtr = (Tcl_HashEntry *)Tcl_Alloc(sizeof(Tcl_HashEntry)); hPtr->key.objPtr = objPtr; Tcl_IncrRefCount(objPtr); @@ -4451,7 +4010,7 @@ TclCompareObjKeys( Tcl_HashEntry *hPtr) /* Existing key to compare. */ { Tcl_Obj *objPtr1 = (Tcl_Obj *)keyPtr; - Tcl_Obj *objPtr2 = (Tcl_Obj *) hPtr->key.oneWordValue; + Tcl_Obj *objPtr2 = (Tcl_Obj *)hPtr->key.oneWordValue; const char *p1, *p2; size_t l1, l2; @@ -4513,7 +4072,7 @@ TclFreeObjEntry( Tcl_Obj *objPtr = (Tcl_Obj *) hPtr->key.oneWordValue; Tcl_DecrRefCount(objPtr); - ckfree(hPtr); + Tcl_Free(hPtr); } /* @@ -4540,7 +4099,7 @@ TclHashObjKey( void *keyPtr) /* Key from which to compute hash value. */ { Tcl_Obj *objPtr = (Tcl_Obj *)keyPtr; - int length; + size_t length; const char *string = Tcl_GetStringFromObj(objPtr, &length); TCL_HASH_TYPE result = 0; @@ -4578,7 +4137,7 @@ TclHashObjKey( * See [tcl-Feature Request #2958832] */ - if (length > 0) { + if (length) { result = UCHAR(*string); while (--length) { result += (result << 3) + UCHAR(*++string); @@ -4703,7 +4262,7 @@ SetCmdNameObj( if (resPtr) { fillPtr = resPtr; } else { - fillPtr = (ResolvedCmdName *)ckalloc(sizeof(ResolvedCmdName)); + fillPtr = (ResolvedCmdName *)Tcl_Alloc(sizeof(ResolvedCmdName)); fillPtr->refCount = 1; } @@ -4806,7 +4365,7 @@ FreeCmdNameInternalRep( Command *cmdPtr = resPtr->cmdPtr; TclCleanupCommandMacro(cmdPtr); - ckfree(resPtr); + Tcl_Free(resPtr); } objPtr->typePtr = NULL; } @@ -4955,7 +4514,7 @@ Tcl_RepresentationCmd( * "1872361827361287" */ - descObj = Tcl_ObjPrintf("value is a %s with a refcount of %d," + descObj = Tcl_ObjPrintf("value is a %s with a refcount of %" TCL_Z_MODIFIER "u," " object pointer at %p", objv[1]->typePtr ? objv[1]->typePtr->name : "pure string", objv[1]->refCount, objv[1]); diff --git a/generic/tclOptimize.c b/generic/tclOptimize.c index de28b0c..7d3bc7b 100644 --- a/generic/tclOptimize.c +++ b/generic/tclOptimize.c @@ -28,7 +28,7 @@ static void TrimUnreachable(CompileEnv *envPtr); */ #define DefineTargetAddress(tablePtr, address) \ - ((void) Tcl_CreateHashEntry((tablePtr), (void *) (address), &isNew)) + ((void) Tcl_CreateHashEntry((tablePtr), (address), &isNew)) #define IsTargetAddress(tablePtr, address) \ (Tcl_FindHashEntry((tablePtr), (void *) (address)) != NULL) #define AddrLength(address) \ @@ -54,7 +54,8 @@ LocateTargetAddresses( Tcl_HashTable *tablePtr) { unsigned char *currentInstPtr, *targetInstPtr; - int isNew, i; + int isNew; + size_t i; Tcl_HashEntry *hPtr; Tcl_HashSearch hSearch; @@ -133,7 +134,7 @@ LocateTargetAddresses( } else { targetInstPtr = envPtr->codeStart + rangePtr->breakOffset; DefineTargetAddress(tablePtr, targetInstPtr); - if (rangePtr->continueOffset >= 0) { + if (rangePtr->continueOffset != TCL_INDEX_NONE) { targetInstPtr = envPtr->codeStart + rangePtr->continueOffset; DefineTargetAddress(tablePtr, targetInstPtr); } @@ -231,9 +232,9 @@ ConvertZeroEffectToNOP( && TclGetUInt1AtPtr(currentInstPtr + size + 1) == 2) { Tcl_Obj *litPtr = TclFetchLiteral(envPtr, TclGetUInt1AtPtr(currentInstPtr + 1)); - int numBytes; + size_t numBytes; - (void) TclGetStringFromObj(litPtr, &numBytes); + (void) Tcl_GetStringFromObj(litPtr, &numBytes); if (numBytes == 0) { blank = size + InstLength(nextInst); } @@ -246,9 +247,9 @@ ConvertZeroEffectToNOP( && TclGetUInt1AtPtr(currentInstPtr + size + 1) == 2) { Tcl_Obj *litPtr = TclFetchLiteral(envPtr, TclGetUInt4AtPtr(currentInstPtr + 1)); - int numBytes; + size_t numBytes; - (void) TclGetStringFromObj(litPtr, &numBytes); + (void) Tcl_GetStringFromObj(litPtr, &numBytes); if (numBytes == 0) { blank = size + InstLength(nextInst); } @@ -287,8 +288,6 @@ ConvertZeroEffectToNOP( case INST_INCR_ARRAY_STK: case INST_INCR_SCALAR_STK: case INST_INCR_STK: - case INST_LOR: - case INST_LAND: case INST_EQ: case INST_NEQ: case INST_LT: diff --git a/generic/tclPanic.c b/generic/tclPanic.c index ba7e801..1d7e992 100644 --- a/generic/tclPanic.c +++ b/generic/tclPanic.c @@ -15,7 +15,7 @@ #include "tclInt.h" #if defined(_WIN32) || defined(__CYGWIN__) - MODULE_SCOPE TCL_NORETURN void tclWinDebugPanic(const char *format, ...); + MODULE_SCOPE void tclWinDebugPanic(const char *format, ...); #endif /* @@ -23,11 +23,7 @@ * procedure. */ -#if defined(__CYGWIN__) || (defined(_WIN32) && (defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8)) -static TCL_NORETURN1 Tcl_PanicProc *panicProc = tclWinDebugPanic; -#else static TCL_NORETURN1 Tcl_PanicProc *panicProc = NULL; -#endif /* *---------------------------------------------------------------------- @@ -45,19 +41,10 @@ static TCL_NORETURN1 Tcl_PanicProc *panicProc = NULL; *---------------------------------------------------------------------- */ -#undef Tcl_SetPanicProc const char * Tcl_SetPanicProc( TCL_NORETURN1 Tcl_PanicProc *proc) { -#if defined(_WIN32) - /* tclWinDebugPanic only installs if there is no panicProc yet. */ - if (((Tcl_PanicProc *)proc != tclWinDebugPanic) || (panicProc == NULL)) -#elif defined(__CYGWIN__) - if (proc == NULL) - panicProc = tclWinDebugPanic; - else -#endif panicProc = proc; return Tcl_InitSubsystems(); } @@ -65,7 +52,7 @@ Tcl_SetPanicProc( /* *---------------------------------------------------------------------- * - * Tcl_PanicVA -- + * Tcl_Panic -- * * Print an error message and kill the process. * @@ -78,16 +65,24 @@ Tcl_SetPanicProc( *---------------------------------------------------------------------- */ +/* + * The following comment is here so that Coverity's static analizer knows that + * a Tcl_Panic() call can never return and avoids lots of false positives. + */ + +/* coverity[+kill] */ void -Tcl_PanicVA( - const char *format, /* Format string, suitable for passing to - * fprintf. */ - va_list argList) /* Variable argument list. */ +Tcl_Panic( + const char *format, + ...) { + va_list argList; char *arg1, *arg2, *arg3; /* Additional arguments (variable in number) * to pass to fprintf. */ char *arg4, *arg5, *arg6, *arg7, *arg8; + + va_start(argList, format); arg1 = va_arg(argList, char *); arg2 = va_arg(argList, char *); arg3 = va_arg(argList, char *); @@ -96,29 +91,28 @@ Tcl_PanicVA( arg6 = va_arg(argList, char *); arg7 = va_arg(argList, char *); arg8 = va_arg(argList, char *); + va_end (argList); if (panicProc != NULL) { panicProc(format, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8); -#ifdef _WIN32 - } else if (IsDebuggerPresent()) { - tclWinDebugPanic(format, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8); -#endif } else { +#if defined(_WIN32) || defined(__CYGWIN__) + tclWinDebugPanic(format, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8); +#else fprintf(stderr, format, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8); fprintf(stderr, "\n"); fflush(stderr); -#if defined(_WIN32) || defined(__CYGWIN__) +#endif # if defined(__GNUC__) __builtin_trap(); # elif defined(_WIN64) __debugbreak(); # elif defined(_MSC_VER) && defined (_M_IX86) _asm {int 3} -# else +# elif defined(_WIN32) DebugBreak(); # endif -#endif #if defined(_WIN32) ExitProcess(1); #else @@ -128,40 +122,6 @@ Tcl_PanicVA( } /* - *---------------------------------------------------------------------- - * - * Tcl_Panic -- - * - * Print an error message and kill the process. - * - * Results: - * None. - * - * Side effects: - * The process dies, entering the debugger if possible. - * - *---------------------------------------------------------------------- - */ - -/* - * The following comment is here so that Coverity's static analizer knows that - * a Tcl_Panic() call can never return and avoids lots of false positives. - */ - -/* coverity[+kill] */ -void -Tcl_Panic( - const char *format, - ...) -{ - va_list argList; - - va_start(argList, format); - Tcl_PanicVA(format, argList); - va_end (argList); -} - -/* * Local Variables: * mode: c * c-basic-offset: 4 diff --git a/generic/tclParse.c b/generic/tclParse.c index 4de0356..1209a3b 100644 --- a/generic/tclParse.c +++ b/generic/tclParse.c @@ -33,12 +33,13 @@ * meaning in ParseTokens: backslash, dollar sign, or * open bracket. * TYPE_QUOTE - Character is a double quote. + * TYPE_OPEN_PAREN - Character is a left parenthesis. * TYPE_CLOSE_PAREN - Character is a right parenthesis. * TYPE_CLOSE_BRACK - Character is a right square bracket. * TYPE_BRACE - Character is a curly brace (either left or right). */ -const char tclCharTypeTable[] = { +const unsigned char tclCharTypeTable[] = { /* * Positive character values, from 0-127: @@ -54,7 +55,7 @@ const char tclCharTypeTable[] = { TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_SPACE, TYPE_NORMAL, TYPE_QUOTE, TYPE_NORMAL, TYPE_SUBS, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, - TYPE_NORMAL, TYPE_CLOSE_PAREN, TYPE_NORMAL, TYPE_NORMAL, + TYPE_OPEN_PAREN, TYPE_CLOSE_PAREN, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, @@ -119,16 +120,16 @@ const char tclCharTypeTable[] = { * Prototypes for local functions defined in this file: */ -static int CommandComplete(const char *script, int numBytes); -static int ParseComment(const char *src, int numBytes, +static int CommandComplete(const char *script, size_t numBytes); +static size_t ParseComment(const char *src, size_t numBytes, Tcl_Parse *parsePtr); -static int ParseTokens(const char *src, int numBytes, int mask, +static int ParseTokens(const char *src, size_t numBytes, int mask, int flags, Tcl_Parse *parsePtr); -static int ParseWhiteSpace(const char *src, int numBytes, +static size_t ParseWhiteSpace(const char *src, size_t numBytes, int *incompletePtr, char *typePtr); -static int ParseAllWhiteSpace(const char *src, int numBytes, +static size_t ParseAllWhiteSpace(const char *src, size_t numBytes, int *incompletePtr); -static int ParseHex(const char *src, int numBytes, +static int ParseHex(const char *src, size_t numBytes, int *resultPtr); /* @@ -151,7 +152,7 @@ void TclParseInit( Tcl_Interp *interp, /* Interpreter to use for error reporting */ const char *start, /* Start of string to be parsed. */ - int numBytes, /* Total number of bytes in string. If < 0, + size_t 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 */ @@ -197,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. */ - int numBytes, /* Total number of bytes in string. If < 0, + size_t 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: @@ -209,7 +210,7 @@ Tcl_ParseCommand( * the parsed command; any previous * information in the structure is ignored. */ { - const char *src; /* Points to current character in the + const char *src; /* Points to current character in the * command. */ char type; /* Result returned by CHAR_TYPE(*src). */ Tcl_Token *tokenPtr; /* Pointer to token being filled in. */ @@ -218,9 +219,9 @@ Tcl_ParseCommand( * command. */ const char *termPtr; /* Set by Tcl_ParseBraces/QuotedString to * point to char after terminating one. */ - int scanned; + size_t scanned; - if (numBytes < 0 && start) { + if (numBytes == TCL_INDEX_NONE && start) { numBytes = strlen(start); } TclParseInit(interp, start, numBytes, parsePtr); @@ -344,9 +345,9 @@ Tcl_ParseCommand( expPtr = &parsePtr->tokenPtr[expIdx]; if ((0 == expandWord) /* Haven't seen prefix already */ - && (1 == parsePtr->numTokens - expIdx) + && (expIdx + 1 == (int)parsePtr->numTokens) /* Only one token */ - && (((1 == (size_t) expPtr->size) + && (((1 == expPtr->size) /* Same length as prefix */ && (expPtr->start[0] == '*'))) /* Is the prefix */ @@ -379,9 +380,10 @@ Tcl_ParseCommand( tokenPtr = &parsePtr->tokenPtr[wordIndex]; tokenPtr->size = src - tokenPtr->start; - tokenPtr->numComponents = parsePtr->numTokens - (wordIndex + 1); + tokenPtr->numComponents = (int)parsePtr->numTokens - (wordIndex + 1); if (expandWord) { - int i, isLiteral = 1; + size_t i; + int isLiteral = 1; /* * When a command includes a word that is an expanded literal; for @@ -427,7 +429,7 @@ Tcl_ParseCommand( */ while (nextElem < listEnd) { - int size; + size_t size; code = TclFindElement(NULL, nextElem, listEnd - nextElem, &elemStart, &nextElem, &size, &literal); @@ -470,7 +472,7 @@ Tcl_ParseCommand( const char *listStart; int growthNeeded = wordIndex + 2*elemCount - - parsePtr->numTokens; + - (int)parsePtr->numTokens; parsePtr->numWords += elemCount - 1; if (growthNeeded > 0) { @@ -619,10 +621,10 @@ TclIsBareword( *---------------------------------------------------------------------- */ -static int +static size_t ParseWhiteSpace( const char *src, /* First character to parse. */ - int numBytes, /* Max number of bytes to scan. */ + size_t 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 @@ -673,17 +675,17 @@ ParseWhiteSpace( *---------------------------------------------------------------------- */ -static int +static size_t ParseAllWhiteSpace( const char *src, /* First character to parse. */ - int numBytes, /* Max number of byes to scan */ + size_t numBytes, /* Max number of byes to scan */ int *incompletePtr) /* Set true if parse is incomplete. */ { char type; const char *p = src; do { - int scanned = ParseWhiteSpace(p, numBytes, incompletePtr, &type); + size_t scanned = ParseWhiteSpace(p, numBytes, incompletePtr, &type); p += scanned; numBytes -= scanned; @@ -691,10 +693,10 @@ ParseAllWhiteSpace( return (p-src); } -int +size_t TclParseAllWhiteSpace( const char *src, /* First character to parse. */ - int numBytes) /* Max number of byes to scan */ + size_t numBytes) /* Max number of byes to scan */ { int dummy; return ParseAllWhiteSpace(src, numBytes, &dummy); @@ -725,8 +727,8 @@ TclParseAllWhiteSpace( int ParseHex( const char *src, /* First character to parse. */ - int numBytes, /* Max number of byes to scan */ - int *resultPtr) /* Points to storage provided by caller where + size_t 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,8 +783,8 @@ int TclParseBackslash( const char *src, /* Points to the backslash character of a a * backslash sequence. */ - int numBytes, /* Max number of bytes to scan. */ - int *readPtr, /* NULL, or points to storage where the number + size_t numBytes, /* Max number of bytes to scan. */ + size_t *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 @@ -791,7 +793,7 @@ TclParseBackslash( const char *p = src+1; int unichar; int result; - int count; + size_t count; char buf[4] = ""; if (numBytes == 0) { @@ -868,6 +870,7 @@ TclParseBackslash( * No hexdigits -> This is just "u". */ result = 'u'; +#if TCL_UTF_MAX < 4 } else if (((result & 0xFC00) == 0xD800) && (count == 6) && (p[5] == '\\') && (p[6] == 'u') && (numBytes >= 10)) { /* If high surrogate is immediately followed by a low surrogate @@ -878,6 +881,7 @@ TclParseBackslash( result = ((result & 0x3FF)<<10 | (low & 0x3FF)) + 0x10000; count += count2 + 2; } +#endif } break; case 'U': @@ -887,9 +891,6 @@ TclParseBackslash( * No hexdigits -> This is just "U". */ result = 'U'; - } else if ((result | 0x7FF) == 0xDFFF) { - /* Upper or lower surrogate, not allowed in this syntax. */ - result = 0xFFFD; } break; case '\n': @@ -953,10 +954,12 @@ TclParseBackslash( *readPtr = count; } count = Tcl_UniCharToUtf(result, dst); +#if TCL_UTF_MAX < 4 if ((result >= 0xD800) && (count < 3)) { /* Special case for handling high surrogates. */ count += Tcl_UniCharToUtf(-1, dst + count); } +#endif return count; } @@ -978,10 +981,10 @@ TclParseBackslash( *---------------------------------------------------------------------- */ -static int +static size_t ParseComment( const char *src, /* First character to parse. */ - int numBytes, /* Max number of bytes to scan. */ + size_t numBytes, /* Max number of bytes to scan. */ Tcl_Parse *parsePtr) /* Information about parse in progress. * Updated if parsing indicates an incomplete * command. */ @@ -990,7 +993,7 @@ ParseComment( int incomplete = parsePtr->incomplete; while (numBytes) { - int scanned = ParseAllWhiteSpace(p, numBytes, &incomplete); + size_t scanned = ParseAllWhiteSpace(p, numBytes, &incomplete); p += scanned; numBytes -= scanned; @@ -1054,7 +1057,7 @@ ParseComment( static int ParseTokens( const char *src, /* First character to parse. */ - int numBytes, /* Max number of bytes to scan. */ + size_t 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 @@ -1229,7 +1232,7 @@ ParseTokens( */ if (mask & TYPE_SPACE) { - if (parsePtr->numTokens == originalTokens) { + if ((int)parsePtr->numTokens == originalTokens) { goto finishToken; } break; @@ -1250,7 +1253,7 @@ ParseTokens( Tcl_Panic("ParseTokens encountered unknown character"); } } - if (parsePtr->numTokens == originalTokens) { + if ((int)parsePtr->numTokens == originalTokens) { /* * There was nothing in this range of text. Add an empty token for the * empty range, so that there is always at least one token added. @@ -1294,7 +1297,7 @@ Tcl_FreeParse( * call to Tcl_ParseCommand. */ { if (parsePtr->tokenPtr != parsePtr->staticTokens) { - ckfree(parsePtr->tokenPtr); + Tcl_Free(parsePtr->tokenPtr); parsePtr->tokenPtr = parsePtr->staticTokens; } } @@ -1332,7 +1335,7 @@ Tcl_ParseVarName( * NULL, then no error message is provided. */ const char *start, /* Start of variable substitution string. * First character must be "$". */ - int numBytes, /* Total number of bytes in string. If < 0, + size_t 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 @@ -1347,7 +1350,7 @@ Tcl_ParseVarName( int varIndex; unsigned array; - if (numBytes < 0 && start) { + if (numBytes == TCL_INDEX_NONE && start) { numBytes = strlen(start); } if (!append) { @@ -1396,15 +1399,28 @@ Tcl_ParseVarName( */ if (*src == '{') { + char ch; int braceCount = 0; src++; numBytes--; tokenPtr->type = TCL_TOKEN_TEXT; tokenPtr->start = src; tokenPtr->numComponents = 0; - while (numBytes && (*src != '}')) { + ch = *src; + while (numBytes && (braceCount>0 || ch != '}')) { + switch (ch) { + case '{': braceCount++; break; + case '}': braceCount--; break; + case '\\': + /* if 2 or more left, consume 2, else consume + just the \ and let it run into the end */ + if (numBytes > 1) { + src++; numBytes--; + } + } numBytes--; src++; + ch= *src; } if (numBytes == 0) { if (parsePtr->interp != NULL) { @@ -1460,11 +1476,11 @@ Tcl_ParseVarName( * any number of substitutions. */ - if (TCL_OK != ParseTokens(src+1, numBytes-1, TYPE_CLOSE_PAREN, + if (TCL_OK != ParseTokens(src+1, numBytes-1, TYPE_BAD_ARRAY_INDEX, TCL_SUBST_ALL, parsePtr)) { goto error; } - if ((parsePtr->term == src+numBytes) || (*parsePtr->term != ')')){ + if (parsePtr->term == src+numBytes){ if (parsePtr->interp != NULL) { Tcl_SetObjResult(parsePtr->interp, Tcl_NewStringObj( "missing )", -1)); @@ -1473,6 +1489,14 @@ Tcl_ParseVarName( parsePtr->term = src; parsePtr->incomplete = 1; goto error; + } else if ((*parsePtr->term != ')')){ + if (parsePtr->interp != NULL) { + Tcl_SetObjResult(parsePtr->interp, Tcl_NewStringObj( + "invalid character in array index", -1)); + } + parsePtr->errorType = TCL_PARSE_SYNTAX; + parsePtr->term = src; + goto error; } src = parsePtr->term + 1; } @@ -1609,7 +1633,7 @@ Tcl_ParseBraces( * NULL, then no error message is provided. */ const char *start, /* Start of string enclosed in braces. The * first character must be {'. */ - int numBytes, /* Total number of bytes in string. If < 0, + size_t numBytes, /* Total number of bytes in string. If -1, * the string consists of all bytes up to the * first null character. */ Tcl_Parse *parsePtr, @@ -1626,9 +1650,10 @@ Tcl_ParseBraces( { Tcl_Token *tokenPtr; const char *src; - int startIndex, level, length; + int startIndex, level; + size_t length; - if (numBytes < 0 && start) { + if (numBytes == TCL_INDEX_NONE && start) { numBytes = strlen(start); } if (!append) { @@ -1677,7 +1702,7 @@ Tcl_ParseBraces( */ if ((src != tokenPtr->start) - || (parsePtr->numTokens == startIndex)) { + || ((int)parsePtr->numTokens == startIndex)) { tokenPtr->size = (src - tokenPtr->start); parsePtr->numTokens++; } @@ -1810,7 +1835,7 @@ Tcl_ParseQuotedString( * NULL, then no error message is provided. */ const char *start, /* Start of the quoted string. The first * character must be '"'. */ - int numBytes, /* Total number of bytes in string. If < 0, + size_t numBytes, /* Total number of bytes in string. If -1, * the string consists of all bytes up to the * first null character. */ Tcl_Parse *parsePtr, @@ -1825,7 +1850,7 @@ Tcl_ParseQuotedString( * the quoted string's terminating close-quote * if the parse succeeds. */ { - if (numBytes < 0 && start) { + if (numBytes == TCL_INDEX_NONE && start) { numBytes = strlen(start); } if (!append) { @@ -1891,12 +1916,12 @@ void TclSubstParse( Tcl_Interp *interp, const char *bytes, - int numBytes, + size_t numBytes, int flags, Tcl_Parse *parsePtr, Tcl_InterpState *statePtr) { - int length = numBytes; + size_t length = numBytes; const char *p = bytes; TclParseInit(interp, p, length, parsePtr); @@ -2090,12 +2115,12 @@ TclSubstTokens( * errors. */ Tcl_Token *tokenPtr, /* Pointer to first in an array of tokens to * evaluate and concatenate. */ - int count, /* Number of tokens to consider at tokenPtr. + size_t 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 */ - int line, /* The line the script starts on. */ + size_t 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 @@ -2117,7 +2142,8 @@ TclSubstTokens( Tcl_Obj *result; int code = TCL_OK; #define NUM_STATIC_POS 20 - int isLiteral, maxNumCL, numCL, i, adjust; + int isLiteral; + size_t i, maxNumCL, numCL, adjust; int *clPosition = NULL; Interp *iPtr = (Interp *) interp; int inFile = iPtr->evalFlags & TCL_EVAL_FILE; @@ -2153,7 +2179,7 @@ TclSubstTokens( if (isLiteral) { maxNumCL = NUM_STATIC_POS; - clPosition = (int *)ckalloc(maxNumCL * sizeof(int)); + clPosition = (int *)Tcl_Alloc(maxNumCL * sizeof(int)); } adjust = 0; @@ -2193,17 +2219,17 @@ TclSubstTokens( if ((appendByteLength == 1) && (utfCharBytes[0] == ' ') && (tokenPtr->start[1] == '\n')) { if (isLiteral) { - int clPos; + size_t clPos; if (result == 0) { clPos = 0; } else { - TclGetStringFromObj(result, &clPos); + (void)Tcl_GetStringFromObj(result, &clPos); } if (numCL >= maxNumCL) { maxNumCL *= 2; - clPosition = (int *)ckrealloc(clPosition, + clPosition = (int *)Tcl_Realloc(clPosition, maxNumCL * sizeof(int)); } clPosition[numCL] = clPos; @@ -2222,7 +2248,7 @@ TclSubstTokens( * Test cases: info-30.{6,8,9} */ - int theline; + size_t theline; TclAdvanceContinuations(&line, &clNextOuter, tokenPtr->start - outerScript); @@ -2361,7 +2387,7 @@ TclSubstTokens( */ if (maxNumCL) { - ckfree(clPosition); + Tcl_Free(clPosition); } } else { Tcl_ResetResult(interp); @@ -2399,7 +2425,7 @@ TclSubstTokens( static int CommandComplete( const char *script, /* Script to check. */ - int numBytes) /* Number of bytes in script. */ + size_t numBytes) /* Number of bytes in script. */ { Tcl_Parse parse; const char *p, *end; @@ -2447,7 +2473,7 @@ int Tcl_CommandComplete( const char *script) /* Script to check. */ { - return CommandComplete(script, (int) strlen(script)); + return CommandComplete(script, strlen(script)); } /* @@ -2473,8 +2499,8 @@ TclObjCommandComplete( Tcl_Obj *objPtr) /* Points to object holding script to * check. */ { - int length; - const char *script = TclGetStringFromObj(objPtr, &length); + size_t length; + const char *script = Tcl_GetStringFromObj(objPtr, &length); return CommandComplete(script, length); } diff --git a/generic/tclParse.h b/generic/tclParse.h index 5f75c9a..b28ac8c 100644 --- a/generic/tclParse.h +++ b/generic/tclParse.h @@ -11,7 +11,9 @@ #define TYPE_CLOSE_PAREN 0x10 #define TYPE_CLOSE_BRACK 0x20 #define TYPE_BRACE 0x40 +#define TYPE_OPEN_PAREN 0x80 +#define TYPE_BAD_ARRAY_INDEX (TYPE_OPEN_PAREN|TYPE_CLOSE_PAREN|TYPE_QUOTE|TYPE_BRACE) #define CHAR_TYPE(c) tclCharTypeTable[(unsigned char)(c)] -MODULE_SCOPE const char tclCharTypeTable[]; +MODULE_SCOPE const unsigned char tclCharTypeTable[]; diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c index 87aed3a..d0826b7 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 int FindSplitPos(const char *path, int separator); +static size_t FindSplitPos(const char *path, int separator); static int IsSeparatorOrNull(int ch); static Tcl_Obj * GetExtension(Tcl_Obj *pathPtr); static int MakePathFromNormalized(Tcl_Interp *interp, @@ -41,7 +41,8 @@ static const Tcl_ObjType fsPathType = { FreeFsPathInternalRep, /* freeIntRepProc */ DupFsPathInternalRep, /* dupIntRepProc */ UpdateStringOfFsPath, /* updateStringProc */ - SetFsPathFromAny /* setFromAnyProc */ + SetFsPathFromAny, /* setFromAnyProc */ + TCL_OBJTYPE_V0 }; /* @@ -50,7 +51,7 @@ static const Tcl_ObjType fsPathType = { * Internal representation of a Tcl_Obj of fsPathType */ -typedef struct FsPath { +typedef struct { Tcl_Obj *translatedPathPtr; /* If the path has been normalized (flags == * 0), this is NULL. Otherwise it is a path * in which any ~user sequences have been @@ -66,7 +67,7 @@ typedef struct FsPath { * below. */ ClientData nativePathPtr; /* Native representation of this path, which * is filesystem dependent. */ - int filesystemEpoch; /* Used to ensure the path representation was + size_t filesystemEpoch; /* Used to ensure the path representation was * generated during the correct filesystem * epoch. The epoch changes when * filesystem-mounts are changed. */ @@ -205,14 +206,14 @@ TclFSNormalizeAbsolutePath( /* * Need to skip '.' in the path. */ - int curLen; + size_t curLen; if (retVal == NULL) { const char *path = TclGetString(pathPtr); retVal = Tcl_NewStringObj(path, dirSep - path); Tcl_IncrRefCount(retVal); } - TclGetStringFromObj(retVal, &curLen); + (void)Tcl_GetStringFromObj(retVal, &curLen); if (curLen == 0) { Tcl_AppendToObj(retVal, dirSep, 1); } @@ -225,7 +226,7 @@ TclFSNormalizeAbsolutePath( } if (dirSep[2] == '.' && IsSeparatorOrNull(dirSep[3])) { Tcl_Obj *linkObj; - int curLen; + size_t curLen; char *linkStr; /* @@ -238,7 +239,7 @@ TclFSNormalizeAbsolutePath( retVal = Tcl_NewStringObj(path, dirSep - path); Tcl_IncrRefCount(retVal); } - TclGetStringFromObj(retVal, &curLen); + (void)Tcl_GetStringFromObj(retVal, &curLen); if (curLen == 0) { Tcl_AppendToObj(retVal, dirSep, 1); } @@ -269,9 +270,9 @@ TclFSNormalizeAbsolutePath( */ const char *path = - TclGetStringFromObj(retVal, &curLen); + Tcl_GetStringFromObj(retVal, &curLen); - while (--curLen >= 0) { + while (curLen-- > 0) { if (IsSeparatorOrNull(path[curLen])) { break; } @@ -284,7 +285,7 @@ TclFSNormalizeAbsolutePath( Tcl_SetObjLength(retVal, curLen+1); Tcl_AppendObjToObj(retVal, linkObj); TclDecrRefCount(linkObj); - linkStr = TclGetStringFromObj(retVal, &curLen); + linkStr = Tcl_GetStringFromObj(retVal, &curLen); } else { /* * Absolute link. @@ -297,14 +298,14 @@ TclFSNormalizeAbsolutePath( } else { retVal = linkObj; } - linkStr = TclGetStringFromObj(retVal, &curLen); + linkStr = Tcl_GetStringFromObj(retVal, &curLen); /* * Convert to forward-slashes on windows. */ if (tclPlatform == TCL_PLATFORM_WINDOWS) { - int i; + size_t i; for (i = 0; i < curLen; i++) { if (linkStr[i] == '\\') { @@ -314,7 +315,7 @@ TclFSNormalizeAbsolutePath( } } } else { - linkStr = TclGetStringFromObj(retVal, &curLen); + linkStr = Tcl_GetStringFromObj(retVal, &curLen); } /* @@ -322,7 +323,7 @@ TclFSNormalizeAbsolutePath( * not the first character of the path). */ - while (--curLen >= 0) { + while (curLen-- > 0) { if (IsSeparatorOrNull(linkStr[curLen])) { if (curLen) { Tcl_SetObjLength(retVal, curLen); @@ -384,8 +385,8 @@ TclFSNormalizeAbsolutePath( */ if (tclPlatform == TCL_PLATFORM_WINDOWS) { - int len; - const char *path = TclGetStringFromObj(retVal, &len); + size_t len; + const char *path = Tcl_GetStringFromObj(retVal, &len); if (len == 2 && path[0] != 0 && path[1] == ':') { if (Tcl_IsShared(retVal)) { @@ -476,7 +477,7 @@ Tcl_PathType TclFSGetPathType( Tcl_Obj *pathPtr, const Tcl_Filesystem **filesystemPtrPtr, - int *driveNameLengthPtr) + size_t *driveNameLengthPtr) { FsPath *fsPathPtr; @@ -540,7 +541,7 @@ TclFSGetPathType( Tcl_Obj * TclPathPart( - Tcl_Interp *interp, /* Used for error reporting */ + TCL_UNUSED(Tcl_Interp *), /* Used for error reporting */ Tcl_Obj *pathPtr, /* Path to take dirname of */ Tcl_PathPart portion) /* Requested portion of name */ { @@ -558,9 +559,8 @@ TclPathPart( * the standardPath code. */ - int numBytes; - const char *rest = - TclGetStringFromObj(fsPathPtr->normPathPtr, &numBytes); + size_t numBytes; + const char *rest = Tcl_GetStringFromObj(fsPathPtr->normPathPtr, &numBytes); if (strchr(rest, '/') != NULL) { goto standardPath; @@ -596,9 +596,8 @@ TclPathPart( * we don't, and instead just use the standardPath code. */ - int numBytes; - const char *rest = - TclGetStringFromObj(fsPathPtr->normPathPtr, &numBytes); + size_t numBytes; + const char *rest = Tcl_GetStringFromObj(fsPathPtr->normPathPtr, &numBytes); if (strchr(rest, '/') != NULL) { goto standardPath; @@ -625,9 +624,9 @@ TclPathPart( return GetExtension(fsPathPtr->normPathPtr); case TCL_PATH_ROOT: { const char *fileName, *extension; - int length; + size_t length; - fileName = TclGetStringFromObj(fsPathPtr->normPathPtr, + fileName = Tcl_GetStringFromObj(fsPathPtr->normPathPtr, &length); extension = TclGetExtension(fileName); if (extension == NULL) { @@ -648,7 +647,7 @@ TclPathPart( Tcl_Obj *resultPtr = TclNewFSPathObj(fsPathPtr->cwdPtr, fileName, - (int)(length - strlen(extension))); + length - strlen(extension)); Tcl_IncrRefCount(resultPtr); return resultPtr; @@ -668,7 +667,7 @@ TclPathPart( goto standardPath; } } else { - int splitElements; + size_t splitElements; Tcl_Obj *splitPtr, *resultPtr; standardPath: @@ -676,17 +675,17 @@ TclPathPart( if (portion == TCL_PATH_EXTENSION) { return GetExtension(pathPtr); } else if (portion == TCL_PATH_ROOT) { - int length; + size_t length; const char *fileName, *extension; - fileName = TclGetStringFromObj(pathPtr, &length); + fileName = Tcl_GetStringFromObj(pathPtr, &length); extension = TclGetExtension(fileName); if (extension == NULL) { Tcl_IncrRefCount(pathPtr); return pathPtr; } else { Tcl_Obj *root = Tcl_NewStringObj(fileName, - (int) (length - strlen(extension))); + length - strlen(extension)); Tcl_IncrRefCount(root); return root; @@ -701,18 +700,8 @@ TclPathPart( splitPtr = Tcl_FSSplitPath(pathPtr, &splitElements); Tcl_IncrRefCount(splitPtr); - if (splitElements == 1 && TclGetString(pathPtr)[0] == '~') { - Tcl_Obj *norm; - TclDecrRefCount(splitPtr); - norm = Tcl_FSGetNormalizedPath(interp, pathPtr); - if (norm == NULL) { - return NULL; - } - splitPtr = Tcl_FSSplitPath(norm, &splitElements); - Tcl_IncrRefCount(splitPtr); - } - if (portion == TCL_PATH_TAIL) { + if (portion == TCL_PATH_TAIL) { /* * Return the last component, unless it is the only component, and * it is the root of an absolute path. @@ -806,17 +795,17 @@ Tcl_Obj * Tcl_FSJoinPath( Tcl_Obj *listObj, /* Path elements to join, may have a zero * reference count. */ - int elements) /* Number of elements to use (-1 = all) */ + size_t elements) /* Number of elements to use (-1 = all) */ { Tcl_Obj *res; - int objc; + size_t objc; Tcl_Obj **objv; if (TclListObjLengthM(NULL, listObj, &objc) != TCL_OK) { return NULL; } - elements = ((elements >= 0) && (elements <= objc)) ? elements : objc; + elements = ((elements != TCL_INDEX_NONE) && (elements <= objc)) ? elements : objc; TclListObjGetElementsM(NULL, listObj, &objc, &objv); res = TclJoinPath(elements, objv, 0); return res; @@ -824,17 +813,15 @@ Tcl_FSJoinPath( Tcl_Obj * TclJoinPath( - int elements, /* Number of elements to use (-1 = all) */ + size_t 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) */ { Tcl_Obj *res = NULL; - int i; + size_t i; const Tcl_Filesystem *fsPtr = NULL; - assert ( elements >= 0 ); - if (elements == 0) { TclNewObj(res); return res; @@ -869,9 +856,9 @@ TclJoinPath( TclGetPathType(tailObj, NULL, NULL, NULL); if (type == TCL_PATH_RELATIVE) { const char *str; - int len; + size_t len; - str = TclGetStringFromObj(tailObj, &len); + str = Tcl_GetStringFromObj(tailObj, &len); if (len == 0) { /* * This happens if we try to handle the root volume '/'. @@ -900,7 +887,7 @@ TclJoinPath( */ if ((tclPlatform != TCL_PLATFORM_WINDOWS) - || (strchr(Tcl_GetString(elt), '\\') == NULL)) { + || (strchr(TclGetString(elt), '\\') == NULL)) { if (PATHFLAGS(elt)) { return TclNewFSPathObj(elt, str, len); @@ -936,13 +923,14 @@ TclJoinPath( assert ( res == NULL ); for (i = 0; i < elements; i++) { - int driveNameLength, strEltLen, length; + size_t driveNameLength; + size_t strEltLen, length; Tcl_PathType type; char *strElt, *ptr; Tcl_Obj *driveName = NULL; Tcl_Obj *elt = objv[i]; - strElt = TclGetStringFromObj(elt, &strEltLen); + strElt = Tcl_GetStringFromObj(elt, &strEltLen); driveNameLength = 0; /* if forceRelative - all paths excepting first one are relative */ type = (forceRelative && (i > 0)) ? TCL_PATH_RELATIVE : @@ -1039,20 +1027,10 @@ TclJoinPath( if (res == NULL) { TclNewObj(res); } - ptr = TclGetStringFromObj(res, &length); - - /* - * Strip off any './' before a tilde, unless this is the beginning of - * the path. - */ - - if (length > 0 && strEltLen > 0 && (strElt[0] == '.') && - (strElt[1] == '/') && (strElt[2] == '~')) { - strElt += 2; - } + ptr = Tcl_GetStringFromObj(res, &length); - /* - * A NULL value for fsPtr at this stage basically means we're trying + /* + * A NULL value for fsPtr at this stage basically means we're trying * to join a relative path onto something which is also relative (or * empty). There's nothing particularly wrong with that. */ @@ -1084,9 +1062,9 @@ TclJoinPath( if (length > 0 && ptr[length -1] != '/') { Tcl_AppendToObj(res, &separator, 1); - TclGetStringFromObj(res, &length); + (void)Tcl_GetStringFromObj(res, &length); } - Tcl_SetObjLength(res, length + (int) strlen(strElt)); + Tcl_SetObjLength(res, length + strlen(strElt)); ptr = TclGetString(res) + length; for (; *strElt != '\0'; strElt++) { @@ -1188,7 +1166,7 @@ IsSeparatorOrNull( * of the end of the string. */ -static int +static size_t FindSplitPos( const char *path, int separator) @@ -1242,14 +1220,17 @@ Tcl_Obj * TclNewFSPathObj( Tcl_Obj *dirPtr, const char *addStrRep, - int len) + size_t len) { FsPath *fsPathPtr; Tcl_Obj *pathPtr; const char *p; int state = 0, count = 0; - /* [Bug 2806250] - this is only a partial solution of the problem. + /* + * This comment is kept from the days of tilde expansion because + * it is illustrative of a more general problem. + * [Bug 2806250] - this is only a partial solution of the problem. * The PATHFLAGS != 0 representation assumes in many places that * the "tail" part stored in the normPathPtr field is itself a * relative path. Strings that begin with "~" are not relative paths, @@ -1265,16 +1246,9 @@ TclNewFSPathObj( * that by mounting on path prefixes like foo:// which cannot be the * name of a file or directory read from a native [glob] operation. */ - if (addStrRep[0] == '~') { - Tcl_Obj *tail = Tcl_NewStringObj(addStrRep, len); - - pathPtr = AppendPath(dirPtr, tail); - Tcl_DecrRefCount(tail); - return pathPtr; - } TclNewObj(pathPtr); - fsPathPtr = (FsPath *)ckalloc(sizeof(FsPath)); + fsPathPtr = (FsPath *)Tcl_Alloc(sizeof(FsPath)); /* * Set up the path. @@ -1299,12 +1273,12 @@ TclNewFSPathObj( * things as needing more aggressive normalization that don't actually * need it. No harm done. */ - for (p = addStrRep; len > 0; p++, len--) { + for (p = addStrRep; len+1 > 1; p++, len--) { switch (state) { case 0: /* So far only "." since last dirsep or start */ switch (*p) { case '.': - count++; + count = 1; break; case '/': case '\\': @@ -1341,9 +1315,9 @@ AppendPath( Tcl_Obj *head, Tcl_Obj *tail) { - int numBytes; const char *bytes; Tcl_Obj *copy = Tcl_DuplicateObj(head); + size_t length; /* * This is likely buggy when dealing with virtual filesystem drivers @@ -1353,8 +1327,8 @@ AppendPath( * internalrep produce the same results; that is, bugward compatibility. If * we need to fix that bug here, it needs fixing in TclJoinPath() too. */ - bytes = TclGetStringFromObj(tail, &numBytes); - if (numBytes == 0) { + bytes = Tcl_GetStringFromObj(tail, &length); + if (length == 0) { Tcl_AppendToObj(copy, "/", 1); } else { TclpNativeJoinPath(copy, bytes); @@ -1390,7 +1364,7 @@ TclFSMakePathRelative( Tcl_Obj *pathPtr, /* The path we have. */ Tcl_Obj *cwdPtr) /* Make it relative to this. */ { - int cwdLen, len; + size_t cwdLen, len; const char *tempStr; Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(pathPtr, &fsPathType); @@ -1413,7 +1387,7 @@ TclFSMakePathRelative( * too little below, leading to wrong answers returned by glob. */ - tempStr = TclGetStringFromObj(cwdPtr, &cwdLen); + tempStr = Tcl_GetStringFromObj(cwdPtr, &cwdLen); /* * Should we perhaps use 'Tcl_FSPathSeparator'? But then what about the @@ -1433,7 +1407,7 @@ TclFSMakePathRelative( } break; } - tempStr = TclGetStringFromObj(pathPtr, &len); + tempStr = Tcl_GetStringFromObj(pathPtr, &len); return Tcl_NewStringObj(tempStr + cwdLen, len - cwdLen); } @@ -1466,7 +1440,7 @@ MakePathFromNormalized( return TCL_OK; } - fsPathPtr = (FsPath *)ckalloc(sizeof(FsPath)); + fsPathPtr = (FsPath *)Tcl_Alloc(sizeof(FsPath)); /* * It's a pure normalized absolute path. @@ -1501,7 +1475,7 @@ MakePathFromNormalized( * Any memory which is allocated for 'clientData' should be retained * until clientData is passed to the filesystem's freeInternalRepProc * when it can be freed. The built in platform-specific filesystems use - * 'ckalloc' to allocate clientData, and ckfree to free it. + * 'Tcl_Alloc' to allocate clientData, and Tcl_Free to free it. * * Results: * NULL or a valid path object pointer, with refCount zero. @@ -1534,7 +1508,7 @@ Tcl_FSNewNativePath( */ Tcl_StoreInternalRep(pathPtr, &fsPathType, NULL); - fsPathPtr = (FsPath *)ckalloc(sizeof(FsPath)); + fsPathPtr = (FsPath *)Tcl_Alloc(sizeof(FsPath)); fsPathPtr->translatedPathPtr = NULL; @@ -1658,9 +1632,9 @@ Tcl_FSGetTranslatedStringPath( Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(interp, pathPtr); if (transPtr != NULL) { - int len; - const char *orig = TclGetStringFromObj(transPtr, &len); - char *result = (char *)ckalloc(len+1); + size_t len; + const char *orig = Tcl_GetStringFromObj(transPtr, &len); + char *result = (char *)Tcl_Alloc(len+1); memcpy(result, orig, len+1); TclDecrRefCount(transPtr); @@ -1708,7 +1682,8 @@ Tcl_FSGetNormalizedPath( */ Tcl_Obj *dir, *copy; - int tailLen, cwdLen, pathType; + size_t tailLen, cwdLen; + int pathType; pathType = Tcl_FSGetPathType(fsPathPtr->cwdPtr); dir = Tcl_FSGetNormalizedPath(interp, fsPathPtr->cwdPtr); @@ -1718,7 +1693,7 @@ Tcl_FSGetNormalizedPath( /* TODO: Figure out why this is needed. */ TclGetString(pathPtr); - TclGetStringFromObj(fsPathPtr->normPathPtr, &tailLen); + (void)Tcl_GetStringFromObj(fsPathPtr->normPathPtr, &tailLen); if (tailLen) { copy = AppendPath(dir, fsPathPtr->normPathPtr); } else { @@ -1731,7 +1706,7 @@ Tcl_FSGetNormalizedPath( * We now own a reference on both 'dir' and 'copy' */ - (void) TclGetStringFromObj(dir, &cwdLen); + (void) Tcl_GetStringFromObj(dir, &cwdLen); /* Normalize the combined string. */ @@ -1809,13 +1784,13 @@ Tcl_FSGetNormalizedPath( } fsPathPtr = PATHOBJ(pathPtr); } else if (fsPathPtr->normPathPtr == NULL) { - int cwdLen; + size_t cwdLen; Tcl_Obj *copy; copy = AppendPath(fsPathPtr->cwdPtr, pathPtr); - (void) TclGetStringFromObj(fsPathPtr->cwdPtr, &cwdLen); - cwdLen += (Tcl_GetString(copy)[cwdLen] == '/'); + (void) Tcl_GetStringFromObj(fsPathPtr->cwdPtr, &cwdLen); + cwdLen += (TclGetString(copy)[cwdLen] == '/'); /* * Normalize the combined string, but only starting after the end @@ -2142,7 +2117,8 @@ Tcl_FSEqualPaths( Tcl_Obj *secondPtr) { const char *firstStr, *secondStr; - int firstLen, secondLen, tempErrno; + size_t firstLen, secondLen; + int tempErrno; if (firstPtr == secondPtr) { return 1; @@ -2151,8 +2127,8 @@ Tcl_FSEqualPaths( if (firstPtr == NULL || secondPtr == NULL) { return 0; } - firstStr = TclGetStringFromObj(firstPtr, &firstLen); - secondStr = TclGetStringFromObj(secondPtr, &secondLen); + firstStr = Tcl_GetStringFromObj(firstPtr, &firstLen); + secondStr = Tcl_GetStringFromObj(secondPtr, &secondLen); if ((firstLen == secondLen) && !memcmp(firstStr, secondStr, firstLen)) { return 1; } @@ -2171,8 +2147,8 @@ Tcl_FSEqualPaths( return 0; } - firstStr = TclGetStringFromObj(firstPtr, &firstLen); - secondStr = TclGetStringFromObj(secondPtr, &secondLen); + firstStr = Tcl_GetStringFromObj(firstPtr, &firstLen); + secondStr = Tcl_GetStringFromObj(secondPtr, &secondLen); return ((firstLen == secondLen) && !memcmp(firstStr, secondStr, firstLen)); } @@ -2184,10 +2160,6 @@ Tcl_FSEqualPaths( * Attempt to convert the internal representation of pathPtr to * fsPathType. * - * A tilde ("~") character at the beginnig of the filename indicates the - * current user's home directory, and "~<user>" indicates a particular - * user's directory. - * * Results: * Standard Tcl error code. * @@ -2199,13 +2171,12 @@ Tcl_FSEqualPaths( static int SetFsPathFromAny( - Tcl_Interp *interp, /* Used for error reporting if not NULL. */ + TCL_UNUSED(Tcl_Interp *), /* Used for error reporting if not NULL. */ Tcl_Obj *pathPtr) /* The object to convert. */ { - int len; + size_t len; FsPath *fsPathPtr; Tcl_Obj *transPtr; - const char *name; if (TclHasInternalRep(pathPtr, &fsPathType)) { return TCL_OK; @@ -2225,129 +2196,15 @@ SetFsPathFromAny( * cmdAH.test exercise most of the code). */ - name = TclGetStringFromObj(pathPtr, &len); - - /* - * Handle tilde substitutions, if needed. - */ - - if (len && name[0] == '~') { - Tcl_DString temp; - int split; - char separator = '/'; - - /* - * We have multiple cases '~/foo/bar...', '~user/foo/bar...', etc. - * split becomes value 1 for '~/...' as well as for '~'. - */ - split = FindSplitPos(name, separator); - - /* - * Do some tilde substitution. - */ - - if (split == 1) { - /* - * We have just '~' (or '~/...') - */ - - const char *dir; - Tcl_DString dirString; - - dir = TclGetEnv("HOME", &dirString); - if (dir == NULL) { - if (interp) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "couldn't find HOME environment variable to" - " expand path", -1)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", - "HOMELESS", NULL); - } - return TCL_ERROR; - } - Tcl_DStringInit(&temp); - Tcl_JoinPath(1, &dir, &temp); - Tcl_DStringFree(&dirString); - } else { - /* - * There is a '~user' - */ - - const char *expandedUser; - Tcl_DString userName; - - Tcl_DStringInit(&userName); - Tcl_DStringAppend(&userName, name+1, split-1); - expandedUser = Tcl_DStringValue(&userName); - - Tcl_DStringInit(&temp); - if (TclpGetUserHome(expandedUser, &temp) == NULL) { - if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "user \"%s\" doesn't exist", expandedUser)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", "NOUSER", - NULL); - } - Tcl_DStringFree(&userName); - Tcl_DStringFree(&temp); - return TCL_ERROR; - } - Tcl_DStringFree(&userName); - } - - transPtr = Tcl_DStringToObj(&temp); - - if (split != len) { - /* - * Join up the tilde substitution with the rest. - */ - - if (name[split+1] == separator) { - /* - * Somewhat tricky case like ~//foo/bar. Make use of - * Split/Join machinery to get it right. Assumes all paths - * beginning with ~ are part of the native filesystem. - */ - - int objc; - Tcl_Obj **objv; - Tcl_Obj *parts = TclpNativeSplitPath(pathPtr, NULL); - - TclListObjGetElementsM(NULL, parts, &objc, &objv); - - /* - * Skip '~'. It's replaced by its expansion. - */ - - objc--; objv++; - while (objc--) { - TclpNativeJoinPath(transPtr, Tcl_GetString(*objv++)); - } - TclDecrRefCount(parts); - } else { - Tcl_Obj *pair[2]; - - pair[0] = transPtr; - pair[1] = Tcl_NewStringObj(name+split+1, -1); - transPtr = TclJoinPath(2, pair, 1); - if (transPtr != pair[0]) { - Tcl_DecrRefCount(pair[0]); - } - if (transPtr != pair[1]) { - Tcl_DecrRefCount(pair[1]); - } - } - } - } else { - transPtr = TclJoinPath(1, &pathPtr, 1); - } + Tcl_GetStringFromObj(pathPtr, &len); /* TODO: Is this needed? */ + transPtr = TclJoinPath(1, &pathPtr, 1); /* * Now we have a translated filename in 'transPtr'. This will have forward * slashes on Windows, and will not contain any ~user sequences. */ - fsPathPtr = (FsPath *)ckalloc(sizeof(FsPath)); + fsPathPtr = (FsPath *)Tcl_Alloc(sizeof(FsPath)); if (transPtr == pathPtr) { transPtr = Tcl_DuplicateObj(pathPtr); @@ -2398,7 +2255,7 @@ FreeFsPathInternalRep( } } - ckfree(fsPathPtr); + Tcl_Free(fsPathPtr); } static void @@ -2407,7 +2264,7 @@ DupFsPathInternalRep( Tcl_Obj *copyPtr) /* Path obj with internal rep to set. */ { FsPath *srcFsPathPtr = PATHOBJ(srcPtr); - FsPath *copyFsPathPtr = (FsPath *)ckalloc(sizeof(FsPath)); + FsPath *copyFsPathPtr = (FsPath *)Tcl_Alloc(sizeof(FsPath)); SETPATHOBJ(copyPtr, copyFsPathPtr); @@ -2467,7 +2324,7 @@ UpdateStringOfFsPath( Tcl_Obj *pathPtr) /* path obj with string rep to update. */ { FsPath *fsPathPtr = PATHOBJ(pathPtr); - int cwdLen; + size_t cwdLen; Tcl_Obj *copy; if (PATHFLAGS(pathPtr) == 0 || fsPathPtr->cwdPtr == NULL) { @@ -2481,7 +2338,7 @@ UpdateStringOfFsPath( Tcl_IncrRefCount(copy); /* Steal copy's string rep */ - pathPtr->bytes = TclGetStringFromObj(copy, &cwdLen); + pathPtr->bytes = Tcl_GetStringFromObj(copy, &cwdLen); pathPtr->length = cwdLen; TclInitStringRep(copy, NULL, 0); TclDecrRefCount(copy); @@ -2539,9 +2396,9 @@ TclNativePathInFilesystem( * situation. */ - int len; + size_t len; - (void) TclGetStringFromObj(pathPtr, &len); + (void) Tcl_GetStringFromObj(pathPtr, &len); if (len == 0) { /* * We reject the empty path "". @@ -2685,8 +2542,8 @@ TclResolveTildePath( Tcl_Obj *pathObj) { const char *path; - int len; - int split; + size_t len; + size_t split; Tcl_DString resolvedPath; path = Tcl_GetStringFromObj(pathObj, &len); @@ -2762,8 +2619,8 @@ TclResolveTildePathList( Tcl_Obj *pathsObj) { Tcl_Obj **objv; - int objc; - int i; + size_t objc; + size_t i; Tcl_Obj *resolvedPaths; const char *path; diff --git a/generic/tclPipe.c b/generic/tclPipe.c index 699d559..137b415 100644 --- a/generic/tclPipe.c +++ b/generic/tclPipe.c @@ -179,16 +179,16 @@ FileForRedirect( void Tcl_DetachPids( - int numPids, /* Number of pids to detach: gives size of + size_t numPids, /* Number of pids to detach: gives size of * array pointed to by pidPtr. */ Tcl_Pid *pidPtr) /* Array of pids to detach. */ { Detached *detPtr; - int i; + size_t i; Tcl_MutexLock(&pipeMutex); for (i = 0; i < numPids; i++) { - detPtr = (Detached *)ckalloc(sizeof(Detached)); + detPtr = (Detached *)Tcl_Alloc(sizeof(Detached)); detPtr->pid = pidPtr[i]; detPtr->nextPtr = detList; detList = detPtr; @@ -238,7 +238,7 @@ Tcl_ReapDetachedProcs(void) } else { prevPtr->nextPtr = detPtr->nextPtr; } - ckfree(detPtr); + Tcl_Free(detPtr); detPtr = nextPtr; } Tcl_MutexUnlock(&pipeMutex); @@ -269,16 +269,16 @@ Tcl_ReapDetachedProcs(void) int TclCleanupChildren( Tcl_Interp *interp, /* Used for error messages. */ - int numPids, /* Number of entries in pidPtr array. */ + size_t 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 * stderr output. */ { int result = TCL_OK; - int i, abnormalExit, anyErrorInfo; + int code, abnormalExit, anyErrorInfo; TclProcessWaitStatus waitStatus; - int code; + size_t i; Tcl_Obj *msg, *error; abnormalExit = 0; @@ -336,7 +336,7 @@ TclCleanupChildren( Tcl_Seek(errorChan, 0, SEEK_SET); TclNewObj(objPtr); count = Tcl_ReadChars(errorChan, objPtr, -1, 0); - if (count < 0) { + if (count == -1) { result = TCL_ERROR; Tcl_DecrRefCount(objPtr); Tcl_ResetResult(interp); @@ -351,7 +351,7 @@ TclCleanupChildren( Tcl_DecrRefCount(objPtr); } } - Tcl_Close(NULL, errorChan); + Tcl_CloseEx(NULL, errorChan, 0); } /* @@ -378,7 +378,7 @@ TclCleanupChildren( * * Results: * The return value is a count of the number of new processes created, or - * -1 if an error occurred while creating the pipeline. *pidArrayPtr is + * TCL_INDEX_NONE if an error occurred while creating the pipeline. *pidArrayPtr is * filled in with the address of a dynamically allocated array giving the * ids of all of the processes. It is up to the caller to free this array * when it isn't needed anymore. If inPipePtr is non-NULL, *inPipePtr is @@ -395,10 +395,10 @@ TclCleanupChildren( *---------------------------------------------------------------------- */ -int +size_t TclCreatePipeline( Tcl_Interp *interp, /* Interpreter to use for error reporting. */ - int argc, /* Number of entries in argv. */ + size_t 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. */ @@ -431,9 +431,9 @@ TclCreatePipeline( { Tcl_Pid *pidPtr = NULL; /* Points to malloc-ed array holding all the * pids of child processes. */ - int numPids; /* Actual number of processes that exist at + size_t numPids; /* Actual number of processes that exist at * *pidPtr right now. */ - int cmdCount; /* Count of number of distinct commands found + size_t cmdCount; /* Count of number of distinct commands found * in argc/argv. */ const char *inputLiteral = NULL; /* If non-null, then this points to a string @@ -460,7 +460,8 @@ TclCreatePipeline( int errorRelease = 0; const char *p; const char *nextArg; - int skip, lastBar, lastArg, i, j, atOK, flags, needCmd, errorToOutput = 0; + int skip, atOK, flags, needCmd, errorToOutput = 0; + size_t i, j, lastArg, lastBar; Tcl_DString execBuffer; TclFile pipeIn; TclFile curInFile, curOutFile, curErrFile; @@ -496,7 +497,7 @@ TclCreatePipeline( * list. */ - lastBar = -1; + lastBar = TCL_INDEX_NONE; cmdCount = 1; needCmd = 1; for (i = 0; i < argc; i++) { @@ -824,7 +825,7 @@ TclCreatePipeline( */ Tcl_ReapDetachedProcs(); - pidPtr = (Tcl_Pid *)ckalloc(cmdCount * sizeof(Tcl_Pid)); + pidPtr = (Tcl_Pid *)Tcl_Alloc(cmdCount * sizeof(Tcl_Pid)); curInFile = inputFile; @@ -978,7 +979,7 @@ TclCreatePipeline( Tcl_DetachPids(1, &pidPtr[i]); } } - ckfree(pidPtr); + Tcl_Free(pidPtr); } numPids = -1; goto cleanup; @@ -1020,15 +1021,15 @@ Tcl_Channel Tcl_OpenCommandChannel( Tcl_Interp *interp, /* Interpreter for error reporting. Can NOT be * NULL. */ - int argc, /* How many arguments. */ + size_t 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; - int numPids; - Tcl_Pid *pidPtr; + size_t numPids; + Tcl_Pid *pidPtr = NULL; Tcl_Channel channel; inPipe = outPipe = errFile = NULL; @@ -1040,7 +1041,7 @@ Tcl_OpenCommandChannel( numPids = TclCreatePipeline(interp, argc, argv, &pidPtr, inPipePtr, outPipePtr, errFilePtr); - if (numPids < 0) { + if (numPids == TCL_INDEX_NONE) { goto error; } @@ -1080,9 +1081,9 @@ Tcl_OpenCommandChannel( return channel; error: - if (numPids > 0) { + if (pidPtr) { Tcl_DetachPids(numPids, pidPtr); - ckfree(pidPtr); + Tcl_Free(pidPtr); } if (inPipe != NULL) { TclpCloseFile(inPipe); diff --git a/generic/tclPkg.c b/generic/tclPkg.c index 7866158..34346f9 100644 --- a/generic/tclPkg.c +++ b/generic/tclPkg.c @@ -57,7 +57,7 @@ typedef struct PkgFiles { * "Tk" (no version number). */ -typedef struct Package { +typedef struct { Tcl_Obj *version; PkgAvail *availPtr; /* First in list of all available versions of * this package. */ @@ -111,7 +111,7 @@ static int TclNRPackageObjCmdCleanup(ClientData data[], Tcl_Interp *interp, int */ #define DupBlock(v,s,len) \ - ((v) = (char *)ckalloc(len), memcpy((v),(s),(len))) + ((v) = (char *)Tcl_Alloc(len), memcpy((v),(s),(len))) #define DupString(v,s) \ do { \ size_t local__len = strlen(s) + 1; \ @@ -175,13 +175,13 @@ Tcl_PkgProvideEx( NULL) != TCL_OK) { return TCL_ERROR; } else if (CheckVersionAndConvert(interp, version, &vi, NULL) != TCL_OK) { - ckfree(pvi); + Tcl_Free(pvi); return TCL_ERROR; } res = CompareVersions(pvi, vi, NULL); - ckfree(pvi); - ckfree(vi); + Tcl_Free(pvi); + Tcl_Free(vi); if (res == 0) { if (clientData != NULL) { @@ -236,7 +236,7 @@ PkgFilesCleanupProc( PkgName *name = pkgFiles->names; pkgFiles->names = name->nextPtr; - ckfree(name); + Tcl_Free(name); } entry = Tcl_FirstHashEntry(&pkgFiles->table, &search); while (entry) { @@ -246,7 +246,7 @@ PkgFilesCleanupProc( entry = Tcl_NextHashEntry(&search); } Tcl_DeleteHashTable(&pkgFiles->table); - ckfree(pkgFiles); + Tcl_Free(pkgFiles); return; } @@ -261,7 +261,7 @@ TclInitPkgFiles( PkgFiles *pkgFiles = (PkgFiles *)Tcl_GetAssocData(interp, "tclPkgFiles", NULL); if (!pkgFiles) { - pkgFiles = (PkgFiles *)ckalloc(sizeof(PkgFiles)); + pkgFiles = (PkgFiles *)Tcl_Alloc(sizeof(PkgFiles)); pkgFiles->names = NULL; Tcl_InitHashTable(&pkgFiles->table, TCL_STRING_KEYS); Tcl_SetAssocData(interp, "tclPkgFiles", PkgFilesCleanupProc, pkgFiles); @@ -399,7 +399,7 @@ Tcl_PkgRequireEx( if (version == NULL) { if (Tcl_PkgRequireProc(interp, name, 0, NULL, clientDataPtr) == TCL_OK) { - result = Tcl_GetString(Tcl_GetObjResult(interp)); + result = Tcl_GetStringResult(interp); Tcl_ResetResult(interp); } } else { @@ -413,7 +413,7 @@ Tcl_PkgRequireEx( } Tcl_IncrRefCount(ov); if (Tcl_PkgRequireProc(interp, name, 1, &ov, clientDataPtr) == TCL_OK) { - result = Tcl_GetString(Tcl_GetObjResult(interp)); + result = Tcl_GetStringResult(interp); Tcl_ResetResult(interp); } TclDecrRefCount(ov); @@ -426,7 +426,7 @@ Tcl_PkgRequireProc( Tcl_Interp *interp, /* Interpreter in which package is now * available. */ const char *name, /* Name of desired package. */ - int reqc, /* Requirements constraining the desired + size_t reqc, /* Requirements constraining the desired * version. */ Tcl_Obj *const reqv[], /* 0 means to use the latest version * available. */ @@ -470,7 +470,7 @@ PkgRequireCore( if (code != TCL_OK) { return code; } - reqPtr = (Require *)ckalloc(sizeof(Require)); + reqPtr = (Require *)Tcl_Alloc(sizeof(Require)); Tcl_NRAddCallback(interp, PkgRequireCoreCleanup, reqPtr, NULL, NULL, NULL); reqPtr->clientDataPtr = data[3]; reqPtr->name = name; @@ -610,7 +610,7 @@ PkgRequireCoreFinal( &pkgVersionI, NULL); satisfies = SomeRequirementSatisfied(pkgVersionI, reqc, reqv); - ckfree(pkgVersionI); + Tcl_Free(pkgVersionI); if (!satisfies) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( @@ -638,7 +638,7 @@ PkgRequireCoreCleanup( TCL_UNUSED(Tcl_Interp *), int result) { - ckfree(data[0]); + Tcl_Free(data[0]); return result; } @@ -707,7 +707,7 @@ SelectPackage( if (reqc > 0) { satisfies = SomeRequirementSatisfied(availVersion, reqc, reqv); if (!satisfies) { - ckfree(availVersion); + Tcl_Free(availVersion); availVersion = NULL; continue; } @@ -726,7 +726,7 @@ SelectPackage( * currently selected version. */ - ckfree(bestVersion); + Tcl_Free(bestVersion); bestVersion = NULL; goto newbest; } @@ -741,7 +741,7 @@ SelectPackage( } if (!availStable) { - ckfree(availVersion); + Tcl_Free(availVersion); availVersion = NULL; continue; } @@ -759,7 +759,7 @@ SelectPackage( * the currently selected stable version. */ - ckfree(bestStableVersion); + Tcl_Free(bestStableVersion); bestStableVersion = NULL; goto newstable; } @@ -775,7 +775,7 @@ SelectPackage( &bestStableVersion, NULL); } - ckfree(availVersion); + Tcl_Free(availVersion); availVersion = NULL; } /* end for */ @@ -784,12 +784,12 @@ SelectPackage( */ if (bestVersion != NULL) { - ckfree(bestVersion); + Tcl_Free(bestVersion); bestVersion = NULL; } if (bestStableVersion != NULL) { - ckfree(bestStableVersion); + Tcl_Free(bestStableVersion); bestStableVersion = NULL; } @@ -828,7 +828,7 @@ SelectPackage( * Push "ifneeded" package name in "tclPkgFiles" assocdata. */ - pkgName = (PkgName *)ckalloc(offsetof(PkgName, name) + 1 + strlen(name)); + pkgName = (PkgName *)Tcl_Alloc(offsetof(PkgName, name) + 1 + strlen(name)); pkgName->nextPtr = pkgFiles->names; strcpy(pkgName->name, name); pkgFiles->names = pkgName; @@ -864,7 +864,7 @@ SelectPackageFinal( PkgFiles *pkgFiles = (PkgFiles *)Tcl_GetAssocData(interp, "tclPkgFiles", NULL); PkgName *pkgName = pkgFiles->names; pkgFiles->names = pkgName->nextPtr; - ckfree(pkgName); + Tcl_Free(pkgName); reqPtr->pkgPtr = FindPackage(interp, name); if (result == TCL_OK) { @@ -885,13 +885,13 @@ SelectPackageFinal( result = TCL_ERROR; } else if (CheckVersionAndConvert(interp, versionToProvide, &vi, NULL) != TCL_OK) { - ckfree(pvi); + Tcl_Free(pvi); result = TCL_ERROR; } else { int res = CompareVersions(pvi, vi, NULL); - ckfree(pvi); - ckfree(vi); + Tcl_Free(pvi); + Tcl_Free(vi); if (res != 0) { result = TCL_ERROR; Tcl_SetObjResult(interp, Tcl_ObjPrintf( @@ -1063,7 +1063,7 @@ Tcl_PackageObjCmd( int TclNRPackageObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -1077,9 +1077,10 @@ TclNRPackageObjCmd( PKG_FILES, PKG_FORGET, PKG_IFNEEDED, PKG_NAMES, PKG_PREFER, PKG_PRESENT, PKG_PROVIDE, PKG_REQUIRE, PKG_UNKNOWN, PKG_VCOMPARE, PKG_VERSIONS, PKG_VSATISFIES - }; + } optionIndex; Interp *iPtr = (Interp *) interp; - int optionIndex, exact, i, newobjc, satisfies; + int exact, satisfies; + size_t i, newobjc; PkgAvail *availPtr, *prevPtr; Package *pkgPtr; Tcl_HashEntry *hPtr; @@ -1099,7 +1100,7 @@ TclNRPackageObjCmd( &optionIndex) != TCL_OK) { return TCL_ERROR; } - switch ((enum pkgOptionsEnum) optionIndex) { + switch (optionIndex) { case PKG_FILES: { PkgFiles *pkgFiles; @@ -1109,8 +1110,9 @@ TclNRPackageObjCmd( } pkgFiles = (PkgFiles *) Tcl_GetAssocData(interp, "tclPkgFiles", NULL); if (pkgFiles) { - Tcl_HashEntry *entry = - Tcl_FindHashEntry(&pkgFiles->table, Tcl_GetString(objv[2])); + Tcl_HashEntry *entry = Tcl_FindHashEntry(&pkgFiles->table, + TclGetString(objv[2])); + if (entry) { Tcl_SetObjResult(interp, (Tcl_Obj *)Tcl_GetHashValue(entry)); } @@ -1122,7 +1124,7 @@ TclNRPackageObjCmd( PkgFiles *pkgFiles = (PkgFiles *) Tcl_GetAssocData(interp, "tclPkgFiles", NULL); - for (i = 2; i < objc; i++) { + for (i = 2; i < (size_t)objc; i++) { keyString = TclGetString(objv[i]); if (pkgFiles) { hPtr = Tcl_FindHashEntry(&pkgFiles->table, keyString); @@ -1151,14 +1153,15 @@ TclNRPackageObjCmd( Tcl_EventuallyFree(availPtr->pkgIndex, TCL_DYNAMIC); availPtr->pkgIndex = NULL; } - ckfree(availPtr); + Tcl_Free(availPtr); } - ckfree(pkgPtr); + Tcl_Free(pkgPtr); } break; } case PKG_IFNEEDED: { - int length, res; + size_t length; + int res; char *argv3i, *avi; if ((objc != 4) && (objc != 5)) { @@ -1173,29 +1176,29 @@ TclNRPackageObjCmd( if (objc == 4) { hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv2); if (hPtr == NULL) { - ckfree(argv3i); + Tcl_Free(argv3i); return TCL_OK; } pkgPtr = (Package *)Tcl_GetHashValue(hPtr); } else { pkgPtr = FindPackage(interp, argv2); } - argv3 = TclGetStringFromObj(objv[3], &length); + argv3 = Tcl_GetStringFromObj(objv[3], &length); for (availPtr = pkgPtr->availPtr, prevPtr = NULL; availPtr != NULL; prevPtr = availPtr, availPtr = availPtr->nextPtr) { if (CheckVersionAndConvert(interp, availPtr->version, &avi, NULL) != TCL_OK) { - ckfree(argv3i); + Tcl_Free(argv3i); return TCL_ERROR; } res = CompareVersions(avi, argv3i, NULL); - ckfree(avi); + Tcl_Free(avi); if (res == 0) { if (objc == 4) { - ckfree(argv3i); + Tcl_Free(argv3i); Tcl_SetObjResult(interp, Tcl_NewStringObj(availPtr->script, -1)); return TCL_OK; @@ -1208,13 +1211,13 @@ TclNRPackageObjCmd( break; } } - ckfree(argv3i); + Tcl_Free(argv3i); if (objc == 4) { return TCL_OK; } if (availPtr == NULL) { - availPtr = (PkgAvail *)ckalloc(sizeof(PkgAvail)); + availPtr = (PkgAvail *)Tcl_Alloc(sizeof(PkgAvail)); availPtr->pkgIndex = NULL; DupBlock(availPtr->version, argv3, length + 1); @@ -1227,10 +1230,10 @@ TclNRPackageObjCmd( } } if (iPtr->scriptFile) { - argv4 = TclGetStringFromObj(iPtr->scriptFile, &length); + argv4 = Tcl_GetStringFromObj(iPtr->scriptFile, &length); DupBlock(availPtr->pkgIndex, argv4, length + 1); } - argv4 = TclGetStringFromObj(objv[4], &length); + argv4 = Tcl_GetStringFromObj(objv[4], &length); DupBlock(availPtr->script, argv4, length + 1); break; } @@ -1396,7 +1399,7 @@ TclNRPackageObjCmd( } break; case PKG_UNKNOWN: { - int length; + size_t length; if (objc == 2) { if (iPtr->packageUnknown != NULL) { @@ -1405,9 +1408,9 @@ TclNRPackageObjCmd( } } else if (objc == 3) { if (iPtr->packageUnknown != NULL) { - ckfree(iPtr->packageUnknown); + Tcl_Free(iPtr->packageUnknown); } - argv2 = TclGetStringFromObj(objv[2], &length); + argv2 = Tcl_GetStringFromObj(objv[2], &length); if (argv2[0] == 0) { iPtr->packageUnknown = NULL; } else { @@ -1466,7 +1469,7 @@ TclNRPackageObjCmd( if (CheckVersionAndConvert(interp, argv2, &iva, NULL) != TCL_OK || CheckVersionAndConvert(interp, argv3, &ivb, NULL) != TCL_OK) { if (iva != NULL) { - ckfree(iva); + Tcl_Free(iva); } /* @@ -1482,8 +1485,8 @@ TclNRPackageObjCmd( Tcl_SetObjResult(interp, Tcl_NewWideIntObj(CompareVersions(iva, ivb, NULL))); - ckfree(iva); - ckfree(ivb); + Tcl_Free(iva); + Tcl_Free(ivb); break; case PKG_VERSIONS: if (objc != 3) { @@ -1518,12 +1521,12 @@ TclNRPackageObjCmd( if (CheckVersionAndConvert(interp, argv2, &argv2i, NULL) != TCL_OK) { return TCL_ERROR; } else if (CheckAllRequirements(interp, objc-3, objv+3) != TCL_OK) { - ckfree(argv2i); + Tcl_Free(argv2i); return TCL_ERROR; } satisfies = SomeRequirementSatisfied(argv2i, objc-3, objv+3); - ckfree(argv2i); + Tcl_Free(argv2i); Tcl_SetObjResult(interp, Tcl_NewBooleanObj(satisfies)); break; @@ -1575,7 +1578,7 @@ FindPackage( hPtr = Tcl_CreateHashEntry(&iPtr->packageTable, name, &isNew); if (isNew) { - pkgPtr = (Package *)ckalloc(sizeof(Package)); + pkgPtr = (Package *)Tcl_Alloc(sizeof(Package)); pkgPtr->version = NULL; pkgPtr->availPtr = NULL; pkgPtr->clientData = NULL; @@ -1627,13 +1630,13 @@ TclFreePackageInfo( Tcl_EventuallyFree(availPtr->pkgIndex, TCL_DYNAMIC); availPtr->pkgIndex = NULL; } - ckfree(availPtr); + Tcl_Free(availPtr); } - ckfree(pkgPtr); + Tcl_Free(pkgPtr); } Tcl_DeleteHashTable(&iPtr->packageTable); if (iPtr->packageUnknown != NULL) { - ckfree(iPtr->packageUnknown); + Tcl_Free(iPtr->packageUnknown); } } @@ -1673,7 +1676,7 @@ CheckVersionAndConvert( * 4* assuming that each char is a separator (a,b become ' -x '). * 4+ to have spce for an additional -2 at the end */ - char *ibuf = (char *)ckalloc(4 + 4*strlen(string)); + char *ibuf = (char *)Tcl_Alloc(4 + 4*strlen(string)); char *ip = ibuf; /* @@ -1741,7 +1744,7 @@ CheckVersionAndConvert( if (internal != NULL) { *internal = ibuf; } else { - ckfree(ibuf); + Tcl_Free(ibuf); } if (stable != NULL) { *stable = !hasunstable; @@ -1750,7 +1753,7 @@ CheckVersionAndConvert( } error: - ckfree(ibuf); + Tcl_Free(ibuf); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "expected version number but got \"%s\"", string)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "VERSION", NULL); @@ -2024,7 +2027,7 @@ CheckRequirement( * Exactly one dash is present. Copy the string, split at the location of * dash and check that both parts are versions. Note that the max part can * be empty. Also note that the string allocated with strdup() must be - * freed with free() and not ckfree(). + * freed with free() and not Tcl_Free(). */ DupString(buf, string); @@ -2035,11 +2038,11 @@ CheckRequirement( if ((CheckVersionAndConvert(interp, buf, NULL, NULL) != TCL_OK) || ((*dash != '\0') && (CheckVersionAndConvert(interp, dash, NULL, NULL) != TCL_OK))) { - ckfree(buf); + Tcl_Free(buf); return TCL_ERROR; } - ckfree(buf); + Tcl_Free(buf); return TCL_OK; } @@ -2068,10 +2071,11 @@ AddRequirementsToResult( * available. */ { Tcl_Obj *result = Tcl_GetObjResult(interp); - int i, length; + int i; + size_t length; for (i = 0; i < reqc; i++) { - const char *v = TclGetStringFromObj(reqv[i], &length); + const char *v = Tcl_GetStringFromObj(reqv[i], &length); if ((length & 0x1) && (v[length/2] == '-') && (strncmp(v, v+((length+1)/2), length/2) == 0)) { @@ -2204,7 +2208,7 @@ RequirementSatisfied( strcat(reqi, " -2"); res = CompareVersions(havei, reqi, &thisIsMajor); satisfied = (res == 0) || ((res == 1) && !thisIsMajor); - ckfree(reqi); + Tcl_Free(reqi); return satisfied; } @@ -2228,8 +2232,8 @@ RequirementSatisfied( CheckVersionAndConvert(NULL, buf, &min, NULL); strcat(min, " -2"); satisfied = (CompareVersions(havei, min, NULL) >= 0); - ckfree(min); - ckfree(buf); + Tcl_Free(min); + Tcl_Free(buf); return satisfied; } @@ -2251,9 +2255,9 @@ RequirementSatisfied( (CompareVersions(havei, max, NULL) < 0)); } - ckfree(min); - ckfree(max); - ckfree(buf); + Tcl_Free(min); + Tcl_Free(max); + Tcl_Free(buf); return satisfied; } @@ -2282,7 +2286,7 @@ Tcl_PkgInitStubsCheck( const char * version, int exact) { - const char *actualVersion = Tcl_PkgPresent(interp, "Tcl", version, 0); + const char *actualVersion = Tcl_PkgPresentEx(interp, "Tcl", version, 0, NULL); if ((exact&1) && actualVersion) { const char *p = version; @@ -2294,11 +2298,11 @@ Tcl_PkgInitStubsCheck( if (count == 1) { if (0 != strncmp(version, actualVersion, strlen(version))) { /* Construct error message */ - Tcl_PkgPresent(interp, "Tcl", version, 1); + Tcl_PkgPresentEx(interp, "Tcl", version, 1, NULL); return NULL; } } else { - return Tcl_PkgPresent(interp, "Tcl", version, 1); + return Tcl_PkgPresentEx(interp, "Tcl", version, 1, NULL); } } return actualVersion; diff --git a/generic/tclPkgConfig.c b/generic/tclPkgConfig.c index a0dae51..d84472c 100644 --- a/generic/tclPkgConfig.c +++ b/generic/tclPkgConfig.c @@ -93,7 +93,6 @@ #endif static Tcl_Config const cfg[] = { -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 {"debug", CFG_DEBUG}, {"threaded", CFG_THREADED}, {"profiled", CFG_PROFILED}, @@ -102,7 +101,6 @@ static Tcl_Config const cfg[] = { {"mem_debug", CFG_MEMDEBUG}, {"compile_debug", CFG_COMPILE_DEBUG}, {"compile_stats", CFG_COMPILE_STATS}, -#endif /* Runtime paths to various stuff */ diff --git a/generic/tclPlatDecls.h b/generic/tclPlatDecls.h index f2bc0da..10d3094 100644 --- a/generic/tclPlatDecls.h +++ b/generic/tclPlatDecls.h @@ -48,7 +48,7 @@ # endif #endif -/* !BEGIN!: Do not edit below this line. */ +#if TCL_MAJOR_VERSION < 9 #ifdef __cplusplus extern "C" { @@ -134,8 +134,67 @@ extern const TclPlatStubs *tclPlatStubsPtr; #endif /* defined(USE_TCL_STUBS) */ +#else /* TCL_MAJOR_VERSION > 8 */ + +/* !BEGIN!: Do not edit below this line. */ + +#ifdef __cplusplus +extern "C" { +#endif + +/* + * Exported function declarations: + */ + +/* Slot 0 is reserved */ +/* 1 */ +EXTERN int Tcl_MacOSXOpenVersionedBundleResources( + Tcl_Interp *interp, const char *bundleName, + const char *bundleVersion, + int hasResourceFile, size_t maxPathLen, + char *libraryPath); +/* 2 */ +EXTERN void Tcl_MacOSXNotifierAddRunLoopMode( + const void *runLoopMode); +/* 3 */ +EXTERN void Tcl_WinConvertError(unsigned errCode); + +typedef struct TclPlatStubs { + int magic; + void *hooks; + + void (*reserved0)(void); + int (*tcl_MacOSXOpenVersionedBundleResources) (Tcl_Interp *interp, const char *bundleName, const char *bundleVersion, int hasResourceFile, size_t maxPathLen, char *libraryPath); /* 1 */ + void (*tcl_MacOSXNotifierAddRunLoopMode) (const void *runLoopMode); /* 2 */ + void (*tcl_WinConvertError) (unsigned errCode); /* 3 */ +} TclPlatStubs; + +extern const TclPlatStubs *tclPlatStubsPtr; + +#ifdef __cplusplus +} +#endif + +#if defined(USE_TCL_STUBS) + +/* + * Inline function declarations: + */ + +/* Slot 0 is reserved */ +#define Tcl_MacOSXOpenVersionedBundleResources \ + (tclPlatStubsPtr->tcl_MacOSXOpenVersionedBundleResources) /* 1 */ +#define Tcl_MacOSXNotifierAddRunLoopMode \ + (tclPlatStubsPtr->tcl_MacOSXNotifierAddRunLoopMode) /* 2 */ +#define Tcl_WinConvertError \ + (tclPlatStubsPtr->tcl_WinConvertError) /* 3 */ + +#endif /* defined(USE_TCL_STUBS) */ + /* !END!: Do not edit above this line. */ +#endif /* TCL_MAJOR_VERSION */ + #ifdef MAC_OSX_TCL /* MACOSX */ #undef Tcl_MacOSXOpenBundleResources #define Tcl_MacOSXOpenBundleResources(a,b,c,d,e) Tcl_MacOSXOpenVersionedBundleResources(a,b,NULL,c,d,e) @@ -144,6 +203,16 @@ extern const TclPlatStubs *tclPlatStubsPtr; #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLIMPORT +#ifdef _WIN32 +# undef Tcl_CreateFileHandler +# undef Tcl_DeleteFileHandler +# undef Tcl_GetOpenFile +#endif +#ifndef MAC_OSX_TCL +# undef Tcl_MacOSXOpenVersionedBundleResources +# undef Tcl_MacOSXNotifierAddRunLoopMode +#endif + #if defined(USE_TCL_STUBS) && (defined(_WIN32) || defined(__CYGWIN__))\ && (defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8) #undef Tcl_WinUtfToTChar diff --git a/generic/tclPreserve.c b/generic/tclPreserve.c index b32dd63..5bc0a1a 100644 --- a/generic/tclPreserve.c +++ b/generic/tclPreserve.c @@ -37,9 +37,9 @@ typedef struct { */ static Reference *refArray = NULL; /* First in array of references. */ -static int spaceAvl = 0; /* Total number of structures available at +static size_t spaceAvl = 0; /* Total number of structures available at * *firstRefPtr. */ -static int inUse = 0; /* Count of structures currently in use in +static size_t inUse = 0; /* Count of structures currently in use in * refArray. */ TCL_DECLARE_MUTEX(preserveMutex)/* To protect the above statics */ @@ -53,7 +53,7 @@ TCL_DECLARE_MUTEX(preserveMutex)/* To protect the above statics */ * objects that we don't want to live any longer than necessary. */ -typedef struct HandleStruct { +typedef struct { void *ptr; /* Pointer to the memory block being tracked. * This field will become NULL when the memory * block is deleted. This field must be the @@ -88,7 +88,7 @@ TclFinalizePreserve(void) { Tcl_MutexLock(&preserveMutex); if (spaceAvl != 0) { - ckfree(refArray); + Tcl_Free(refArray); refArray = NULL; inUse = 0; spaceAvl = 0; @@ -120,7 +120,7 @@ Tcl_Preserve( ClientData clientData) /* Pointer to malloc'ed block of memory. */ { Reference *refPtr; - int i; + size_t i; /* * See if there is already a reference for this pointer. If so, just @@ -143,7 +143,7 @@ Tcl_Preserve( if (inUse == spaceAvl) { spaceAvl = spaceAvl ? 2*spaceAvl : INITIAL_SIZE; - refArray = (Reference *)ckrealloc(refArray, spaceAvl * sizeof(Reference)); + refArray = (Reference *)Tcl_Realloc(refArray, spaceAvl * sizeof(Reference)); } /* @@ -183,7 +183,7 @@ Tcl_Release( ClientData clientData) /* Pointer to malloc'ed block of memory. */ { Reference *refPtr; - int i; + size_t i; Tcl_MutexLock(&preserveMutex); for (i=0, refPtr=refArray ; i<inUse ; i++, refPtr++) { @@ -223,7 +223,7 @@ Tcl_Release( Tcl_MutexUnlock(&preserveMutex); if (mustFree) { if (freeProc == TCL_DYNAMIC) { - ckfree(clientData); + Tcl_Free(clientData); } else { freeProc((char *)clientData); } @@ -263,7 +263,7 @@ Tcl_EventuallyFree( Tcl_FreeProc *freeProc) /* Function to actually do free. */ { Reference *refPtr; - int i; + size_t i; /* * See if there is a reference for this pointer. If so, set its "mustFree" @@ -290,7 +290,7 @@ Tcl_EventuallyFree( */ if (freeProc == TCL_DYNAMIC) { - ckfree(clientData); + Tcl_Free(clientData); } else { freeProc((char *)clientData); } @@ -326,7 +326,7 @@ TclHandleCreate( * be tracked for deletion. Must not be * NULL. */ { - HandleStruct *handlePtr = (HandleStruct *)ckalloc(sizeof(HandleStruct)); + HandleStruct *handlePtr = (HandleStruct *)Tcl_Alloc(sizeof(HandleStruct)); handlePtr->ptr = ptr; #ifdef TCL_MEM_DEBUG @@ -376,7 +376,7 @@ TclHandleFree( #endif handlePtr->ptr = NULL; if (handlePtr->refCount == 0) { - ckfree(handlePtr); + Tcl_Free(handlePtr); } } @@ -459,7 +459,7 @@ TclHandleRelease( } #endif if ((handlePtr->refCount-- <= 1) && (handlePtr->ptr == NULL)) { - ckfree(handlePtr); + Tcl_Free(handlePtr); } } diff --git a/generic/tclProc.c b/generic/tclProc.c index b8c324e..e97cb10 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -63,8 +63,9 @@ const Tcl_ObjType tclProcBodyType = { NULL, /* UpdateString function; Tcl_GetString and * Tcl_GetStringFromObj should panic * instead. */ - NULL /* SetFromAny function; Tcl_ConvertToType + NULL, /* SetFromAny function; Tcl_ConvertToType * should panic instead. */ + TCL_OBJTYPE_V0 }; #define ProcSetInternalRep(objPtr, procPtr) \ @@ -93,7 +94,7 @@ const Tcl_ObjType tclProcBodyType = { static const Tcl_ObjType levelReferenceType = { "levelReference", - NULL, NULL, NULL, NULL + NULL, NULL, NULL, NULL, TCL_OBJTYPE_V0 }; /* @@ -110,7 +111,8 @@ static const Tcl_ObjType lambdaType = { FreeLambdaInternalRep, /* freeIntRepProc */ DupLambdaInternalRep, /* dupIntRepProc */ NULL, /* updateStringProc */ - SetLambdaFromAny /* setFromAnyProc */ + SetLambdaFromAny, /* setFromAnyProc */ + TCL_OBJTYPE_V0 }; #define LambdaSetInternalRep(objPtr, procPtr, nsObjPtr) \ @@ -262,11 +264,11 @@ Tcl_ProcObjCmd( && (contextPtr->nline >= 4) && (contextPtr->line[3] >= 0)) { int isNew; Tcl_HashEntry *hePtr; - CmdFrame *cfPtr = (CmdFrame *)ckalloc(sizeof(CmdFrame)); + CmdFrame *cfPtr = (CmdFrame *)Tcl_Alloc(sizeof(CmdFrame)); cfPtr->level = -1; cfPtr->type = contextPtr->type; - cfPtr->line = (int *)ckalloc(sizeof(int)); + cfPtr->line = (int *)Tcl_Alloc(sizeof(int)); cfPtr->line[0] = contextPtr->line[3]; cfPtr->nline = 1; cfPtr->framePtr = NULL; @@ -294,9 +296,9 @@ Tcl_ProcObjCmd( Tcl_DecrRefCount(cfOldPtr->data.eval.path); cfOldPtr->data.eval.path = NULL; } - ckfree(cfOldPtr->line); + Tcl_Free(cfOldPtr->line); cfOldPtr->line = NULL; - ckfree(cfOldPtr); + Tcl_Free(cfOldPtr); } Tcl_SetHashValue(hePtr, cfPtr); } @@ -353,7 +355,7 @@ Tcl_ProcObjCmd( * The argument list is just "args"; check the body */ - procBody = TclGetStringFromObj(objv[3], &numBytes); + procBody = Tcl_GetStringFromObj(objv[3], &numBytes); if (TclParseAllWhiteSpace(procBody, numBytes) < numBytes) { goto done; } @@ -448,7 +450,7 @@ TclCreateProc( Tcl_Size length; Tcl_Obj *sharedBodyPtr = bodyPtr; - bytes = TclGetStringFromObj(bodyPtr, &length); + bytes = Tcl_GetStringFromObj(bodyPtr, &length); bodyPtr = Tcl_NewStringObj(bytes, length); /* @@ -468,7 +470,7 @@ TclCreateProc( Tcl_IncrRefCount(bodyPtr); - procPtr = (Proc *)ckalloc(sizeof(Proc)); + procPtr = (Proc *)Tcl_Alloc(sizeof(Proc)); procPtr->iPtr = iPtr; procPtr->refCount = 1; procPtr->bodyPtr = bodyPtr; @@ -493,8 +495,8 @@ TclCreateProc( if (precompiled) { if (numArgs > procPtr->numArgs) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "procedure \"%s\": arg list contains %d entries, " - "precompiled header expects %d", procName, numArgs, + "procedure \"%s\": arg list contains %" TCL_Z_MODIFIER "u entries, " + "precompiled header expects %" TCL_Z_MODIFIER "u", procName, numArgs, procPtr->numArgs)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC", "BYTECODELIES", NULL); @@ -530,7 +532,7 @@ TclCreateProc( "FORMALARGUMENTFORMAT", NULL); goto procError; } - if ((fieldCount == 0) || (TclGetCharLength(fieldValues[0]) == 0)) { + if ((fieldCount == 0) || (Tcl_GetCharLength(fieldValues[0]) == 0)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "argument with no name", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC", @@ -551,7 +553,7 @@ TclCreateProc( if (*argnamelast == ')') { /* We have an array element. */ Tcl_SetObjResult(interp, Tcl_ObjPrintf( "formal parameter \"%s\" is an array element", - Tcl_GetString(fieldValues[0]))); + TclGetString(fieldValues[0]))); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC", "FORMALARGUMENTFORMAT", NULL); goto procError; @@ -588,7 +590,7 @@ TclCreateProc( || (localPtr->defValuePtr == NULL && fieldCount == 2) || (localPtr->defValuePtr != NULL && fieldCount != 2)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "procedure \"%s\": formal parameter %d is " + "procedure \"%s\": formal parameter %" TCL_Z_MODIFIER "u is " "inconsistent with precompiled body", procName, i)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC", "BYTECODELIES", NULL); @@ -601,8 +603,8 @@ TclCreateProc( if (localPtr->defValuePtr != NULL) { Tcl_Size tmpLength, valueLength; - const char *tmpPtr = TclGetStringFromObj(localPtr->defValuePtr, &tmpLength); - const char *value = TclGetStringFromObj(fieldValues[1], &valueLength); + const char *tmpPtr = Tcl_GetStringFromObj(localPtr->defValuePtr, &tmpLength); + const char *value = Tcl_GetStringFromObj(fieldValues[1], &valueLength); if ((valueLength != tmpLength) || memcmp(value, tmpPtr, tmpLength) != 0 @@ -632,7 +634,7 @@ TclCreateProc( * local variables for the argument. */ - localPtr = (CompiledLocal *)ckalloc( + localPtr = (CompiledLocal *)Tcl_Alloc( offsetof(CompiledLocal, name) + 1U + fieldValues[0]->length); if (procPtr->firstLocalPtr == NULL) { procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr; @@ -678,9 +680,9 @@ TclCreateProc( Tcl_DecrRefCount(localPtr->defValuePtr); } - ckfree(localPtr); + Tcl_Free(localPtr); } - ckfree(procPtr); + Tcl_Free(procPtr); } return TCL_ERROR; } @@ -830,7 +832,7 @@ TclObjGetFrame( CallFrame *framePtr; for (framePtr = iPtr->varFramePtr; framePtr != NULL; framePtr = framePtr->callerVarPtr) { - if (framePtr->level == level) { + if ((int)framePtr->level == level) { *framePtrPtr = framePtr; return result; } @@ -1080,11 +1082,7 @@ ProcWrongNumArgs( if (framePtr->isProcCallFrame & FRAME_IS_LAMBDA) { desiredObjs[0] = Tcl_NewStringObj("lambdaExpr", -1); } else { -#ifdef AVOID_HACKS_FOR_ITCL desiredObjs[0] = framePtr->objv[skip-1]; -#else - desiredObjs[0] = Tcl_NewListObj(1, framePtr->objv + skip - 1); -#endif /* AVOID_HACKS_FOR_ITCL */ } Tcl_IncrRefCount(desiredObjs[0]); @@ -1123,56 +1121,6 @@ ProcWrongNumArgs( /* *---------------------------------------------------------------------- * - * TclInitCompiledLocals -- - * - * This routine is invoked in order to initialize the compiled locals - * table for a new call frame. - * - * DEPRECATED: functionality has been inlined elsewhere; this function - * remains to insure binary compatibility with Itcl. - * - * Results: - * None. - * - * Side effects: - * May invoke various name resolvers in order to determine which - * variables are being referenced at runtime. - * - *---------------------------------------------------------------------- - */ - -#ifndef TCL_NO_DEPRECATED -void -TclInitCompiledLocals( - Tcl_Interp *interp, /* Current interpreter. */ - CallFrame *framePtr, /* Call frame to initialize. */ - Namespace *nsPtr) /* Pointer to current namespace. */ -{ - Var *varPtr = framePtr->compiledLocals; - Tcl_Obj *bodyPtr; - ByteCode *codePtr; - - bodyPtr = framePtr->procPtr->bodyPtr; - ByteCodeGetInternalRep(bodyPtr, &tclByteCodeType, codePtr); - if (codePtr == NULL) { - Tcl_Panic("body object for proc attached to frame is not a byte code type"); - } - - if (framePtr->numCompiledLocals) { - if (!codePtr->localCachePtr) { - InitLocalCache(framePtr->procPtr) ; - } - framePtr->localCachePtr = codePtr->localCachePtr; - framePtr->localCachePtr->refCount++; - } - - InitResolvedLocals(interp, codePtr, varPtr, nsPtr); -} -#endif /* TCL_NO_DEPRECATED */ - -/* - *---------------------------------------------------------------------- - * * InitResolvedLocals -- * * This routine is invoked in order to initialize the compiled locals @@ -1226,7 +1174,7 @@ InitResolvedLocals( if (localPtr->resolveInfo->deleteProc) { localPtr->resolveInfo->deleteProc(localPtr->resolveInfo); } else { - ckfree(localPtr->resolveInfo); + Tcl_Free(localPtr->resolveInfo); } localPtr->resolveInfo = NULL; } @@ -1312,7 +1260,7 @@ TclFreeLocalCache( TclReleaseLiteral(interp, objPtr); } } - ckfree(localCachePtr); + Tcl_Free(localCachePtr); } static void @@ -1338,7 +1286,7 @@ InitLocalCache( * for future calls. */ - localCachePtr = (LocalCache *)ckalloc(offsetof(LocalCache, varName0) + localCachePtr = (LocalCache *)Tcl_Alloc(offsetof(LocalCache, varName0) + localCt * sizeof(Tcl_Obj *) + numArgs * sizeof(Var)); @@ -1350,7 +1298,7 @@ InitLocalCache( *namePtr = NULL; } else { *namePtr = TclCreateLiteral(iPtr, localPtr->name, - localPtr->nameLength, /* hash */ (unsigned int) -1, + localPtr->nameLength, /* hash */ (size_t) -1, &isNew, /* nsPtr */ NULL, 0, NULL); Tcl_IncrRefCount(*namePtr); } @@ -2066,10 +2014,10 @@ TclProcCompileProc( if (toFree->resolveInfo->deleteProc) { toFree->resolveInfo->deleteProc(toFree->resolveInfo); } else { - ckfree(toFree->resolveInfo); + Tcl_Free(toFree->resolveInfo); } } - ckfree(toFree); + Tcl_Free(toFree); } procPtr->numCompiledLocals = procPtr->numArgs; } @@ -2132,9 +2080,9 @@ MakeProcError( { int overflow, limit = 60; Tcl_Size nameLen; - const char *procName = TclGetStringFromObj(procNameObj, &nameLen); + const char *procName = Tcl_GetStringFromObj(procNameObj, &nameLen); - overflow = (nameLen > limit); + overflow = (nameLen > (Tcl_Size)limit); Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (procedure \"%.*s%s\" line %d)", (overflow ? limit : (int)nameLen), procName, @@ -2219,7 +2167,7 @@ TclProcCleanupProc( if (resVarInfo->deleteProc) { resVarInfo->deleteProc(resVarInfo); } else { - ckfree(resVarInfo); + Tcl_Free(resVarInfo); } } @@ -2227,10 +2175,10 @@ TclProcCleanupProc( defPtr = localPtr->defValuePtr; Tcl_DecrRefCount(defPtr); } - ckfree(localPtr); + Tcl_Free(localPtr); localPtr = nextPtr; } - ckfree(procPtr); + Tcl_Free(procPtr); /* * TIP #280: Release the location data associated with this Proc @@ -2254,9 +2202,9 @@ TclProcCleanupProc( Tcl_DecrRefCount(cfPtr->data.eval.path); cfPtr->data.eval.path = NULL; } - ckfree(cfPtr->line); + Tcl_Free(cfPtr->line); cfPtr->line = NULL; - ckfree(cfPtr); + Tcl_Free(cfPtr); } Tcl_DeleteHashEntry(hePtr); } @@ -2512,7 +2460,7 @@ SetLambdaFromAny( if ((result != TCL_OK) || ((objc != 2) && (objc != 3))) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't interpret \"%s\" as a lambda expression", - Tcl_GetString(objPtr))); + TclGetString(objPtr))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "LAMBDA", NULL); return TCL_ERROR; } @@ -2598,12 +2546,12 @@ SetLambdaFromAny( * location (line of 2nd list element). */ - cfPtr = (CmdFrame *)ckalloc(sizeof(CmdFrame)); + cfPtr = (CmdFrame *)Tcl_Alloc(sizeof(CmdFrame)); TclListLines(objPtr, contextPtr->line[1], 2, buf, NULL); cfPtr->level = -1; cfPtr->type = contextPtr->type; - cfPtr->line = (int *)ckalloc(sizeof(int)); + cfPtr->line = (int *)Tcl_Alloc(sizeof(int)); cfPtr->line[0] = buf[1]; cfPtr->nline = 1; cfPtr->framePtr = NULL; @@ -2818,9 +2766,9 @@ MakeLambdaError( { int overflow, limit = 60; Tcl_Size nameLen; - const char *procName = TclGetStringFromObj(procNameObj, &nameLen); + const char *procName = Tcl_GetStringFromObj(procNameObj, &nameLen); - overflow = (nameLen > limit); + overflow = (nameLen > (Tcl_Size)limit); Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (lambda term \"%.*s%s\" line %d)", (overflow ? limit : (int)nameLen), procName, diff --git a/generic/tclProcess.c b/generic/tclProcess.c index aec8c0a..075877e 100644 --- a/generic/tclProcess.c +++ b/generic/tclProcess.c @@ -47,7 +47,7 @@ static void InitProcessInfo(ProcessInfo *info, Tcl_Pid pid, int resolvedPid); static void FreeProcessInfo(ProcessInfo *info); static int RefreshProcessInfo(ProcessInfo *info, int options); -static TclProcessWaitStatus WaitProcessStatus(Tcl_Pid pid, int resolvedPid, +static TclProcessWaitStatus WaitProcessStatus(Tcl_Pid pid, size_t resolvedPid, int options, int *codePtr, Tcl_Obj **msgPtr, Tcl_Obj **errorObjPtr); static Tcl_Obj * BuildProcessStatusObj(ProcessInfo *info); @@ -122,7 +122,7 @@ FreeProcessInfo( * Free allocated structure. */ - ckfree(info); + Tcl_Free(info); } /* @@ -185,7 +185,7 @@ RefreshProcessInfo( TclProcessWaitStatus WaitProcessStatus( Tcl_Pid pid, /* Process id. */ - int resolvedPid, /* Resolved process id. */ + size_t resolvedPid, /* Resolved process id. */ int options, /* Options passed to Tcl_WaitPid. */ int *codePtr, /* If non-NULL, will receive either: * - 0 for normal exit. @@ -451,14 +451,13 @@ ProcessStatusObjCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *dict; - int index, options = WNOHANG; + int options = WNOHANG; Tcl_HashEntry *entry; Tcl_HashSearch search; ProcessInfo *info; - int numPids; + size_t i, numPids; Tcl_Obj **pidObjs; int result; - int i; int pid; Tcl_Obj *const *savedobjv = objv; static const char *const switches[] = { @@ -466,7 +465,7 @@ ProcessStatusObjCmd( }; enum switchesEnum { STATUS_WAIT, STATUS_LAST - }; + } index; while (objc > 1) { if (TclGetString(objv[1])[0] != '-') { @@ -477,7 +476,7 @@ ProcessStatusObjCmd( return TCL_ERROR; } ++objv; --objc; - if (STATUS_WAIT == (enum switchesEnum) index) { + if (STATUS_WAIT == index) { options = 0; } else { break; @@ -601,11 +600,9 @@ ProcessPurgeObjCmd( Tcl_HashEntry *entry; Tcl_HashSearch search; ProcessInfo *info; - int numPids; + size_t i, numPids; Tcl_Obj **pidObjs; - int result; - int i; - int pid; + int result, pid; if (objc != 1 && objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "?pids?"); @@ -792,7 +789,7 @@ void TclProcessCreated( Tcl_Pid pid) /* Process id. */ { - int resolvedPid; + size_t resolvedPid; Tcl_HashEntry *entry, *entry2; int isNew; ProcessInfo *info; @@ -826,7 +823,7 @@ TclProcessCreated( * Allocate and initialize info structure. */ - info = (ProcessInfo *)ckalloc(sizeof(ProcessInfo)); + info = (ProcessInfo *)Tcl_Alloc(sizeof(ProcessInfo)); InitProcessInfo(info, pid, resolvedPid); /* diff --git a/generic/tclRegexp.c b/generic/tclRegexp.c index bb4ffc9..4e3c6c5 100644 --- a/generic/tclRegexp.c +++ b/generic/tclRegexp.c @@ -13,6 +13,7 @@ #include "tclInt.h" #include "tclRegexp.h" +#include "tclTomMath.h" #include <assert.h> /* @@ -70,7 +71,7 @@ typedef struct { char *patterns[NUM_REGEXPS];/* Strings corresponding to compiled regular * expression patterns. NULL means that this * slot isn't used. Malloc-ed. */ - int patLengths[NUM_REGEXPS];/* Number of non-null characters in + size_t patLengths[NUM_REGEXPS];/* Number of non-null characters in * corresponding entry in patterns. -1 means * entry isn't used. */ struct TclRegexp *regexps[NUM_REGEXPS]; @@ -85,15 +86,15 @@ static Tcl_ThreadDataKey dataKey; */ static TclRegexp * CompileRegexp(Tcl_Interp *interp, const char *pattern, - int length, int flags); + size_t length, int flags); static void DupRegexpInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); -static void FinalizeRegexp(ClientData clientData); +static void FinalizeRegexp(void *clientData); static void FreeRegexp(TclRegexp *regexpPtr); static void FreeRegexpInternalRep(Tcl_Obj *objPtr); static int RegExpExecUniChar(Tcl_Interp *interp, Tcl_RegExp re, - const Tcl_UniChar *uniString, int numChars, - int nmatches, int flags); + const Tcl_UniChar *uniString, size_t numChars, + size_t nmatches, int flags); static int SetRegexpFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); /* @@ -106,7 +107,8 @@ const Tcl_ObjType tclRegexpType = { FreeRegexpInternalRep, /* freeIntRepProc */ DupRegexpInternalRep, /* dupIntRepProc */ NULL, /* updateStringProc */ - SetRegexpFromAny /* setFromAnyProc */ + SetRegexpFromAny, /* setFromAnyProc */ + TCL_OBJTYPE_V0 }; #define RegexpSetInternalRep(objPtr, rePtr) \ @@ -155,7 +157,7 @@ Tcl_RegExpCompile( const char *pattern) /* String for which to produce compiled * regular expression. */ { - return (Tcl_RegExp) CompileRegexp(interp, pattern, (int) strlen(pattern), + return (Tcl_RegExp) CompileRegexp(interp, pattern, strlen(pattern), REG_ADVANCED); } @@ -190,7 +192,8 @@ Tcl_RegExpExec( * identifies beginning of larger string, so * that "^" won't match. */ { - int flags, result, numChars; + int flags, result; + size_t numChars; TclRegexp *regexp = (TclRegexp *) re; Tcl_DString ds; const Tcl_UniChar *ustr; @@ -250,7 +253,7 @@ void Tcl_RegExpRange( Tcl_RegExp re, /* Compiled regular expression that has been * passed to Tcl_RegExpExec. */ - int index, /* 0 means give the range of the entire match, + size_t 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 @@ -261,7 +264,7 @@ Tcl_RegExpRange( TclRegexp *regexpPtr = (TclRegexp *) re; const char *string; - if ((size_t) index > regexpPtr->re.re_nsub) { + if (index > regexpPtr->re.re_nsub) { *startPtr = *endPtr = NULL; } else if (regexpPtr->matches[index].rm_so == TCL_INDEX_NONE) { *startPtr = *endPtr = NULL; @@ -271,8 +274,8 @@ Tcl_RegExpRange( } else { string = regexpPtr->string; } - *startPtr = TclUtfAtIndex(string, regexpPtr->matches[index].rm_so); - *endPtr = TclUtfAtIndex(string, regexpPtr->matches[index].rm_eo); + *startPtr = Tcl_UtfAtIndex(string, regexpPtr->matches[index].rm_so); + *endPtr = Tcl_UtfAtIndex(string, regexpPtr->matches[index].rm_eo); } } @@ -302,9 +305,8 @@ RegExpExecUniChar( Tcl_RegExp re, /* Compiled regular expression; returned by a * previous call to Tcl_GetRegExpFromObj */ const Tcl_UniChar *wString, /* String against which to match re. */ - int numChars, /* Length of Tcl_UniChar string (must be - * >=0). */ - int nmatches, /* How many subexpression matches (counting + size_t numChars, /* Length of Tcl_UniChar string. */ + size_t nm, /* How many subexpression matches (counting * the whole match as subexpression 0) are of * interest. -1 means "don't know". */ int flags) /* Regular expression flags. */ @@ -312,13 +314,12 @@ RegExpExecUniChar( int status; TclRegexp *regexpPtr = (TclRegexp *) re; size_t last = regexpPtr->re.re_nsub + 1; - size_t nm = last; - if (nmatches >= 0 && (size_t) nmatches < nm) { - nm = (size_t) nmatches; + if (nm >= last) { + nm = last; } - status = TclReExec(®expPtr->re, wString, (size_t) numChars, + status = TclReExec(®expPtr->re, wString, numChars, ®expPtr->details, nm, regexpPtr->matches, flags); /* @@ -362,13 +363,13 @@ void TclRegExpRangeUniChar( Tcl_RegExp re, /* Compiled regular expression that has been * passed to Tcl_RegExpExec. */ - int index, /* 0 means give the range of the entire match, + size_t 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 * rm_extend field. */ - int *startPtr, /* Store address of first character in + size_t *startPtr, /* Store address of first character in * (sub-)range here. */ - int *endPtr) /* Store address of character just after last + size_t *endPtr) /* Store address of character just after last * in (sub-)range here. */ { TclRegexp *regexpPtr = (TclRegexp *) re; @@ -376,7 +377,7 @@ TclRegExpRangeUniChar( if ((regexpPtr->flags®_EXPECT) && (index == TCL_INDEX_NONE)) { *startPtr = regexpPtr->details.rm_extend.rm_so; *endPtr = regexpPtr->details.rm_extend.rm_eo; - } else if ((size_t) index > regexpPtr->re.re_nsub) { + } else if (index + 1 > regexpPtr->re.re_nsub + 1) { *startPtr = TCL_INDEX_NONE; *endPtr = TCL_INDEX_NONE; } else { @@ -442,16 +443,16 @@ Tcl_RegExpExecObj( * returned by previous call to * Tcl_GetRegExpFromObj. */ Tcl_Obj *textObj, /* Text against which to match re. */ - int offset, /* Character index that marks where matching + size_t offset, /* Character index that marks where matching * should begin. */ - int nmatches, /* How many subexpression matches (counting + size_t 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; - int length; + size_t length; int reflags = regexpPtr->flags; #define TCL_REG_GLOBOK_FLAGS \ (TCL_REG_ADVANCED | TCL_REG_NOSUB | TCL_REG_NOCASE) @@ -482,7 +483,7 @@ Tcl_RegExpExecObj( regexpPtr->string = NULL; regexpPtr->objPtr = textObj; - udata = TclGetUnicodeFromObj_(textObj, &length); + udata = Tcl_GetUnicodeFromObj(textObj, &length); if (offset > length) { offset = length; @@ -594,14 +595,14 @@ Tcl_GetRegExpFromObj( * expression. */ int flags) /* Regular expression compilation flags. */ { - int length; + size_t length; TclRegexp *regexpPtr; const char *pattern; RegexpGetInternalRep(objPtr, regexpPtr); if ((regexpPtr == NULL) || (regexpPtr->flags != flags)) { - pattern = TclGetStringFromObj(objPtr, &length); + pattern = Tcl_GetStringFromObj(objPtr, &length); regexpPtr = CompileRegexp(interp, pattern, length, flags); if (regexpPtr == NULL) { @@ -858,7 +859,7 @@ static TclRegexp * CompileRegexp( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ const char *string, /* The regexp to compile (UTF-8). */ - int length, /* The length of the string in bytes. */ + size_t length, /* The length of the string in bytes. */ int flags) /* Compilation flags. */ { TclRegexp *regexpPtr; @@ -916,11 +917,11 @@ CompileRegexp( * This is a new expression, so compile it and add it to the cache. */ - regexpPtr = (TclRegexp*)ckalloc(sizeof(TclRegexp)); + regexpPtr = (TclRegexp*)Tcl_Alloc(sizeof(TclRegexp)); regexpPtr->objPtr = NULL; regexpPtr->string = NULL; - regexpPtr->details.rm_extend.rm_so = -1; - regexpPtr->details.rm_extend.rm_eo = -1; + regexpPtr->details.rm_extend.rm_so = TCL_INDEX_NONE; + regexpPtr->details.rm_extend.rm_eo = TCL_INDEX_NONE; /* * Get the up-to-date string representation and map to unicode. @@ -943,7 +944,7 @@ CompileRegexp( * Clean up and report errors in the interpreter, if possible. */ - ckfree(regexpPtr); + Tcl_Free(regexpPtr); if (interp) { TclRegError(interp, "couldn't compile regular expression pattern: ", status); @@ -971,7 +972,7 @@ CompileRegexp( */ regexpPtr->matches = - (regmatch_t*)ckalloc(sizeof(regmatch_t) * (regexpPtr->re.re_nsub + 1)); + (regmatch_t*)Tcl_Alloc(sizeof(regmatch_t) * (regexpPtr->re.re_nsub + 1)); /* * Initialize the refcount to one initially, since it is in the cache. @@ -990,14 +991,14 @@ CompileRegexp( if (oldRegexpPtr->refCount-- <= 1) { FreeRegexp(oldRegexpPtr); } - ckfree(tsdPtr->patterns[NUM_REGEXPS-1]); + Tcl_Free(tsdPtr->patterns[NUM_REGEXPS-1]); } for (i = NUM_REGEXPS - 2; i >= 0; i--) { tsdPtr->patterns[i+1] = tsdPtr->patterns[i]; tsdPtr->patLengths[i+1] = tsdPtr->patLengths[i]; tsdPtr->regexps[i+1] = tsdPtr->regexps[i]; } - tsdPtr->patterns[0] = (char *)ckalloc(length + 1); + tsdPtr->patterns[0] = (char *)Tcl_Alloc(length + 1); memcpy(tsdPtr->patterns[0], string, length + 1); tsdPtr->patLengths[0] = length; tsdPtr->regexps[0] = regexpPtr; @@ -1030,9 +1031,9 @@ FreeRegexp( TclDecrRefCount(regexpPtr->globObjPtr); } if (regexpPtr->matches) { - ckfree(regexpPtr->matches); + Tcl_Free(regexpPtr->matches); } - ckfree(regexpPtr); + Tcl_Free(regexpPtr); } /* @@ -1053,7 +1054,7 @@ FreeRegexp( static void FinalizeRegexp( - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { int i; TclRegexp *regexpPtr; @@ -1064,7 +1065,7 @@ FinalizeRegexp( if (regexpPtr->refCount-- <= 1) { FreeRegexp(regexpPtr); } - ckfree(tsdPtr->patterns[i]); + Tcl_Free(tsdPtr->patterns[i]); tsdPtr->patterns[i] = NULL; } diff --git a/generic/tclResolve.c b/generic/tclResolve.c index ff88ffd..f321515 100644 --- a/generic/tclResolve.c +++ b/generic/tclResolve.c @@ -101,9 +101,9 @@ Tcl_AddInterpResolvers( * list, so that it overrides existing schemes. */ - resPtr = (ResolverScheme *)ckalloc(sizeof(ResolverScheme)); + resPtr = (ResolverScheme *)Tcl_Alloc(sizeof(ResolverScheme)); len = strlen(name) + 1; - resPtr->name = (char *)ckalloc(len); + resPtr->name = (char *)Tcl_Alloc(len); memcpy(resPtr->name, name, len); resPtr->cmdResProc = cmdProc; resPtr->varResProc = varProc; @@ -225,8 +225,8 @@ Tcl_RemoveInterpResolvers( } *prevPtrPtr = resPtr->nextPtr; - ckfree(resPtr->name); - ckfree(resPtr); + Tcl_Free(resPtr->name); + Tcl_Free(resPtr); return 1; } diff --git a/generic/tclResult.c b/generic/tclResult.c index 7e108e9..c0266bc 100644 --- a/generic/tclResult.c +++ b/generic/tclResult.c @@ -25,11 +25,8 @@ enum returnKeys { */ static Tcl_Obj ** GetKeys(void); -static void ReleaseKeys(ClientData clientData); +static void ReleaseKeys(void *clientData); static void ResetObjResult(Interp *iPtr); -#ifndef TCL_NO_DEPRECATED -static void SetupAppendBuffer(Interp *iPtr, int newSpace); -#endif /* !TCL_NO_DEPRECATED */ /* * This structure is used to take a snapshot of the interpreter state in @@ -77,7 +74,7 @@ Tcl_SaveInterpState( int status) /* status code for current operation */ { Interp *iPtr = (Interp *) interp; - InterpState *statePtr = (InterpState *)ckalloc(sizeof(InterpState)); + InterpState *statePtr = (InterpState *)Tcl_Alloc(sizeof(InterpState)); statePtr->status = status; statePtr->flags = iPtr->flags & ERR_ALREADY_LOGGED; @@ -207,302 +204,7 @@ Tcl_DiscardInterpState( Tcl_DecrRefCount(statePtr->errorStack); } Tcl_DecrRefCount(statePtr->objResult); - ckfree(statePtr); -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_SaveResult -- - * - * Takes a snapshot of the current result state of the interpreter. The - * snapshot can be restored at any point by Tcl_RestoreResult. Note that - * this routine does not preserve the errorCode, errorInfo, or flags - * fields so it should not be used if an error is in progress. - * - * Once a snapshot is saved, it must be restored by calling - * Tcl_RestoreResult, or discarded by calling Tcl_DiscardResult. - * - * Results: - * None. - * - * Side effects: - * Resets the interpreter result. - * - *---------------------------------------------------------------------- - */ - -#ifndef TCL_NO_DEPRECATED -#undef Tcl_SaveResult -void -Tcl_SaveResult( - Tcl_Interp *interp, /* Interpreter to save. */ - Tcl_SavedResult *statePtr) /* Pointer to state structure. */ -{ - Interp *iPtr = (Interp *) interp; - - /* - * Move the result object into the save state. Note that we don't need to - * change its refcount because we're moving it, not adding a new - * reference. Put an empty object into the interpreter. - */ - - statePtr->objResultPtr = iPtr->objResultPtr; - TclNewObj(iPtr->objResultPtr); - Tcl_IncrRefCount(iPtr->objResultPtr); - - /* - * Save the string result. - */ - - statePtr->freeProc = iPtr->freeProc; - if (iPtr->result == iPtr->resultSpace) { - /* - * Copy the static string data out of the interp buffer. - */ - - statePtr->result = statePtr->resultSpace; - strcpy(statePtr->result, iPtr->result); - statePtr->appendResult = NULL; - } else if (iPtr->result == iPtr->appendResult) { - /* - * Move the append buffer out of the interp. - */ - - statePtr->appendResult = iPtr->appendResult; - statePtr->appendAvl = iPtr->appendAvl; - statePtr->appendUsed = iPtr->appendUsed; - statePtr->result = statePtr->appendResult; - iPtr->appendResult = NULL; - iPtr->appendAvl = 0; - iPtr->appendUsed = 0; - } else { - /* - * Move the dynamic or static string out of the interpreter. - */ - - statePtr->result = iPtr->result; - statePtr->appendResult = NULL; - } - - iPtr->result = iPtr->resultSpace; - iPtr->resultSpace[0] = 0; - iPtr->freeProc = 0; -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_RestoreResult -- - * - * Restores the state of the interpreter to a snapshot taken by - * Tcl_SaveResult. After this call, the token for the interpreter state - * is no longer valid. - * - * Results: - * None. - * - * Side effects: - * Restores the interpreter result. - * - *---------------------------------------------------------------------- - */ - -#undef Tcl_RestoreResult -void -Tcl_RestoreResult( - Tcl_Interp *interp, /* Interpreter being restored. */ - Tcl_SavedResult *statePtr) /* State returned by Tcl_SaveResult. */ -{ - Interp *iPtr = (Interp *) interp; - - Tcl_ResetResult(interp); - - /* - * Restore the string result. - */ - - iPtr->freeProc = statePtr->freeProc; - if (statePtr->result == statePtr->resultSpace) { - /* - * Copy the static string data into the interp buffer. - */ - - iPtr->result = iPtr->resultSpace; - strcpy(iPtr->result, statePtr->result); - } else if (statePtr->result == statePtr->appendResult) { - /* - * Move the append buffer back into the interp. - */ - - if (iPtr->appendResult != NULL) { - ckfree(iPtr->appendResult); - } - - iPtr->appendResult = statePtr->appendResult; - iPtr->appendAvl = statePtr->appendAvl; - iPtr->appendUsed = statePtr->appendUsed; - iPtr->result = iPtr->appendResult; - } else { - /* - * Move the dynamic or static string back into the interpreter. - */ - - iPtr->result = statePtr->result; - } - - /* - * Restore the object result. - */ - - Tcl_DecrRefCount(iPtr->objResultPtr); - iPtr->objResultPtr = statePtr->objResultPtr; -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_DiscardResult -- - * - * Frees the memory associated with an interpreter snapshot taken by - * Tcl_SaveResult. If the snapshot is not restored, this function must be - * called to discard it, or the memory will be lost. - * - * Results: - * None. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -#undef Tcl_DiscardResult -void -Tcl_DiscardResult( - Tcl_SavedResult *statePtr) /* State returned by Tcl_SaveResult. */ -{ - TclDecrRefCount(statePtr->objResultPtr); - - if (statePtr->result == statePtr->appendResult) { - ckfree(statePtr->appendResult); - } else if (statePtr->freeProc == TCL_DYNAMIC) { - ckfree(statePtr->result); - } else if (statePtr->freeProc) { - statePtr->freeProc(statePtr->result); - } -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_SetResult -- - * - * Arrange for "result" to be the Tcl return value. - * - * Results: - * None. - * - * Side effects: - * interp->result is left pointing either to "result" or to a copy of it. - * Also, the object result is reset. - * - *---------------------------------------------------------------------- - */ - -void -Tcl_SetResult( - Tcl_Interp *interp, /* Interpreter with which to associate the - * return value. */ - char *result, /* Value to be returned. If NULL, the result - * is set to an empty string. */ - Tcl_FreeProc *freeProc) /* Gives information about the string: - * TCL_STATIC, TCL_VOLATILE, or the address of - * a Tcl_FreeProc such as free. */ -{ - Interp *iPtr = (Interp *) interp; - Tcl_FreeProc *oldFreeProc = iPtr->freeProc; - char *oldResult = iPtr->result; - - if (result == NULL) { - iPtr->resultSpace[0] = 0; - iPtr->result = iPtr->resultSpace; - iPtr->freeProc = 0; - } else if (freeProc == TCL_VOLATILE) { - int length = strlen(result); - - if (length > TCL_RESULT_SIZE) { - iPtr->result = (char *)ckalloc(length + 1); - iPtr->freeProc = TCL_DYNAMIC; - } else { - iPtr->result = iPtr->resultSpace; - iPtr->freeProc = 0; - } - memcpy(iPtr->result, result, length+1); - } else { - iPtr->result = (char *) result; - iPtr->freeProc = freeProc; - } - - /* - * If the old result was dynamically-allocated, free it up. Do it here, - * rather than at the beginning, in case the new result value was part of - * the old result value. - */ - - if (oldFreeProc != 0) { - if (oldFreeProc == TCL_DYNAMIC) { - ckfree(oldResult); - } else { - oldFreeProc(oldResult); - } - } - - /* - * Reset the object result since we just set the string result. - */ - - ResetObjResult(iPtr); -} -#endif /* !TCL_NO_DEPRECATED */ - -/* - *---------------------------------------------------------------------- - * - * Tcl_GetStringResult -- - * - * Returns an interpreter's result value as a string. - * - * Results: - * The interpreter's result as a string. - * - * Side effects: - * If the string result is empty, the object result is moved to the - * string result, then the object result is reset. - * - *---------------------------------------------------------------------- - */ - -#undef Tcl_GetStringResult -const char * -Tcl_GetStringResult( - Tcl_Interp *interp)/* Interpreter whose result to return. */ -{ -#ifndef TCL_NO_DEPRECATED - Interp *iPtr = (Interp *) interp; - /* - * If the string result is empty, move the object result to the string - * result, then reset the object result. - */ - - if (*(iPtr->result) == 0) { - Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)), - TCL_VOLATILE); - } - return iPtr->result; -#else - return TclGetString(Tcl_GetObjResult(interp)); -#endif + Tcl_Free(statePtr); } /* @@ -543,23 +245,6 @@ Tcl_SetObjResult( */ TclDecrRefCount(oldObjResult); - -#ifndef TCL_NO_DEPRECATED - /* - * Reset the string result since we just set the result object. - */ - - if (iPtr->freeProc != NULL) { - if (iPtr->freeProc == TCL_DYNAMIC) { - ckfree(iPtr->result); - } else { - iPtr->freeProc(iPtr->result); - } - iPtr->freeProc = 0; - } - iPtr->result = iPtr->resultSpace; - iPtr->resultSpace[0] = 0; -#endif } /* @@ -588,75 +273,13 @@ Tcl_GetObjResult( Tcl_Interp *interp) /* Interpreter whose result to return. */ { Interp *iPtr = (Interp *) interp; -#ifndef TCL_NO_DEPRECATED - Tcl_Obj *objResultPtr; - int length; - - /* - * If the string result is non-empty, move the string result to the object - * result, then reset the string result. - */ - if (iPtr->result[0] != 0) { - ResetObjResult(iPtr); - - objResultPtr = iPtr->objResultPtr; - length = strlen(iPtr->result); - TclInitStringRep(objResultPtr, iPtr->result, length); - - if (iPtr->freeProc != NULL) { - if (iPtr->freeProc == TCL_DYNAMIC) { - ckfree(iPtr->result); - } else { - iPtr->freeProc(iPtr->result); - } - iPtr->freeProc = 0; - } - iPtr->result = iPtr->resultSpace; - iPtr->result[0] = 0; - } -#endif /* !TCL_NO_DEPRECATED */ return iPtr->objResultPtr; } /* *---------------------------------------------------------------------- * - * Tcl_AppendResultVA -- - * - * Append a variable number of strings onto the interpreter's result. - * - * Results: - * None. - * - * Side effects: - * The result of the interpreter given by the first argument is extended - * by the strings in the va_list (up to a terminating NULL argument). - * - * If the string result is non-empty, the object result forced to be a - * duplicate of it first. There will be a string result afterwards. - * - *---------------------------------------------------------------------- - */ - -void -Tcl_AppendResultVA( - Tcl_Interp *interp, /* Interpreter with which to associate the - * return value. */ - va_list argList) /* Variable argument list. */ -{ - Tcl_Obj *objPtr = Tcl_GetObjResult(interp); - - if (Tcl_IsShared(objPtr)) { - objPtr = Tcl_DuplicateObj(objPtr); - } - Tcl_AppendStringsToObjVA(objPtr, argList); - Tcl_SetObjResult(interp, objPtr); -} - -/* - *---------------------------------------------------------------------- - * * Tcl_AppendResult -- * * Append a variable number of strings onto the interpreter's result. @@ -680,9 +303,23 @@ Tcl_AppendResult( Tcl_Interp *interp, ...) { va_list argList; + Tcl_Obj *objPtr; va_start(argList, interp); - Tcl_AppendResultVA(interp, argList); + objPtr = Tcl_GetObjResult(interp); + + if (Tcl_IsShared(objPtr)) { + objPtr = Tcl_DuplicateObj(objPtr); + } + while (1) { + const char *bytes = va_arg(argList, char *); + + if (bytes == NULL) { + break; + } + Tcl_AppendToObj(objPtr, bytes, -1); + } + Tcl_SetObjResult(interp, objPtr); va_end(argList); } @@ -717,201 +354,25 @@ Tcl_AppendElement( * to result. */ { Interp *iPtr = (Interp *) interp; -#ifdef TCL_NO_DEPRECATED Tcl_Obj *elementPtr = Tcl_NewStringObj(element, -1); Tcl_Obj *listPtr = Tcl_NewListObj(1, &elementPtr); const char *bytes; + size_t length; if (Tcl_IsShared(iPtr->objResultPtr)) { Tcl_SetObjResult(interp, Tcl_DuplicateObj(iPtr->objResultPtr)); } - bytes = TclGetString(iPtr->objResultPtr); - if (TclNeedSpace(bytes, bytes+iPtr->objResultPtr->length)) { + bytes = Tcl_GetStringFromObj(iPtr->objResultPtr, &length); + if (TclNeedSpace(bytes, bytes + length)) { Tcl_AppendToObj(iPtr->objResultPtr, " ", 1); } Tcl_AppendObjToObj(iPtr->objResultPtr, listPtr); Tcl_DecrRefCount(listPtr); -#else - char *dst; - int size; - int flags; - int quoteHash = 1; - - /* - * If the string result is empty, move the object result to the string - * result, then reset the object result. - */ - - (void) Tcl_GetStringResult(interp); - - /* - * See how much space is needed, and grow the append buffer if needed to - * accommodate the list element. - */ - - size = Tcl_ScanElement(element, &flags) + 1; - if ((iPtr->result != iPtr->appendResult) - || (iPtr->appendResult[iPtr->appendUsed] != 0) - || ((size + iPtr->appendUsed) >= iPtr->appendAvl)) { - SetupAppendBuffer(iPtr, size+iPtr->appendUsed); - } - - /* - * Convert the string into a list element and copy it to the buffer that's - * forming, with a space separator if needed. - */ - - dst = iPtr->appendResult + iPtr->appendUsed; - if (TclNeedSpace(iPtr->appendResult, dst)) { - iPtr->appendUsed++; - *dst = ' '; - dst++; - - /* - * If we need a space to separate this element from preceding stuff, - * then this element will not lead a list, and need not have it's - * leading '#' quoted. - */ - quoteHash = 0; - } else { - while ((--dst >= iPtr->appendResult) && TclIsSpaceProcM(*dst)) { - } - quoteHash = !TclNeedSpace(iPtr->appendResult, dst+1); - } - dst = iPtr->appendResult + iPtr->appendUsed; - if (!quoteHash) { - flags |= TCL_DONT_QUOTE_HASH; - } - - iPtr->appendUsed += Tcl_ConvertElement(element, dst, flags); -#endif /* !TCL_NO_DEPRECATED */ } /* *---------------------------------------------------------------------- * - * SetupAppendBuffer -- - * - * This function makes sure that there is an append buffer properly - * initialized, if necessary, from the interpreter's result, and that it - * has at least enough room to accommodate newSpace new bytes of - * information. - * - * Results: - * None. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -#ifndef TCL_NO_DEPRECATED -static void -SetupAppendBuffer( - Interp *iPtr, /* Interpreter whose result is being set up. */ - int newSpace) /* Make sure that at least this many bytes of - * new information may be added. */ -{ - int totalSpace; - - /* - * Make the append buffer larger, if that's necessary, then copy the - * result into the append buffer and make the append buffer the official - * Tcl result. - */ - - if (iPtr->result != iPtr->appendResult) { - /* - * If an oversized buffer was used recently, then free it up so we go - * back to a smaller buffer. This avoids tying up memory forever after - * a large operation. - */ - - if (iPtr->appendAvl > 500) { - ckfree(iPtr->appendResult); - iPtr->appendResult = NULL; - iPtr->appendAvl = 0; - } - iPtr->appendUsed = strlen(iPtr->result); - } else if (iPtr->result[iPtr->appendUsed] != 0) { - /* - * Most likely someone has modified a result created by - * Tcl_AppendResult et al. so that it has a different size. Just - * recompute the size. - */ - - iPtr->appendUsed = strlen(iPtr->result); - } - - totalSpace = newSpace + iPtr->appendUsed; - if (totalSpace >= iPtr->appendAvl) { - char *newSpacePtr; - - if (totalSpace < 100) { - totalSpace = 200; - } else { - totalSpace *= 2; - } - newSpacePtr = (char *)ckalloc(totalSpace); - strcpy(newSpacePtr, iPtr->result); - if (iPtr->appendResult != NULL) { - ckfree(iPtr->appendResult); - } - iPtr->appendResult = newSpacePtr; - iPtr->appendAvl = totalSpace; - } else if (iPtr->result != iPtr->appendResult) { - strcpy(iPtr->appendResult, iPtr->result); - } - - Tcl_FreeResult((Tcl_Interp *) iPtr); - iPtr->result = iPtr->appendResult; -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_FreeResult -- - * - * This function frees up the memory associated with an interpreter's - * string result. It also resets the interpreter's result object. - * Tcl_FreeResult is most commonly used when a function is about to - * replace one result value with another. - * - * Results: - * None. - * - * Side effects: - * Frees the memory associated with interp's string result and sets - * interp->freeProc to zero, but does not change interp->result or clear - * error state. Resets interp's result object to an unshared empty - * object. - * - *---------------------------------------------------------------------- - */ - -void -Tcl_FreeResult( - Tcl_Interp *interp)/* Interpreter for which to free result. */ -{ - Interp *iPtr = (Interp *) interp; - - if (iPtr->freeProc != NULL) { - if (iPtr->freeProc == TCL_DYNAMIC) { - ckfree(iPtr->result); - } else { - iPtr->freeProc(iPtr->result); - } - iPtr->freeProc = 0; - } - - ResetObjResult(iPtr); -} -#endif /* !TCL_NO_DEPRECATED */ - -/* - *---------------------------------------------------------------------- - * * Tcl_ResetResult -- * * This function resets both the interpreter's string and object results. @@ -935,18 +396,6 @@ Tcl_ResetResult( Interp *iPtr = (Interp *) interp; ResetObjResult(iPtr); -#ifndef TCL_NO_DEPRECATED - if (iPtr->freeProc != NULL) { - if (iPtr->freeProc == TCL_DYNAMIC) { - ckfree(iPtr->result); - } else { - iPtr->freeProc(iPtr->result); - } - iPtr->freeProc = 0; - } - iPtr->result = iPtr->resultSpace; - iPtr->resultSpace[0] = 0; -#endif /* !TCL_NO_DEPRECATED */ if (iPtr->errorCode) { /* Legacy support */ if (iPtr->flags & ERR_LEGACY_COPY) { @@ -1008,7 +457,7 @@ ResetObjResult( } else { if (objResultPtr->bytes != &tclEmptyString) { if (objResultPtr->bytes) { - ckfree(objResultPtr->bytes); + Tcl_Free(objResultPtr->bytes); } objResultPtr->bytes = &tclEmptyString; objResultPtr->length = 0; @@ -1020,7 +469,7 @@ ResetObjResult( /* *---------------------------------------------------------------------- * - * Tcl_SetErrorCodeVA -- + * Tcl_SetErrorCode -- * * This function is called to record machine-readable information about * an error that is about to be returned. @@ -1037,10 +486,10 @@ ResetObjResult( */ void -Tcl_SetErrorCodeVA( - Tcl_Interp *interp, /* Interpreter in which to set errorCode */ - va_list argList) /* Variable argument list. */ +Tcl_SetErrorCode( + Tcl_Interp *interp, ...) { + va_list argList; Tcl_Obj *errorObj; /* @@ -1048,7 +497,14 @@ Tcl_SetErrorCodeVA( * errorCode field as list elements. */ - TclNewObj(errorObj); + va_start(argList, interp); + errorObj = Tcl_NewObj(); + + /* + * Scan through the arguments one at a time, appending them to the + * errorCode field as list elements. + */ + while (1) { char *elem = va_arg(argList, char *); @@ -1058,40 +514,6 @@ Tcl_SetErrorCodeVA( Tcl_ListObjAppendElement(NULL, errorObj, Tcl_NewStringObj(elem, -1)); } Tcl_SetObjErrorCode(interp, errorObj); -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_SetErrorCode -- - * - * This function is called to record machine-readable information about - * an error that is about to be returned. - * - * Results: - * None. - * - * Side effects: - * The errorCode field of the interp is modified to hold all of the - * arguments to this function, in a list form with each argument becoming - * one element of the list. - * - *---------------------------------------------------------------------- - */ - -void -Tcl_SetErrorCode( - Tcl_Interp *interp, ...) -{ - va_list argList; - - /* - * Scan through the arguments one at a time, appending them to the - * errorCode field as list elements. - */ - - va_start(argList, interp); - Tcl_SetErrorCodeVA(interp, argList); va_end(argList); } @@ -1137,7 +559,6 @@ Tcl_SetObjErrorCode( *---------------------------------------------------------------------- */ -#undef Tcl_GetErrorLine int Tcl_GetErrorLine( Tcl_Interp *interp) @@ -1155,7 +576,6 @@ Tcl_GetErrorLine( *---------------------------------------------------------------------- */ -#undef Tcl_SetErrorLine void Tcl_SetErrorLine( Tcl_Interp *interp, @@ -1239,7 +659,7 @@ GetKeys(void) static void ReleaseKeys( - ClientData clientData) + void *clientData) { Tcl_Obj **keys = (Tcl_Obj **)clientData; int i; @@ -1301,8 +721,10 @@ TclProcessReturn( Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORINFO], &valuePtr); if (valuePtr != NULL) { - (void) TclGetString(valuePtr); - if (valuePtr->length) { + size_t length; + + (void) Tcl_GetStringFromObj(valuePtr, &length); + if (length) { iPtr->errorInfo = valuePtr; Tcl_IncrRefCount(iPtr->errorInfo); iPtr->flags |= ERR_ALREADY_LOGGED; @@ -1311,7 +733,7 @@ TclProcessReturn( Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORSTACK], &valuePtr); if (valuePtr != NULL) { - int len, valueObjc; + size_t len, valueObjc; Tcl_Obj **valueObjv; if (Tcl_IsShared(iPtr->errorStack)) { @@ -1488,7 +910,7 @@ TclMergeReturnOptions( Tcl_DictObjGet(NULL, returnOpts, keys[KEY_ERRORCODE], &valuePtr); if (valuePtr != NULL) { - int length; + size_t length; if (TCL_ERROR == TclListObjLengthM(NULL, valuePtr, &length )) { /* @@ -1510,9 +932,9 @@ TclMergeReturnOptions( Tcl_DictObjGet(NULL, returnOpts, keys[KEY_ERRORSTACK], &valuePtr); if (valuePtr != NULL) { - int length; + size_t length; - if (TCL_ERROR == TclListObjLengthM(NULL, valuePtr, &length )) { + if (TCL_ERROR == TclListObjLengthM(NULL, valuePtr, &length)) { /* * Value is not a list, which is illegal for -errorstack. */ @@ -1678,7 +1100,8 @@ Tcl_SetReturnOptions( Tcl_Interp *interp, Tcl_Obj *options) { - int objc, level, code; + size_t objc; + int level, code; Tcl_Obj **objv, *mergedOpts; Tcl_IncrRefCount(options); diff --git a/generic/tclScan.c b/generic/tclScan.c index c200fa0..5eafa53 100644 --- a/generic/tclScan.c +++ b/generic/tclScan.c @@ -104,9 +104,9 @@ BuildCharSet( end += TclUtfToUniChar(end, &ch); } - cset->chars = (Tcl_UniChar *)ckalloc(sizeof(Tcl_UniChar) * (end - format - 1)); + cset->chars = (Tcl_UniChar *)Tcl_Alloc(sizeof(Tcl_UniChar) * (end - format - 1)); if (nranges > 0) { - cset->ranges = (Range *)ckalloc(sizeof(Range) * nranges); + cset->ranges = (Range *)Tcl_Alloc(sizeof(Range) * nranges); } else { cset->ranges = NULL; } @@ -226,9 +226,9 @@ static void ReleaseCharSet( CharSet *cset) { - ckfree(cset->chars); + Tcl_Free(cset->chars); if (cset->ranges) { - ckfree(cset->ranges); + Tcl_Free(cset->ranges); } } @@ -564,7 +564,7 @@ ValidateFormat( int Tcl_ScanObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -587,7 +587,7 @@ Tcl_ScanObjCmd( return TCL_ERROR; } - format = Tcl_GetString(objv[2]); + format = TclGetString(objv[2]); numVars = objc-3; /* @@ -603,13 +603,13 @@ Tcl_ScanObjCmd( */ if (totalVars > 0) { - objs = (Tcl_Obj **)ckalloc(sizeof(Tcl_Obj *) * totalVars); + objs = (Tcl_Obj **)Tcl_Alloc(sizeof(Tcl_Obj *) * totalVars); for (i = 0; i < totalVars; i++) { objs[i] = NULL; } } - string = Tcl_GetString(objv[1]); + string = TclGetString(objv[1]); baseString = string; /* @@ -949,7 +949,7 @@ Tcl_ScanObjCmd( if (res == TCL_ERROR) { if (objs != NULL) { - ckfree(objs); + Tcl_Free(objs); } Tcl_DecrRefCount(objPtr); Tcl_SetObjResult(interp, Tcl_NewStringObj( @@ -1085,7 +1085,7 @@ Tcl_ScanObjCmd( } } if (objs != NULL) { - ckfree(objs); + Tcl_Free(objs); } if (code == TCL_OK) { if (underflow && (nconversions == 0)) { diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c index 3b40f96..a816062 100644 --- a/generic/tclStrToD.c +++ b/generic/tclStrToD.c @@ -385,9 +385,9 @@ static Tcl_WideUInt Nokia770Twiddle(Tcl_WideUInt w); * the first byte to be scanned. If bytes is NULL, then objPtr must be * non-NULL, and the string representation of objPtr will be scanned * (generated first, if necessary). The numBytes argument determines the - * number of bytes to be scanned. If numBytes is negative, the first NUL - * byte encountered will terminate the scan. If numBytes is non-negative, - * then no more than numBytes bytes will be scanned. + * number of bytes to be scanned. If numBytes is TCL_INDEX_NONE, the first NUL + * byte encountered will terminate the scan. Otherwise, + * no more than numBytes bytes will be scanned. * * The argument flags is an input that controls the numeric formats * recognized by the parser. The flag bits are: @@ -483,7 +483,7 @@ TclParseNumber( * ("integer", "boolean value", etc.). */ const char *bytes, /* Pointer to the start of the string to * scan. */ - int numBytes, /* Maximum number of bytes to scan, see + size_t numBytes, /* Maximum number of bytes to scan, see * above. */ const char **endPtrPtr, /* Place to store pointer to the character * that terminated the scan. */ @@ -492,7 +492,7 @@ TclParseNumber( enum State { INITIAL, SIGNUM, ZERO, ZERO_X, ZERO_O, ZERO_B, ZERO_D, BINARY, - HEXADECIMAL, OCTAL, BAD_OCTAL, DECIMAL, + HEXADECIMAL, OCTAL, DECIMAL, LEADING_RADIX_POINT, FRACTION, EXPONENT_START, EXPONENT_SIGNUM, EXPONENT, sI, sIN, sINF, sINFI, sINFIN, sINFINI, sINFINIT, sINFINITY @@ -537,7 +537,6 @@ TclParseNumber( char d = 0; /* Last hexadecimal digit scanned; initialized * to avoid a compiler warning. */ int shift = 0; /* Amount to shift when accumulating binary */ - int explicitOctal = 0; mp_err err = MP_OKAY; int under = 0; /* Flag trailing '_' as error if true once * number is accepted. */ @@ -556,7 +555,7 @@ TclParseNumber( return TCL_ERROR; } if (TclHasInternalRep(objPtr, &tclListType)) { - int length; + size_t length; /* A list can only be a (single) number if its length == 1 */ TclListObjLengthM(NULL, objPtr, &length); if (length != 1) { @@ -674,7 +673,6 @@ TclParseNumber( if (under) { goto endgame; } - explicitOctal = 1; state = ZERO_O; break; } @@ -685,10 +683,7 @@ TclParseNumber( state = ZERO_D; break; } -#ifdef TCL_NO_DEPRECATED goto decimal; -#endif - /* FALLTHROUGH */ case OCTAL: /* @@ -773,62 +768,6 @@ TclParseNumber( under = 1; break; } - /* FALLTHROUGH */ - - case BAD_OCTAL: - if (explicitOctal) { - /* - * No forgiveness for bad digits in explicitly octal numbers. - */ - - goto endgame; - } - if (flags & TCL_PARSE_INTEGER_ONLY) { - /* - * No seeking floating point when parsing only integer. - */ - - goto endgame; - } -#ifndef TCL_NO_DEPRECATED - - /* - * Scanned a number with a leading zero that contains an 8, 9, - * radix point or E. This is an invalid octal number, but might - * still be floating point. - */ - - if (c == '0') { - numTrailZeros++; - under = 0; - state = BAD_OCTAL; - break; - } else if (isdigit(UCHAR(c))) { - if (objPtr != NULL) { - significandOverflow = AccumulateDecimalDigit( - (unsigned)(c-'0'), numTrailZeros, - &significandWide, &significandBig, - significandOverflow); - } - if (numSigDigs != 0) { - numSigDigs += (numTrailZeros + 1); - } else { - numSigDigs = 1; - } - numTrailZeros = 0; - under = 0; - state = BAD_OCTAL; - break; - } else if (c == '.') { - under = 0; - state = FRACTION; - break; - } else if (c == 'E' || c == 'e') { - under = 0; - state = EXPONENT_START; - break; - } -#endif goto endgame; /* @@ -996,9 +935,7 @@ TclParseNumber( * digits. */ -#ifdef TCL_NO_DEPRECATED decimal: -#endif acceptState = state; acceptPoint = p; acceptLen = len; @@ -1308,7 +1245,7 @@ TclParseNumber( } } if (endPtrPtr == NULL) { - if ((len != 0) && ((numBytes > 0) || (*p != '\0'))) { + if ((len != 0) && ((numBytes + 1 > 1) || (*p != '\0'))) { status = TCL_ERROR; } } else { @@ -1324,7 +1261,6 @@ TclParseNumber( TclFreeInternalRep(objPtr); switch (acceptState) { case SIGNUM: - case BAD_OCTAL: case ZERO_X: case ZERO_O: case ZERO_B: @@ -1587,9 +1523,6 @@ TclParseNumber( Tcl_AppendLimitedToObj(msg, bytes, numBytes, 50, ""); Tcl_AppendToObj(msg, "\"", -1); - if (state == BAD_OCTAL) { - Tcl_AppendToObj(msg, " (looks like invalid octal number)", -1); - } Tcl_SetObjResult(interp, msg); Tcl_SetErrorCode(interp, "TCL", "VALUE", "NUMBER", NULL); } @@ -2475,7 +2408,7 @@ TakeAbsoluteValue( * * Results: * Returns one of the strings 'Infinity' and 'NaN'. The string returned - * must be freed by the caller using 'ckfree'. + * must be freed by the caller using 'Tcl_Free'. * * Side effects: * Stores 9999 in *decpt, and sets '*endPtr' to designate the terminating @@ -2494,13 +2427,13 @@ FormatInfAndNaN( *decpt = 9999; if (!(d->w.word1) && !(d->w.word0 & HI_ORDER_SIG_MASK)) { - retval = (char *)ckalloc(9); + retval = (char *)Tcl_Alloc(9); strcpy(retval, "Infinity"); if (endPtr) { *endPtr = retval + 8; } } else { - retval = (char *)ckalloc(4); + retval = (char *)Tcl_Alloc(4); strcpy(retval, "NaN"); if (endPtr) { *endPtr = retval + 3; @@ -2531,7 +2464,7 @@ FormatZero( int *decpt, /* Location of the decimal point. */ char **endPtr) /* Pointer to the end of the formatted data */ { - char *retval = (char *)ckalloc(2); + char *retval = (char *)Tcl_Alloc(2); strcpy(retval, "0"); if (endPtr) { @@ -3077,7 +3010,7 @@ QuickConversion( * Handle the peculiar case where the result has no significant digits. */ - retval = (char *)ckalloc(len + 1); + retval = (char *)Tcl_Alloc(len + 1); if (ilim == 0) { d = d - 5.; if (d > eps.d) { @@ -3088,7 +3021,7 @@ QuickConversion( *decpt = k; return retval; } else { - ckfree(retval); + Tcl_Free(retval); return NULL; } } @@ -3103,7 +3036,7 @@ QuickConversion( end = StrictQuickFormat(d, k, ilim, eps.d, retval, decpt); } if (end == NULL) { - ckfree(retval); + Tcl_Free(retval); return NULL; } *end = '\0'; @@ -3188,7 +3121,7 @@ ShorteningInt64Conversion( char **endPtr) /* OUTPUT: Position of the terminal '\0' at * the end of the returned string. */ { - char *retval = (char *)ckalloc(len + 1); + char *retval = (char *)Tcl_Alloc(len + 1); /* Output buffer. */ Tcl_WideUInt b = (bw * wuipow5[b5]) << b2; /* Numerator of the fraction being @@ -3351,7 +3284,7 @@ StrictInt64Conversion( char **endPtr) /* OUTPUT: Position of the terminal '\0' at * the end of the returned string. */ { - char *retval = (char *)ckalloc(len + 1); + char *retval = (char *)Tcl_Alloc(len + 1); /* Output buffer. */ Tcl_WideUInt b = (bw * wuipow5[b5]) << b2; /* Numerator of the fraction being @@ -3551,7 +3484,7 @@ ShorteningBignumConversionPowD( char **endPtr) /* OUTPUT: Position of the terminal '\0' at * the end of the returned string. */ { - char *retval = (char *)ckalloc(len + 1); + char *retval = (char *)Tcl_Alloc(len + 1); /* Output buffer. */ mp_int b; /* Numerator of the fraction being * converted. */ @@ -3758,7 +3691,7 @@ StrictBignumConversionPowD( char **endPtr) /* OUTPUT: Position of the terminal '\0' at * the end of the returned string. */ { - char *retval = (char *)ckalloc(len + 1); + char *retval = (char *)Tcl_Alloc(len + 1); /* Output buffer. */ mp_int b; /* Numerator of the fraction being * converted. */ @@ -3912,7 +3845,7 @@ ShouldBankerRoundUpToNext( } r = mp_cmp_mag(&temp, S); mp_clear(&temp); - switch(r) { + switch (r) { case MP_EQ: return isodd; case MP_GT: @@ -3954,7 +3887,7 @@ ShorteningBignumConversion( int *decpt, /* OUTPUT: Position of the decimal point. */ char **endPtr) /* OUTPUT: Pointer to the end of the number */ { - char *retval = (char *)ckalloc(len+1); + char *retval = (char *)Tcl_Alloc(len+1); /* Buffer of digits to return. */ char *s = retval; /* Cursor in the return value. */ mp_int b; /* Numerator of the result. */ @@ -4188,7 +4121,7 @@ StrictBignumConversion( int *decpt, /* OUTPUT: Position of the decimal point. */ char **endPtr) /* OUTPUT: Pointer to the end of the number */ { - char *retval = (char *)ckalloc(len+1); + char *retval = (char *)Tcl_Alloc(len+1); /* Buffer of digits to return. */ char *s = retval; /* Cursor in the return value. */ mp_int b; /* Numerator of the result. */ @@ -4354,15 +4287,14 @@ StrictBignumConversion( * This function is a service routine that produces the string of digits for * floating-point-to-decimal conversion. It can do a number of things * according to the 'flags' argument. Valid values for 'flags' include: - * TCL_DD_SHORTEST - This is the default for floating point conversion if - * ::tcl_precision is 0. It constructs the shortest string of + * TCL_DD_SHORTEST - This is the default for floating point conversion. + * It constructs the shortest string of * digits that will reconvert to the given number when scanned. * For floating point numbers that are exactly between two * decimal numbers, it resolves using the 'round to even' rule. * With this value, the 'ndigits' parameter is ignored. * TCL_DD_E_FORMAT - This value is used to prepare numbers for %e format - * conversion (or for default floating->string if tcl_precision - * is not 0). It constructs a string of at most 'ndigits' digits, + * conversion. It constructs a string of at most 'ndigits' digits, * choosing the one that is closest to the given number (and * resolving ties with 'round to even'). It is allowed to return * fewer than 'ndigits' if the number converts exactly; if the @@ -4698,7 +4630,7 @@ TclInitDoubleConversion(void) maxpow10_wide = (int) floor(sizeof(Tcl_WideUInt) * CHAR_BIT * log(2.) / log(10.)); pow10_wide = (Tcl_WideUInt *) - ckalloc((maxpow10_wide + 1) * sizeof(Tcl_WideUInt)); + Tcl_Alloc((maxpow10_wide + 1) * sizeof(Tcl_WideUInt)); u = 1; for (i = 0; i < maxpow10_wide; ++i) { pow10_wide[i] = u; @@ -4808,7 +4740,7 @@ TclFinalizeDoubleConversion(void) { int i; - ckfree(pow10_wide); + Tcl_Free(pow10_wide); for (i=0; i<9; ++i) { mp_clear(pow5 + i); } diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 25bf34b..545a1e0 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -37,7 +37,6 @@ #include "tclInt.h" #include "tclTomMath.h" #include "tclStringRep.h" - #include "assert.h" /* * Prototypes for functions defined later in this file: @@ -46,42 +45,38 @@ static void AppendPrintfToObjVA(Tcl_Obj *objPtr, const char *format, va_list argList); static void AppendUnicodeToUnicodeRep(Tcl_Obj *objPtr, - const Tcl_UniChar *unicode, int appendNumChars); + const Tcl_UniChar *unicode, size_t appendNumChars); static void AppendUnicodeToUtfRep(Tcl_Obj *objPtr, - const Tcl_UniChar *unicode, int numChars); + const Tcl_UniChar *unicode, size_t numChars); static void AppendUtfToUnicodeRep(Tcl_Obj *objPtr, - const char *bytes, int numBytes); + const char *bytes, size_t numBytes); static void AppendUtfToUtfRep(Tcl_Obj *objPtr, - const char *bytes, int numBytes); + const char *bytes, size_t numBytes); static void DupStringInternalRep(Tcl_Obj *objPtr, Tcl_Obj *copyPtr); -static int ExtendStringRepWithUnicode(Tcl_Obj *objPtr, - const Tcl_UniChar *unicode, int numChars); +static size_t ExtendStringRepWithUnicode(Tcl_Obj *objPtr, + const Tcl_UniChar *unicode, size_t numChars); static void ExtendUnicodeRepWithString(Tcl_Obj *objPtr, - const char *bytes, int numBytes, - int numAppendChars); + const char *bytes, size_t numBytes, + size_t numAppendChars); static void FillUnicodeRep(Tcl_Obj *objPtr); static void FreeStringInternalRep(Tcl_Obj *objPtr); -static void GrowStringBuffer(Tcl_Obj *objPtr, int needed, int flag); -static void GrowUnicodeBuffer(Tcl_Obj *objPtr, int needed); +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, int numChars); -static int UnicodeLength(const Tcl_UniChar *unicode); -#if !defined(TCL_NO_DEPRECATED) -static int UTF16Length(const unsigned short *unicode); -#endif + const Tcl_UniChar *unicode, size_t numChars); +static size_t UnicodeLength(const Tcl_UniChar *unicode); static void UpdateStringOfString(Tcl_Obj *objPtr); -#if (TCL_UTF_MAX) > 3 && !defined(TCL_NO_DEPRECATED) -static void DupUTF16StringInternalRep(Tcl_Obj *objPtr, - Tcl_Obj *copyPtr); -static int SetUTF16StringFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); -static void UpdateStringOfUTF16String(Tcl_Obj *objPtr); -#endif +#if TCL_UTF_MAX > 3 +#define ISCONTINUATION(bytes) (\ + ((bytes)[0] & 0xC0) == 0x80) +#else #define ISCONTINUATION(bytes) (\ ((((bytes)[0] & 0xC0) == 0x80) || (((bytes)[0] == '\xED') \ && (((bytes)[1] & 0xF0) == 0xB0) && (((bytes)[2] & 0xC0) == 0x80)))) +#endif /* @@ -89,170 +84,15 @@ static void UpdateStringOfUTF16String(Tcl_Obj *objPtr); * functions that can be invoked by generic object code. */ -#if TCL_UTF_MAX < 4 - -#define tclUniCharStringType tclStringType -#define GET_UNICHAR_STRING GET_STRING -#define UniCharString String -#define UNICHAR_STRING_MAXCHARS STRING_MAXCHARS -#define uniCharStringAlloc stringAlloc -#define uniCharStringRealloc stringRealloc -#define uniCharStringAttemptAlloc stringAttemptAlloc -#define uniCharStringAttemptRealloc stringAttemptRealloc -#define uniCharStringCheckLimits stringCheckLimits -#define SET_UNICHAR_STRING SET_STRING -#define UNICHAR_STRING_SIZE STRING_SIZE - -const Tcl_ObjType tclStringType = { - "string", /* name */ - FreeStringInternalRep, /* freeIntRepPro */ - DupStringInternalRep, /* dupIntRepProc */ - UpdateStringOfString, /* updateStringProc */ - SetStringFromAny /* setFromAnyProc */ -}; - -#else - -#ifndef TCL_NO_DEPRECATED const Tcl_ObjType tclStringType = { "string", /* name */ FreeStringInternalRep, /* freeIntRepPro */ - DupUTF16StringInternalRep, /* dupIntRepProc */ - UpdateStringOfUTF16String, /* updateStringProc */ - SetUTF16StringFromAny /* setFromAnyProc */ -}; -#endif - -const Tcl_ObjType tclUniCharStringType = { - "utf32string", /* name */ - FreeStringInternalRep, /* freeIntRepPro */ DupStringInternalRep, /* dupIntRepProc */ UpdateStringOfString, /* updateStringProc */ - SetStringFromAny /* setFromAnyProc */ + SetStringFromAny, /* setFromAnyProc */ + TCL_OBJTYPE_V0 }; - -typedef struct { - int numChars; /* The number of chars in the string. -1 means - * this value has not been calculated. >= 0 - * means that there is a valid Unicode rep, or - * that the number of UTF bytes == the number - * of chars. */ - int allocated; /* The amount of space actually allocated for - * the UTF string (minus 1 byte for the - * termination char). */ - int maxChars; /* Max number of chars that can fit in the - * 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. */ -} UniCharString; - -#define UNICHAR_STRING_MAXCHARS \ - (int)(((size_t)UINT_MAX - offsetof(UniCharString, unicode))/sizeof(Tcl_UniChar) - 1) -#define UNICHAR_STRING_SIZE(numChars) \ - (offsetof(UniCharString, unicode) + sizeof(Tcl_UniChar) + ((numChars) * sizeof(Tcl_UniChar))) -#define uniCharStringCheckLimits(numChars) \ - do { \ - if ((numChars) < 0 || (numChars) > UNICHAR_STRING_MAXCHARS) { \ - Tcl_Panic("max length for a Tcl unicode value (%d chars) exceeded", \ - UNICHAR_STRING_MAXCHARS); \ - } \ - } while (0) -#define uniCharStringAttemptAlloc(numChars) \ - (UniCharString *) attemptckalloc(UNICHAR_STRING_SIZE(numChars)) -#define uniCharStringAlloc(numChars) \ - (UniCharString *) ckalloc(UNICHAR_STRING_SIZE(numChars)) -#define uniCharStringRealloc(ptr, numChars) \ - (UniCharString *) ckrealloc((ptr), UNICHAR_STRING_SIZE(numChars)) -#define uniCharStringAttemptRealloc(ptr, numChars) \ - (UniCharString *) attemptckrealloc((ptr), UNICHAR_STRING_SIZE(numChars)) -#define GET_UNICHAR_STRING(objPtr) \ - ((UniCharString *) (objPtr)->internalRep.twoPtrValue.ptr1) -#define SET_UNICHAR_STRING(objPtr, stringPtr) \ - ((objPtr)->internalRep.twoPtrValue.ptr2 = NULL), \ - ((objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (stringPtr)) - - -#ifndef TCL_NO_DEPRECATED -static void -DupUTF16StringInternalRep( - Tcl_Obj *srcPtr, /* Object with internal rep to copy. Must have - * an internal rep of type "String". */ - Tcl_Obj *copyPtr) /* Object with internal rep to set. Must not - * currently have an internal rep.*/ -{ - String *srcStringPtr = GET_STRING(srcPtr); - size_t size = offsetof(String, unicode) + (((srcStringPtr->allocated) + 1U) * sizeof(unsigned short)); - String *copyStringPtr = (String *)ckalloc(size); - memcpy(copyStringPtr, srcStringPtr, size); - - SET_STRING(copyPtr, copyStringPtr); - copyPtr->typePtr = &tclStringType; -} - -static int -SetUTF16StringFromAny( - TCL_UNUSED(Tcl_Interp *), - Tcl_Obj *objPtr) /* The object to convert. */ -{ - if (!TclHasInternalRep(objPtr, &tclStringType)) { - Tcl_DString ds; - - /* - * Convert whatever we have into an untyped value. Just A String. - */ - - (void) TclGetString(objPtr); - TclFreeInternalRep(objPtr); - - /* - * Create a basic String internalrep that just points to the UTF-8 string - * already in place at objPtr->bytes. - */ - - Tcl_DStringInit(&ds); - unsigned short *utf16string = Tcl_UtfToChar16DString(objPtr->bytes, objPtr->length, &ds); - int size = Tcl_DStringLength(&ds); - String *stringPtr = (String *)ckalloc((offsetof(String, unicode) + sizeof(unsigned short)) + size); - - memcpy(stringPtr->unicode, utf16string, size); - Tcl_DStringFree(&ds); - size /= sizeof(unsigned short); - stringPtr->unicode[size] = 0; - - stringPtr->numChars = size; - stringPtr->allocated = size; - stringPtr->maxChars = size; - stringPtr->hasUnicode = 1; - SET_STRING(objPtr, stringPtr); - objPtr->typePtr = &tclStringType; - } - return TCL_OK; -} - -static void -UpdateStringOfUTF16String( - Tcl_Obj *objPtr) /* Object with string rep to update. */ -{ - Tcl_DString ds; - String *stringPtr = GET_STRING(objPtr); - - Tcl_DStringInit(&ds); - const char *string = Tcl_Char16ToUtfDString(stringPtr->unicode, stringPtr->numChars, &ds); - - char *bytes = (char *)ckalloc(Tcl_DStringLength(&ds) + 1U); - memcpy(bytes, string, Tcl_DStringLength(&ds)); - bytes[Tcl_DStringLength(&ds)] = 0; - objPtr->bytes = bytes; - objPtr->length = Tcl_DStringLength(&ds); - Tcl_DStringFree(&ds); -} -#endif - -#endif - + /* * TCL STRING GROWTH ALGORITHM * @@ -293,7 +133,7 @@ UpdateStringOfUTF16String( static void GrowStringBuffer( Tcl_Obj *objPtr, - int needed, + size_t needed, int flag) { /* @@ -303,30 +143,28 @@ GrowStringBuffer( * flag || objPtr->bytes != NULL */ - UniCharString *stringPtr = GET_UNICHAR_STRING(objPtr); + String *stringPtr = GET_STRING(objPtr); char *ptr = NULL; - int attempt; + size_t attempt; if (objPtr->bytes == &tclEmptyString) { objPtr->bytes = NULL; } if (flag == 0 || stringPtr->allocated > 0) { - if (needed <= INT_MAX / 2) { - attempt = 2 * needed; - ptr = (char *)attemptckrealloc(objPtr->bytes, attempt + 1U); - } + attempt = 2 * needed; + ptr = (char *)Tcl_AttemptRealloc(objPtr->bytes, attempt + 1U); if (ptr == NULL) { /* * Take care computing the amount of modest growth to avoid * overflow into invalid argument values for attempt. */ - unsigned int limit = INT_MAX - needed; - unsigned int extra = needed - objPtr->length + TCL_MIN_GROWTH; - int growth = (int) ((extra > limit) ? limit : extra); + size_t limit = INT_MAX - needed; + size_t extra = needed - objPtr->length + TCL_MIN_GROWTH; + size_t growth = (extra > limit) ? limit : extra; attempt = needed + growth; - ptr = (char *)attemptckrealloc(objPtr->bytes, attempt + 1U); + ptr = (char *)Tcl_AttemptRealloc(objPtr->bytes, attempt + 1U); } } if (ptr == NULL) { @@ -335,7 +173,7 @@ GrowStringBuffer( */ attempt = needed; - ptr = (char *)ckrealloc(objPtr->bytes, attempt + 1U); + ptr = (char *)Tcl_Realloc(objPtr->bytes, attempt + 1U); } objPtr->bytes = ptr; stringPtr->allocated = attempt; @@ -344,40 +182,35 @@ GrowStringBuffer( static void GrowUnicodeBuffer( Tcl_Obj *objPtr, - int needed) + size_t needed) { /* * Pre-conditions: * objPtr->typePtr == &tclStringType * needed > stringPtr->maxChars - * needed < UNICHAR_STRING_MAXCHARS */ - UniCharString *ptr = NULL, *stringPtr = GET_UNICHAR_STRING(objPtr); - int attempt; + String *ptr = NULL, *stringPtr = GET_STRING(objPtr); + size_t attempt; if (stringPtr->maxChars > 0) { /* * Subsequent appends - apply the growth algorithm. */ - if (needed <= UNICHAR_STRING_MAXCHARS / 2) { - attempt = 2 * needed; - ptr = uniCharStringAttemptRealloc(stringPtr, attempt); - } + attempt = 2 * needed; + ptr = stringAttemptRealloc(stringPtr, attempt); if (ptr == NULL) { /* * Take care computing the amount of modest growth to avoid * overflow into invalid argument values for attempt. */ - unsigned int limit = UNICHAR_STRING_MAXCHARS - needed; - unsigned int extra = needed - stringPtr->numChars + size_t extra = needed - stringPtr->numChars + TCL_MIN_UNICHAR_GROWTH; - int growth = (int) ((extra > limit) ? limit : extra); - attempt = needed + growth; - ptr = uniCharStringAttemptRealloc(stringPtr, attempt); + attempt = needed + extra; + ptr = stringAttemptRealloc(stringPtr, attempt); } } if (ptr == NULL) { @@ -386,11 +219,11 @@ GrowUnicodeBuffer( */ attempt = needed; - ptr = uniCharStringRealloc(stringPtr, attempt); + ptr = stringRealloc(stringPtr, attempt); } stringPtr = ptr; stringPtr->maxChars = attempt; - SET_UNICHAR_STRING(objPtr, stringPtr); + SET_STRING(objPtr, stringPtr); } /* @@ -410,7 +243,7 @@ GrowUnicodeBuffer( * * Side effects: * The new object's internal string representation will be set to a copy - * of the length bytes starting at "bytes". If "length" is negative, use + * of the length bytes starting at "bytes". If "length" is TCL_INDEX_NONE, use * bytes up to the first NUL byte; i.e., assume "bytes" points to a * C-style NUL-terminated string. The object's type is set to NULL. An * extra NUL is added to the end of the new object's byte array. @@ -424,9 +257,9 @@ Tcl_Obj * Tcl_NewStringObj( const char *bytes, /* Points to the first of the length bytes * used to initialize the new object. */ - int length) /* The number of bytes to copy from "bytes" + size_t length) /* The number of bytes to copy from "bytes" * when initializing the new object. If - * negative, use bytes up to the first NUL + * TCL_INDEX_NONE, use bytes up to the first NUL * byte. */ { return Tcl_DbNewStringObj(bytes, length, "unknown", 0); @@ -436,14 +269,13 @@ Tcl_Obj * Tcl_NewStringObj( const char *bytes, /* Points to the first of the length bytes * used to initialize the new object. */ - int length) /* The number of bytes to copy from "bytes" - * when initializing the new object. If - * negative, use bytes up to the first NUL - * byte. */ + size_t 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 < 0) { + if (length == TCL_INDEX_NONE) { length = (bytes? strlen(bytes) : 0); } TclNewStringObj(objPtr, bytes, length); @@ -472,7 +304,7 @@ Tcl_NewStringObj( * * Side effects: * The new object's internal string representation will be set to a copy - * of the length bytes starting at "bytes". If "length" is negative, use + * of the length bytes starting at "bytes". If "length" is TCL_INDEX_NONE, use * bytes up to the first NUL byte; i.e., assume "bytes" points to a * C-style NUL-terminated string. The object's type is set to NULL. An * extra NUL is added to the end of the new object's byte array. @@ -485,10 +317,9 @@ Tcl_Obj * Tcl_DbNewStringObj( const char *bytes, /* Points to the first of the length bytes * used to initialize the new object. */ - int length, /* The number of bytes to copy from "bytes" - * when initializing the new object. If - * negative, use bytes up to the first NUL - * byte. */ + size_t 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 * function; used for debugging. */ int line) /* Line number in the source file; used for @@ -496,7 +327,7 @@ Tcl_DbNewStringObj( { Tcl_Obj *objPtr; - if (length < 0) { + if (length == TCL_INDEX_NONE) { length = (bytes? strlen(bytes) : 0); } TclDbNewObj(objPtr, file, line); @@ -508,10 +339,9 @@ Tcl_Obj * Tcl_DbNewStringObj( const char *bytes, /* Points to the first of the length bytes * used to initialize the new object. */ - int length, /* The number of bytes to copy from "bytes" - * when initializing the new object. If - * negative, use bytes up to the first NUL - * byte. */ + size_t 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*/, TCL_UNUSED(int) /*line*/) { @@ -539,10 +369,10 @@ Tcl_DbNewStringObj( */ Tcl_Obj * -TclNewUnicodeObj( +Tcl_NewUnicodeObj( const Tcl_UniChar *unicode, /* The unicode string used to initialize the * new object. */ - int numChars) /* Number of characters in the unicode + size_t numChars) /* Number of characters in the unicode * string. */ { Tcl_Obj *objPtr; @@ -552,39 +382,6 @@ TclNewUnicodeObj( return objPtr; } -#if (TCL_UTF_MAX > 3) && !defined(TCL_NO_DEPRECATED) -Tcl_Obj * -Tcl_NewUnicodeObj( - const unsigned short *unicode, /* The unicode string used to initialize the - * new object. */ - int numChars) /* Number of characters in the unicode - * string. */ -{ - Tcl_Obj *objPtr; - - TclNewObj(objPtr); - TclInvalidateStringRep(objPtr); - - if (numChars < 0) { - numChars = UTF16Length(unicode); - } - - String *stringPtr = (String *)ckalloc((offsetof(String, unicode) - + sizeof(unsigned short)) + numChars * sizeof(unsigned short)); - memcpy(stringPtr->unicode, unicode, numChars * sizeof(unsigned short)); - stringPtr->unicode[numChars] = 0; - - stringPtr->numChars = numChars; - stringPtr->allocated = numChars; - stringPtr->maxChars = numChars; - stringPtr->hasUnicode = 1; - SET_STRING(objPtr, stringPtr); - objPtr->typePtr = &tclStringType; - - return objPtr; -} -#endif - /* *---------------------------------------------------------------------- * @@ -602,13 +399,13 @@ Tcl_NewUnicodeObj( *---------------------------------------------------------------------- */ -int -TclGetCharLength( +size_t +Tcl_GetCharLength( Tcl_Obj *objPtr) /* The String object to get the num chars * of. */ { - UniCharString *stringPtr; - int numChars; + String *stringPtr; + size_t numChars = 0; /* * Quick, no-shimmer return for short string reps. @@ -631,10 +428,8 @@ TclGetCharLength( */ if (TclIsPureByteArray(objPtr)) { - int length; - - (void) Tcl_GetByteArrayFromObj(objPtr, &length); - return length; + (void) Tcl_GetByteArrayFromObj(objPtr, &numChars); + return numChars; } /* @@ -642,28 +437,26 @@ TclGetCharLength( */ SetStringFromAny(NULL, objPtr); - stringPtr = GET_UNICHAR_STRING(objPtr); + stringPtr = GET_STRING(objPtr); numChars = stringPtr->numChars; /* * If numChars is unknown, compute it. */ - if (numChars == -1) { + if (numChars == TCL_INDEX_NONE) { TclNumUtfCharsM(numChars, objPtr->bytes, objPtr->length); stringPtr->numChars = numChars; } return numChars; } -#if (TCL_UTF_MAX > 3) && !defined(TCL_NO_DEPRECATED) -#undef Tcl_GetCharLength -int -Tcl_GetCharLength( +size_t +TclGetCharLength( Tcl_Obj *objPtr) /* The String object to get the num chars * of. */ { - int numChars; + size_t numChars = 0; /* * Quick, no-shimmer return for short string reps. @@ -686,15 +479,15 @@ Tcl_GetCharLength( */ if (TclIsPureByteArray(objPtr)) { - (void) Tcl_GetByteArrayFromObj(objPtr, &numChars); } else { Tcl_GetString(objPtr); - numChars = Tcl_NumUtfChars(objPtr->bytes, objPtr->length); + numChars = TclNumUtfChars(objPtr->bytes, objPtr->length); } + return numChars; } -#endif + /* *---------------------------------------------------------------------- @@ -716,7 +509,7 @@ int TclCheckEmptyString( Tcl_Obj *objPtr) { - int length = -1; + size_t length = TCL_INDEX_NONE; if (objPtr->bytes == &tclEmptyString) { return TCL_EMPTYSTRING_YES; @@ -756,20 +549,14 @@ TclCheckEmptyString( *---------------------------------------------------------------------- */ -#if (TCL_UTF_MAX > 3) && !defined(TCL_NO_DEPRECATED) -#undef Tcl_GetUniChar int Tcl_GetUniChar( Tcl_Obj *objPtr, /* The object to get the Unicode charater * from. */ - int index) /* Get the index'th Unicode character. */ + size_t index) /* Get the index'th Unicode character. */ { String *stringPtr; - int ch, length; - - if (index < 0) { - return -1; - } + int ch; /* * Optimize the case where we're really dealing with a bytearray object @@ -777,25 +564,42 @@ Tcl_GetUniChar( */ if (TclIsPureByteArray(objPtr)) { + size_t length = 0; unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &length); if (index >= length) { return -1; } - return (int) bytes[index]; + return bytes[index]; } /* * OK, need to work with the object as a string. */ - SetUTF16StringFromAny(NULL, objPtr); + SetStringFromAny(NULL, objPtr); stringPtr = GET_STRING(objPtr); + if (stringPtr->hasUnicode == 0) { + /* + * If numChars is unknown, compute it. + */ + + if (stringPtr->numChars == TCL_INDEX_NONE) { + TclNumUtfCharsM(stringPtr->numChars, objPtr->bytes, objPtr->length); + } + if (stringPtr->numChars == objPtr->length) { + return (unsigned char) objPtr->bytes[index]; + } + FillUnicodeRep(objPtr); + stringPtr = GET_STRING(objPtr); + } + if (index >= stringPtr->numChars) { return -1; } ch = stringPtr->unicode[index]; +#if TCL_UTF_MAX < 4 /* See: bug [11ae2be95dac9417] */ if ((ch & 0xF800) == 0xD800) { if (ch & 0x400) { @@ -810,22 +614,17 @@ Tcl_GetUniChar( (stringPtr->unicode[index] & 0x3FF)) + 0x10000; } } +#endif return ch; } -#endif int TclGetUniChar( Tcl_Obj *objPtr, /* The object to get the Unicode charater * from. */ - int index) /* Get the index'th Unicode character. */ + size_t index) /* Get the index'th Unicode character. */ { - UniCharString *stringPtr; - int ch, length; - - if (index < 0) { - return -1; - } + int ch = 0; /* * Optimize the case where we're really dealing with a bytearray object @@ -833,93 +632,29 @@ TclGetUniChar( */ if (TclIsPureByteArray(objPtr)) { + size_t length = 0; unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &length); if (index >= length) { return -1; } - return (int) bytes[index]; + return bytes[index]; } - /* - * OK, need to work with the object as a string. - */ - - SetStringFromAny(NULL, objPtr); - stringPtr = GET_UNICHAR_STRING(objPtr); + size_t numChars = TclNumUtfChars(objPtr->bytes, objPtr->length); - if (stringPtr->hasUnicode == 0) { - /* - * If numChars is unknown, compute it. - */ - - if (stringPtr->numChars == -1) { - TclNumUtfCharsM(stringPtr->numChars, objPtr->bytes, objPtr->length); - } - if (stringPtr->numChars == objPtr->length) { - return (unsigned char) objPtr->bytes[index]; - } - FillUnicodeRep(objPtr); - stringPtr = GET_UNICHAR_STRING(objPtr); - } - - if (index >= stringPtr->numChars) { + if (index >= numChars) { return -1; } - ch = stringPtr->unicode[index]; -#if TCL_UTF_MAX < 4 - /* See: bug [11ae2be95dac9417] */ - if ((ch & 0xF800) == 0xD800) { - if (ch & 0x400) { - if ((index > 0) - && ((stringPtr->unicode[index-1] & 0xFC00) == 0xD800)) { - ch = -1; /* low surrogate preceded by high surrogate */ - } - } else if ((++index < stringPtr->numChars) - && ((stringPtr->unicode[index] & 0xFC00) == 0xDC00)) { - /* high surrogate followed by low surrogate */ - ch = (((ch & 0x3FF) << 10) | - (stringPtr->unicode[index] & 0x3FF)) + 0x10000; - } - } -#endif + const char *begin = TclUtfAtIndex(objPtr->bytes, index); +#undef Tcl_UtfToUniChar + Tcl_UtfToUniChar(begin, &ch); return ch; } /* *---------------------------------------------------------------------- * - * Tcl_GetUnicode -- - * - * Get the Unicode form of the String object. If the object is not - * already a String object, it will be converted to one. If the String - * object does not have a Unicode rep, then one is created from the UTF - * string format. - * - * Results: - * Returns a pointer to the object's internal Unicode string. - * - * Side effects: - * Converts the object to have the String internal rep. - * - *---------------------------------------------------------------------- - */ - -#undef Tcl_GetUnicodeFromObj -#ifndef TCL_NO_DEPRECATED -#undef Tcl_GetUnicode -unsigned short * -Tcl_GetUnicode( - Tcl_Obj *objPtr) /* The object to find the unicode string - * for. */ -{ - return TclGetUnicodeFromObj(objPtr, NULL); -} -#endif /* TCL_NO_DEPRECATED */ - -/* - *---------------------------------------------------------------------- - * * Tcl_GetUnicodeFromObj/TclGetUnicodeFromObj -- * * Get the Unicode form of the String object with length. If the object @@ -936,75 +671,58 @@ Tcl_GetUnicode( *---------------------------------------------------------------------- */ +#undef Tcl_GetUnicodeFromObj Tcl_UniChar * -TclGetUnicodeFromObj_( +TclGetUnicodeFromObj( 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 * NULL, no length is stored. */ { - UniCharString *stringPtr; + String *stringPtr; SetStringFromAny(NULL, objPtr); - stringPtr = GET_UNICHAR_STRING(objPtr); + stringPtr = GET_STRING(objPtr); if (stringPtr->hasUnicode == 0) { FillUnicodeRep(objPtr); - stringPtr = GET_UNICHAR_STRING(objPtr); + stringPtr = GET_STRING(objPtr); } if (lengthPtr != NULL) { - *lengthPtr = stringPtr->numChars; + if (stringPtr->numChars > INT_MAX) { + Tcl_Panic("Tcl_GetUnicodeFromObj with 'int' lengthPtr" + "cannot handle such long strings. Please use 'size_t'"); + } + *lengthPtr = (int)stringPtr->numChars; } return stringPtr->unicode; } -#if TCL_UTF_MAX > 3 && !defined(TCL_NO_DEPRECATED) -unsigned short * +Tcl_UniChar * Tcl_GetUnicodeFromObj( 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 - * NULL, no length is stored. */ -{ - String *stringPtr; - - SetUTF16StringFromAny(NULL, objPtr); - stringPtr = GET_STRING(objPtr); - - if (lengthPtr != NULL) { - *lengthPtr = stringPtr->numChars; - } - return stringPtr->unicode; -} -#endif - -#if !defined(TCL_NO_DEPRECATED) -unsigned short * -TclGetUnicodeFromObj( - Tcl_Obj *objPtr, /* The object to find the unicode string - * for. */ size_t *lengthPtr) /* If non-NULL, the location where the string * rep's unichar length should be stored. If * NULL, no length is stored. */ { String *stringPtr; -#if TCL_UTF_MAX > 3 - SetUTF16StringFromAny(NULL, objPtr); -#else SetStringFromAny(NULL, objPtr); -#endif stringPtr = GET_STRING(objPtr); + if (stringPtr->hasUnicode == 0) { + FillUnicodeRep(objPtr); + stringPtr = GET_STRING(objPtr); + } + if (lengthPtr != NULL) { *lengthPtr = stringPtr->numChars; } return stringPtr->unicode; } -#endif /* *---------------------------------------------------------------------- @@ -1013,9 +731,9 @@ TclGetUnicodeFromObj( * * Create a Tcl Object that contains the chars between first and last of * the object indicated by "objPtr". If the object is not already a - * String object, convert it to one. If first is negative, the returned - * string start at the beginning of objPtr. If last is negative, the - * returned string ends at the end of objPtr. + * String object, convert it to one. If first is TCL_INDEX_NONE, the + * returned string start at the beginning of objPtr. If last is + * TCL_INDEX_NONE, the returned string ends at the end of objPtr. * * Results: * Returns a new Tcl Object of the String type. @@ -1026,66 +744,18 @@ TclGetUnicodeFromObj( *---------------------------------------------------------------------- */ -#if TCL_UTF_MAX > 3 && !defined(TCL_NO_DEPRECATED) -#undef Tcl_GetRange Tcl_Obj * Tcl_GetRange( Tcl_Obj *objPtr, /* The Tcl object to find the range of. */ - int first, /* First index of the range. */ - int last) /* Last index of the range. */ -{ - Tcl_Obj *newObjPtr; /* The Tcl object to find the range of. */ - int length; - - if (first < 0) { - first = 0; - } - - /* - * Optimize the case where we're really dealing with a bytearray object - * we don't need to convert to a string to perform the substring operation. - */ - - if (TclIsPureByteArray(objPtr)) { - unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &length); - - if (last < 0 || last >= length) { - last = length - 1; - } - if (last < first) { - TclNewObj(newObjPtr); - return newObjPtr; - } - return Tcl_NewByteArrayObj(bytes + first, last - first + 1); - } - - int numChars = Tcl_NumUtfChars(objPtr->bytes, objPtr->length); - - if (last < 0 || last >= numChars) { - last = numChars - 1; - } - if (last < first) { - TclNewObj(newObjPtr); - return newObjPtr; - } - const char *begin = Tcl_UtfAtIndex(objPtr->bytes, first); - const char *end = Tcl_UtfAtIndex(objPtr->bytes, last + 1); - return Tcl_NewStringObj(begin, end - begin); -} -#endif - -Tcl_Obj * -TclGetRange( - Tcl_Obj *objPtr, /* The Tcl object to find the range of. */ - int first, /* First index of the range. */ - int last) /* Last index of the range. */ + size_t first, /* First index of the range. */ + size_t last) /* Last index of the range. */ { Tcl_Obj *newObjPtr; /* The Tcl object to find the range of. */ - UniCharString *stringPtr; - int length; + String *stringPtr; + size_t length = 0; - if (first < 0) { - first = 0; + if (first == TCL_INDEX_NONE) { + first = TCL_INDEX_START; } /* @@ -1096,10 +766,10 @@ TclGetRange( if (TclIsPureByteArray(objPtr)) { unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &length); - if (last < 0 || last >= length) { + if (last >= length) { last = length - 1; } - if (last < first) { + if (last + 1 < first + 1) { TclNewObj(newObjPtr); return newObjPtr; } @@ -1111,21 +781,21 @@ TclGetRange( */ SetStringFromAny(NULL, objPtr); - stringPtr = GET_UNICHAR_STRING(objPtr); + stringPtr = GET_STRING(objPtr); if (stringPtr->hasUnicode == 0) { /* * If numChars is unknown, compute it. */ - if (stringPtr->numChars == -1) { + if (stringPtr->numChars == TCL_INDEX_NONE) { TclNumUtfCharsM(stringPtr->numChars, objPtr->bytes, objPtr->length); } if (stringPtr->numChars == objPtr->length) { - if (last < 0 || last >= stringPtr->numChars) { + if (last >= stringPtr->numChars) { last = stringPtr->numChars - 1; } - if (last < first) { + if (last + 1 < first + 1) { TclNewObj(newObjPtr); return newObjPtr; } @@ -1136,33 +806,78 @@ TclGetRange( */ SetStringFromAny(NULL, newObjPtr); - stringPtr = GET_UNICHAR_STRING(newObjPtr); + stringPtr = GET_STRING(newObjPtr); stringPtr->numChars = newObjPtr->length; return newObjPtr; } FillUnicodeRep(objPtr); - stringPtr = GET_UNICHAR_STRING(objPtr); + stringPtr = GET_STRING(objPtr); } - if (last < 0 || last >= stringPtr->numChars) { + if (last >= stringPtr->numChars) { last = stringPtr->numChars - 1; } - if (last < first) { + if (last + 1 < first + 1) { TclNewObj(newObjPtr); return newObjPtr; } #if TCL_UTF_MAX < 4 /* See: bug [11ae2be95dac9417] */ - if ((first > 0) && ((stringPtr->unicode[first] & 0xFC00) == 0xDC00) + if ((first + 1 > 1) && ((stringPtr->unicode[first] & 0xFC00) == 0xDC00) && ((stringPtr->unicode[first-1] & 0xFC00) == 0xD800)) { ++first; } - if ((last + 1 < stringPtr->numChars) + if ((last + 2 < stringPtr->numChars + 1) && ((stringPtr->unicode[last+1] & 0xFC00) == 0xDC00) && ((stringPtr->unicode[last] & 0xFC00) == 0xD800)) { ++last; } #endif - return TclNewUnicodeObj(stringPtr->unicode + first, last - first + 1); + return Tcl_NewUnicodeObj(stringPtr->unicode + first, last - first + 1); +} + +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_Obj *newObjPtr; /* The Tcl object to find the range of. */ + size_t length = 0; + + if (first == TCL_INDEX_NONE) { + first = TCL_INDEX_START; + } + + /* + * Optimize the case where we're really dealing with a bytearray object + * we don't need to convert to a string to perform the substring operation. + */ + + if (TclIsPureByteArray(objPtr)) { + unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &length); + + if (last >= length) { + last = length - 1; + } + if (last + 1 < first + 1) { + TclNewObj(newObjPtr); + return newObjPtr; + } + return Tcl_NewByteArrayObj(bytes + first, last - first + 1); + } + + size_t numChars = TclNumUtfChars(objPtr->bytes, objPtr->length); + + if (last >= numChars) { + last = numChars - 1; + } + if (last + 1 < first + 1) { + TclNewObj(newObjPtr); + return newObjPtr; + } + const char *begin = TclUtfAtIndex(objPtr->bytes, first); + const char *end = TclUtfAtIndex(objPtr->bytes, last + 1); + return Tcl_NewStringObj(begin, end - begin); } /* @@ -1178,7 +893,7 @@ TclGetRange( * * Side effects: * The object's string representation will be set to a copy of the - * "length" bytes starting at "bytes". If "length" is negative, use bytes + * "length" bytes starting at "bytes". If "length" is TCL_INDEX_NONE, use bytes * up to the first NUL byte; i.e., assume "bytes" points to a C-style * NUL-terminated string. The object's old string and internal * representations are freed and the object's type is set NULL. @@ -1191,8 +906,8 @@ 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. */ - int length) /* The number of bytes to copy from "bytes" - * when initializing the object. If negative, + size_t length) /* The number of bytes to copy from "bytes" + * when initializing the object. If -1, * use bytes up to the first NUL byte.*/ { if (Tcl_IsShared(objPtr)) { @@ -1211,7 +926,7 @@ Tcl_SetStringObj( */ TclInvalidateStringRep(objPtr); - if (length < 0) { + if (length == TCL_INDEX_NONE) { length = (bytes? strlen(bytes) : 0); } TclInitStringRep(objPtr, bytes, length); @@ -1244,21 +959,12 @@ void Tcl_SetObjLength( Tcl_Obj *objPtr, /* Pointer to object. This object must not * currently be shared. */ - int length) /* Number of bytes desired for string + size_t length) /* Number of bytes desired for string * representation of object, not including * terminating null byte. */ { - UniCharString *stringPtr; - - if (length < 0) { - /* - * Setting to a negative length is nonsense. This is probably the - * result of overflowing the signed integer range. - */ + String *stringPtr; - Tcl_Panic("Tcl_SetObjLength: negative length requested: " - "%d (integer overflow?)", length); - } if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetObjLength"); } @@ -1268,7 +974,7 @@ Tcl_SetObjLength( } SetStringFromAny(NULL, objPtr); - stringPtr = GET_UNICHAR_STRING(objPtr); + stringPtr = GET_STRING(objPtr); if (objPtr->bytes != NULL) { /* @@ -1279,9 +985,9 @@ Tcl_SetObjLength( * Need to enlarge the buffer. */ if (objPtr->bytes == &tclEmptyString) { - objPtr->bytes = (char *)ckalloc((unsigned int)length + 1U); + objPtr->bytes = (char *)Tcl_Alloc(length + 1); } else { - objPtr->bytes = (char *)ckrealloc(objPtr->bytes, (unsigned int)length + 1U); + objPtr->bytes = (char *)Tcl_Realloc(objPtr->bytes, length + 1); } stringPtr->allocated = length; } @@ -1293,17 +999,12 @@ Tcl_SetObjLength( * Invalidate the unicode data. */ - stringPtr->numChars = -1; + stringPtr->numChars = TCL_INDEX_NONE; stringPtr->hasUnicode = 0; } else { - /* - * Changing length of pure unicode string. - */ - - uniCharStringCheckLimits(length); if (length > stringPtr->maxChars) { - stringPtr = uniCharStringRealloc(stringPtr, length); - SET_UNICHAR_STRING(objPtr, stringPtr); + stringPtr = stringRealloc(stringPtr, length); + SET_STRING(objPtr, stringPtr); stringPtr->maxChars = length; } @@ -1349,20 +1050,12 @@ int Tcl_AttemptSetObjLength( Tcl_Obj *objPtr, /* Pointer to object. This object must not * currently be shared. */ - int length) /* Number of bytes desired for string + size_t length) /* Number of bytes desired for string * representation of object, not including * terminating null byte. */ { - UniCharString *stringPtr; - - if (length < 0) { - /* - * Setting to a negative length is nonsense. This is probably the - * result of overflowing the signed integer range. - */ + String *stringPtr; - return 0; - } if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_AttemptSetObjLength"); } @@ -1371,7 +1064,7 @@ Tcl_AttemptSetObjLength( } SetStringFromAny(NULL, objPtr); - stringPtr = GET_UNICHAR_STRING(objPtr); + stringPtr = GET_STRING(objPtr); if (objPtr->bytes != NULL) { /* @@ -1385,9 +1078,9 @@ Tcl_AttemptSetObjLength( char *newBytes; if (objPtr->bytes == &tclEmptyString) { - newBytes = (char *)attemptckalloc((unsigned int)length + 1U); + newBytes = (char *)Tcl_AttemptAlloc(length + 1); } else { - newBytes = (char *)attemptckrealloc(objPtr->bytes, (unsigned int)length + 1U); + newBytes = (char *)Tcl_AttemptRealloc(objPtr->bytes, length + 1); } if (newBytes == NULL) { return 0; @@ -1403,22 +1096,19 @@ Tcl_AttemptSetObjLength( * Invalidate the unicode data. */ - stringPtr->numChars = -1; + stringPtr->numChars = TCL_INDEX_NONE; stringPtr->hasUnicode = 0; } else { /* * Changing length of pure unicode string. */ - if (length > UNICHAR_STRING_MAXCHARS) { - return 0; - } if (length > stringPtr->maxChars) { - stringPtr = uniCharStringAttemptRealloc(stringPtr, length); + stringPtr = stringAttemptRealloc(stringPtr, length); if (stringPtr == NULL) { return 0; } - SET_UNICHAR_STRING(objPtr, stringPtr); + SET_STRING(objPtr, stringPtr); stringPtr->maxChars = length; } @@ -1454,68 +1144,32 @@ Tcl_AttemptSetObjLength( *--------------------------------------------------------------------------- */ -#if !defined(TCL_NO_DEPRECATED) void Tcl_SetUnicodeObj( Tcl_Obj *objPtr, /* The object to set the string of. */ - const unsigned short *unicode, /* The unicode string used to initialize the + const Tcl_UniChar *unicode, /* The unicode string used to initialize the * object. */ - int numChars) /* Number of characters in the unicode + size_t numChars) /* Number of characters in the unicode * string. */ { - String *stringPtr; - - if (numChars < 0) { - numChars = UTF16Length(unicode); - } - - /* - * Allocate enough space for the String structure + Unicode string. - */ - - stringCheckLimits(numChars); - stringPtr = stringAlloc(numChars); - SET_STRING(objPtr, stringPtr); - objPtr->typePtr = &tclStringType; - - stringPtr->maxChars = numChars; - memcpy(stringPtr->unicode, unicode, numChars * sizeof(unsigned char)); - stringPtr->unicode[numChars] = 0; - stringPtr->numChars = numChars; - stringPtr->hasUnicode = 1; - - TclInvalidateStringRep(objPtr); - stringPtr->allocated = numChars; -} - -static int -UTF16Length( - const unsigned short *ucs2Ptr) -{ - int numChars = 0; - - if (ucs2Ptr) { - while (numChars >= 0 && ucs2Ptr[numChars] != 0) { - numChars++; - } + if (Tcl_IsShared(objPtr)) { + Tcl_Panic("%s called with shared object", "Tcl_SetUnicodeObj"); } - stringCheckLimits(numChars); - return numChars; + TclFreeInternalRep(objPtr); + SetUnicodeObj(objPtr, unicode, numChars); } -#endif -static int +static size_t UnicodeLength( const Tcl_UniChar *unicode) { - int numChars = 0; + size_t numChars = 0; if (unicode) { - while (numChars >= 0 && unicode[numChars] != 0) { + while ((numChars != TCL_INDEX_NONE) && (unicode[numChars] != 0)) { numChars++; } } - uniCharStringCheckLimits(numChars); return numChars; } @@ -1524,12 +1178,12 @@ SetUnicodeObj( Tcl_Obj *objPtr, /* The object to set the string of. */ const Tcl_UniChar *unicode, /* The unicode string used to initialize the * object. */ - int numChars) /* Number of characters in the unicode + size_t numChars) /* Number of characters in the unicode * string. */ { - UniCharString *stringPtr; + String *stringPtr; - if (numChars < 0) { + if (numChars == TCL_INDEX_NONE) { numChars = UnicodeLength(unicode); } @@ -1537,10 +1191,9 @@ SetUnicodeObj( * Allocate enough space for the String structure + Unicode string. */ - uniCharStringCheckLimits(numChars); - stringPtr = uniCharStringAlloc(numChars); - SET_UNICHAR_STRING(objPtr, stringPtr); - objPtr->typePtr = &tclUniCharStringType; + stringPtr = stringAlloc(numChars); + SET_STRING(objPtr, stringPtr); + objPtr->typePtr = &tclStringType; stringPtr->maxChars = numChars; memcpy(stringPtr->unicode, unicode, numChars * sizeof(Tcl_UniChar)); @@ -1575,20 +1228,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. */ - int length, /* The number of bytes available to be - * appended from "bytes". If < 0, then all - * bytes up to a NUL byte are available. */ - int limit, /* The maximum number of bytes to append to + size_t 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 * the object. */ const char *ellipsis) /* Ellipsis marker string, appended to the * object to indicate not all available bytes * at "bytes" were appended. */ { - UniCharString *stringPtr; - int toCopy = 0; - int eLen = 0; + String *stringPtr; + size_t toCopy = 0; + size_t eLen = 0; - if (length < 0) { + if (length == TCL_INDEX_NONE) { length = (bytes ? strlen(bytes) : 0); } if (length == 0) { @@ -1623,15 +1276,15 @@ Tcl_AppendLimitedToObj( } SetStringFromAny(NULL, objPtr); - stringPtr = GET_UNICHAR_STRING(objPtr); + stringPtr = GET_STRING(objPtr); /* If appended string starts with a continuation byte or a lower surrogate, * force objPtr to unicode representation. See [7f1162a867] */ if (bytes && ISCONTINUATION(bytes)) { - TclGetUnicodeFromObj_(objPtr, NULL); - stringPtr = GET_UNICHAR_STRING(objPtr); + Tcl_GetUnicode(objPtr); + stringPtr = GET_STRING(objPtr); } - if (stringPtr->hasUnicode && stringPtr->numChars > 0) { + if (stringPtr->hasUnicode && (stringPtr->numChars+1) > 1) { AppendUtfToUnicodeRep(objPtr, bytes, toCopy); } else { AppendUtfToUtfRep(objPtr, bytes, toCopy); @@ -1641,8 +1294,8 @@ Tcl_AppendLimitedToObj( return; } - stringPtr = GET_UNICHAR_STRING(objPtr); - if (stringPtr->hasUnicode && stringPtr->numChars > 0) { + stringPtr = GET_STRING(objPtr); + if (stringPtr->hasUnicode && (stringPtr->numChars+1) > 1) { AppendUtfToUnicodeRep(objPtr, ellipsis, eLen); } else { AppendUtfToUtfRep(objPtr, ellipsis, eLen); @@ -1671,11 +1324,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. */ - int length) /* The number of bytes to append from "bytes". - * If < 0, then append all bytes up to NUL + size_t 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, INT_MAX, NULL); + Tcl_AppendLimitedToObj(objPtr, bytes, length, TCL_INDEX_NONE, NULL); } /* @@ -1696,13 +1349,13 @@ Tcl_AppendToObj( */ void -TclAppendUnicodeToObj( +Tcl_AppendUnicodeToObj( Tcl_Obj *objPtr, /* Points to the object to append to. */ const Tcl_UniChar *unicode, /* The unicode string to append to the * object. */ - int length) /* Number of chars in "unicode". */ + size_t length) /* Number of chars in "unicode". */ { - UniCharString *stringPtr; + String *stringPtr; if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_AppendUnicodeToObj"); @@ -1713,7 +1366,7 @@ TclAppendUnicodeToObj( } SetStringFromAny(NULL, objPtr); - stringPtr = GET_UNICHAR_STRING(objPtr); + stringPtr = GET_STRING(objPtr); /* * If objPtr has a valid Unicode rep, then append the "unicode" to the @@ -1728,34 +1381,6 @@ TclAppendUnicodeToObj( } } -#if TCL_UTF_MAX > 3 && !defined(TCL_NO_DEPRECATED) -void -Tcl_AppendUnicodeToObj( - Tcl_Obj *objPtr, /* Points to the object to append to. */ - const unsigned short *unicode, /* The unicode string to append to the - * object. */ - int length) /* Number of chars in "unicode". */ -{ - String *stringPtr; - - if (Tcl_IsShared(objPtr)) { - Tcl_Panic("%s called with shared object", "Tcl_AppendUnicodeToObj"); - } - - if (length == 0) { - return; - } - - SetUTF16StringFromAny(NULL, objPtr); - stringPtr = GET_STRING(objPtr); - stringPtr = stringAttemptRealloc(stringPtr, stringPtr->numChars + length); - memcpy(&stringPtr->unicode[stringPtr->numChars], unicode, length); - stringPtr->maxChars = stringPtr->allocated = stringPtr->numChars += length; - stringPtr->unicode[stringPtr->numChars] = 0; - SET_STRING(objPtr, stringPtr); -} -#endif - /* *---------------------------------------------------------------------- * @@ -1781,8 +1406,9 @@ Tcl_AppendObjToObj( Tcl_Obj *objPtr, /* Points to the object to append to. */ Tcl_Obj *appendObjPtr) /* Object to append. */ { - UniCharString *stringPtr; - int length, numChars, appendNumChars = -1; + String *stringPtr; + size_t length = 0, numChars; + size_t appendNumChars = TCL_INDEX_NONE; const char *bytes; /* @@ -1822,7 +1448,7 @@ Tcl_AppendObjToObj( * First, get the lengths. */ - int lengthSrc; + size_t lengthSrc = 0; (void) Tcl_GetByteArrayFromObj(objPtr, &length); (void) Tcl_GetByteArrayFromObj(appendObjPtr, &lengthSrc); @@ -1845,7 +1471,7 @@ Tcl_AppendObjToObj( */ TclAppendBytesToByteArray(objPtr, - TclGetByteArrayFromObj(appendObjPtr, NULL), lengthSrc); + Tcl_GetByteArrayFromObj(appendObjPtr, (size_t *)NULL), lengthSrc); return; } @@ -1854,14 +1480,14 @@ Tcl_AppendObjToObj( */ SetStringFromAny(NULL, objPtr); - stringPtr = GET_UNICHAR_STRING(objPtr); + stringPtr = GET_STRING(objPtr); /* If appended string starts with a continuation byte or a lower surrogate, * force objPtr to unicode representation. See [7f1162a867] * This fixes append-3.4, append-3.7 and utf-1.18 testcases. */ if (ISCONTINUATION(TclGetString(appendObjPtr))) { - TclGetUnicodeFromObj_(objPtr, NULL); - stringPtr = GET_UNICHAR_STRING(objPtr); + Tcl_GetUnicode(objPtr); + stringPtr = GET_STRING(objPtr); } /* * If objPtr has a valid Unicode rep, then get a Unicode string from @@ -1873,13 +1499,13 @@ Tcl_AppendObjToObj( * If appendObjPtr is not of the "String" type, don't convert it. */ - if (TclHasInternalRep(appendObjPtr, &tclUniCharStringType)) { + if (TclHasInternalRep(appendObjPtr, &tclStringType)) { Tcl_UniChar *unicode = - TclGetUnicodeFromObj_(appendObjPtr, &numChars); + Tcl_GetUnicodeFromObj(appendObjPtr, &numChars); AppendUnicodeToUnicodeRep(objPtr, unicode, numChars); } else { - bytes = TclGetStringFromObj(appendObjPtr, &length); + bytes = Tcl_GetStringFromObj(appendObjPtr, &length); AppendUtfToUnicodeRep(objPtr, bytes, length); } return; @@ -1891,18 +1517,18 @@ Tcl_AppendObjToObj( * characters in the final (appended-to) object. */ - bytes = TclGetStringFromObj(appendObjPtr, &length); + bytes = Tcl_GetStringFromObj(appendObjPtr, &length); numChars = stringPtr->numChars; - if ((numChars >= 0) && TclHasInternalRep(appendObjPtr, &tclUniCharStringType)) { - UniCharString *appendStringPtr = GET_UNICHAR_STRING(appendObjPtr); + if ((numChars != TCL_INDEX_NONE) && TclHasInternalRep(appendObjPtr, &tclStringType)) { + String *appendStringPtr = GET_STRING(appendObjPtr); appendNumChars = appendStringPtr->numChars; } AppendUtfToUtfRep(objPtr, bytes, length); - if (numChars >= 0 && appendNumChars >= 0) { + if ((numChars != TCL_INDEX_NONE) && (appendNumChars != TCL_INDEX_NONE)) { stringPtr->numChars = numChars + appendNumChars; } } @@ -1928,12 +1554,12 @@ static void AppendUnicodeToUnicodeRep( Tcl_Obj *objPtr, /* Points to the object to append to. */ const Tcl_UniChar *unicode, /* String to append. */ - int appendNumChars) /* Number of chars of "unicode" to append. */ + size_t appendNumChars) /* Number of chars of "unicode" to append. */ { - UniCharString *stringPtr; - int numChars; + String *stringPtr; + size_t numChars; - if (appendNumChars < 0) { + if (appendNumChars == TCL_INDEX_NONE) { appendNumChars = UnicodeLength(unicode); } if (appendNumChars == 0) { @@ -1941,7 +1567,7 @@ AppendUnicodeToUnicodeRep( } SetStringFromAny(NULL, objPtr); - stringPtr = GET_UNICHAR_STRING(objPtr); + stringPtr = GET_STRING(objPtr); /* * If not enough space has been allocated for the unicode rep, reallocate @@ -1952,10 +1578,9 @@ AppendUnicodeToUnicodeRep( */ numChars = stringPtr->numChars + appendNumChars; - uniCharStringCheckLimits(numChars); if (numChars > stringPtr->maxChars) { - int offset = -1; + size_t index = TCL_INDEX_NONE; /* * Protect against case where unicode points into the existing @@ -1965,18 +1590,18 @@ AppendUnicodeToUnicodeRep( if (unicode && unicode >= stringPtr->unicode && unicode <= stringPtr->unicode + stringPtr->maxChars) { - offset = unicode - stringPtr->unicode; + index = unicode - stringPtr->unicode; } GrowUnicodeBuffer(objPtr, numChars); - stringPtr = GET_UNICHAR_STRING(objPtr); + stringPtr = GET_STRING(objPtr); /* * Relocate unicode if needed; see above. */ - if (offset >= 0) { - unicode = stringPtr->unicode + offset; + if (index != TCL_INDEX_NONE) { + unicode = stringPtr->unicode + index; } } @@ -2017,13 +1642,13 @@ static void AppendUnicodeToUtfRep( Tcl_Obj *objPtr, /* Points to the object to append to. */ const Tcl_UniChar *unicode, /* String to convert to UTF. */ - int numChars) /* Number of chars of "unicode" to convert. */ + size_t numChars) /* Number of chars of "unicode" to convert. */ { - UniCharString *stringPtr = GET_UNICHAR_STRING(objPtr); + String *stringPtr = GET_STRING(objPtr); numChars = ExtendStringRepWithUnicode(objPtr, unicode, numChars); - if (stringPtr->numChars != -1) { + if (stringPtr->numChars != TCL_INDEX_NONE) { stringPtr->numChars += numChars; } } @@ -2050,9 +1675,9 @@ static void AppendUtfToUnicodeRep( Tcl_Obj *objPtr, /* Points to the object to append to. */ const char *bytes, /* String to convert to Unicode. */ - int numBytes) /* Number of bytes of "bytes" to convert. */ + size_t numBytes) /* Number of bytes of "bytes" to convert. */ { - UniCharString *stringPtr; + String *stringPtr; if (numBytes == 0) { return; @@ -2060,7 +1685,7 @@ AppendUtfToUnicodeRep( ExtendUnicodeRepWithString(objPtr, bytes, numBytes, -1); TclInvalidateStringRep(objPtr); - stringPtr = GET_UNICHAR_STRING(objPtr); + stringPtr = GET_STRING(objPtr); stringPtr->allocated = 0; } @@ -2086,10 +1711,10 @@ static void AppendUtfToUtfRep( Tcl_Obj *objPtr, /* Points to the object to append to. */ const char *bytes, /* String to append. */ - int numBytes) /* Number of bytes of "bytes" to append. */ + size_t numBytes) /* Number of bytes of "bytes" to append. */ { - UniCharString *stringPtr; - int newLength, oldLength; + String *stringPtr; + size_t newLength, oldLength; if (numBytes == 0) { return; @@ -2104,14 +1729,11 @@ AppendUtfToUtfRep( objPtr->length = 0; } oldLength = objPtr->length; - if (numBytes > INT_MAX - oldLength) { - Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); - } newLength = numBytes + oldLength; - stringPtr = GET_UNICHAR_STRING(objPtr); + stringPtr = GET_STRING(objPtr); if (newLength > stringPtr->allocated) { - int offset = -1; + size_t offset = TCL_INDEX_NONE; /* * Protect against case where unicode points into the existing @@ -2135,7 +1757,7 @@ AppendUtfToUtfRep( * Relocate bytes if needed; see above. */ - if (offset >= 0) { + if (offset != TCL_INDEX_NONE) { bytes = objPtr->bytes + offset; } } @@ -2144,7 +1766,7 @@ AppendUtfToUtfRep( * Invalidate the unicode data. */ - stringPtr->numChars = -1; + stringPtr->numChars = TCL_INDEX_NONE; stringPtr->hasUnicode = 0; if (bytes) { @@ -2157,7 +1779,7 @@ AppendUtfToUtfRep( /* *---------------------------------------------------------------------- * - * Tcl_AppendStringsToObjVA -- + * Tcl_AppendStringsToObj -- * * This function appends one or more null-terminated strings to an * object. @@ -2173,10 +1795,13 @@ AppendUtfToUtfRep( */ void -Tcl_AppendStringsToObjVA( - Tcl_Obj *objPtr, /* Points to the object to append to. */ - va_list argList) /* Variable argument list. */ +Tcl_AppendStringsToObj( + Tcl_Obj *objPtr, + ...) { + va_list argList; + + va_start(argList, objPtr); if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_AppendStringsToObj"); } @@ -2189,35 +1814,6 @@ Tcl_AppendStringsToObjVA( } Tcl_AppendToObj(objPtr, bytes, -1); } -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_AppendStringsToObj -- - * - * This function appends one or more null-terminated strings to an - * object. - * - * Results: - * None. - * - * Side effects: - * The contents of all the string arguments are appended to the string - * representation of objPtr. - * - *---------------------------------------------------------------------- - */ - -void -Tcl_AppendStringsToObj( - Tcl_Obj *objPtr, - ...) -{ - va_list argList; - - va_start(argList, objPtr); - Tcl_AppendStringsToObjVA(objPtr, argList); va_end(argList); } @@ -2246,12 +1842,12 @@ Tcl_AppendFormatToObj( Tcl_Interp *interp, Tcl_Obj *appendObj, const char *format, - int objc, + size_t objc, Tcl_Obj *const objv[]) { const char *span = format, *msg, *errCode; - int numBytes = 0, objIndex = 0, gotXpg = 0, gotSequential = 0; - int originalLength, limit; + int gotXpg = 0, gotSequential = 0; + size_t objIndex = 0, originalLength, limit, numBytes = 0; Tcl_UniChar ch = 0; static const char *mixedXPG = "cannot mix \"%\" and \"%n$\" conversion specifiers"; @@ -2264,8 +1860,8 @@ Tcl_AppendFormatToObj( if (Tcl_IsShared(appendObj)) { Tcl_Panic("%s called with shared object", "Tcl_AppendFormatToObj"); } - TclGetStringFromObj(appendObj, &originalLength); - limit = INT_MAX - originalLength; + (void)Tcl_GetStringFromObj(appendObj, &originalLength); + limit = (size_t)INT_MAX - originalLength; /* * Format string is NUL-terminated. @@ -2278,7 +1874,8 @@ Tcl_AppendFormatToObj( #ifndef TCL_WIDE_INT_IS_LONG int useWide = 0; #endif - int newXpg, numChars, allocSegment = 0, segmentLimit, segmentNumBytes; + int newXpg, numChars, allocSegment = 0, segmentLimit; + size_t segmentNumBytes; Tcl_Obj *segment; int step = TclUtfToUniChar(format, &ch); @@ -2342,7 +1939,7 @@ Tcl_AppendFormatToObj( } gotSequential = 1; } - if ((objIndex < 0) || (objIndex >= objc)) { + if (objIndex >= objc) { msg = badIndex[gotXpg]; errCode = gotXpg ? "INDEXRANGE" : "FIELDVARMISMATCH"; goto errorMsg; @@ -2410,7 +2007,7 @@ Tcl_AppendFormatToObj( format += step; step = TclUtfToUniChar(format, &ch); } - if (width > limit) { + if (width > (int) limit) { msg = overflow; errCode = "OVERFLOW"; goto errorMsg; @@ -2513,12 +2110,12 @@ Tcl_AppendFormatToObj( goto errorMsg; case 's': if (gotPrecision) { - numChars = TclGetCharLength(segment); + numChars = Tcl_GetCharLength(segment); if (precision < numChars) { if (precision < 1) { TclNewObj(segment); } else { - segment = TclGetRange(segment, 0, precision - 1); + segment = Tcl_GetRange(segment, 0, precision - 1); } numChars = precision; Tcl_IncrRefCount(segment); @@ -2534,10 +2131,12 @@ Tcl_AppendFormatToObj( goto error; } length = Tcl_UniCharToUtf(code, buf); +#if TCL_UTF_MAX < 4 if ((code >= 0xD800) && (length < 3)) { /* Special case for handling high surrogates. */ length += Tcl_UniCharToUtf(-1, buf + length); } +#endif segment = Tcl_NewStringObj(buf, length); Tcl_IncrRefCount(segment); allocSegment = 1; @@ -2640,20 +2239,12 @@ Tcl_AppendFormatToObj( Tcl_AppendToObj(segment, "0b", 2); segmentLimit -= 2; break; -#if TCL_MAJOR_VERSION < 9 - case 'd': - if (gotZero) { - Tcl_AppendToObj(segment, "0d", 2); - segmentLimit -= 2; - } - break; -#endif } } switch (ch) { case 'd': { - int length; + size_t length; Tcl_Obj *pure; const char *bytes; @@ -2669,7 +2260,7 @@ Tcl_AppendFormatToObj( TclNewIntObj(pure, l); } Tcl_IncrRefCount(pure); - bytes = TclGetStringFromObj(pure, &length); + bytes = Tcl_GetStringFromObj(pure, &length); /* * Already did the sign above. @@ -2688,21 +2279,21 @@ Tcl_AppendFormatToObj( */ if (gotPrecision) { - if (length < precision) { + if (length < (size_t)precision) { segmentLimit -= precision - length; } - while (length < precision) { + while (length < (size_t)precision) { Tcl_AppendToObj(segment, "0", 1); length++; } gotZero = 0; } if (gotZero) { - length += TclGetCharLength(segment); - if (length < width) { + length += Tcl_GetCharLength(segment); + if (length < (size_t)width) { segmentLimit -= width - length; } - while (length < width) { + while (length < (size_t)width) { Tcl_AppendToObj(segment, "0", 1); length++; } @@ -2723,9 +2314,10 @@ Tcl_AppendFormatToObj( case 'x': case 'X': case 'b': { - Tcl_WideUInt bits = (Tcl_WideUInt) 0; - Tcl_WideInt numDigits = (Tcl_WideInt) 0; - int length, numBits = 4, base = 16, index = 0, shift = 0; + Tcl_WideUInt bits = 0; + Tcl_WideInt numDigits = 0; + int numBits = 4, base = 16, index = 0, shift = 0; + size_t length; Tcl_Obj *pure; char *bytes; @@ -2789,9 +2381,9 @@ Tcl_AppendFormatToObj( numDigits = 1; } TclNewObj(pure); - Tcl_SetObjLength(pure, (int) numDigits); + Tcl_SetObjLength(pure, numDigits); bytes = TclGetString(pure); - toAppend = length = (int) numDigits; + toAppend = length = numDigits; while (numDigits--) { int digitOffset; @@ -2803,7 +2395,7 @@ Tcl_AppendFormatToObj( } shift -= numBits; } - digitOffset = (int) (bits % base); + digitOffset = bits % base; if (digitOffset > 9) { if (ch == 'X') { bytes[numDigits] = 'A' + digitOffset - 10; @@ -2819,21 +2411,21 @@ Tcl_AppendFormatToObj( mp_clear(&big); } if (gotPrecision) { - if (length < precision) { + if (length < (size_t)precision) { segmentLimit -= precision - length; } - while (length < precision) { + while (length < (size_t)precision) { Tcl_AppendToObj(segment, "0", 1); length++; } gotZero = 0; } if (gotZero) { - length += TclGetCharLength(segment); - if (length < width) { + length += Tcl_GetCharLength(segment); + if (length < (size_t)width) { segmentLimit -= width - length; } - while (length < width) { + while (length < (size_t)width) { Tcl_AppendToObj(segment, "0", 1); length++; } @@ -2940,7 +2532,7 @@ Tcl_AppendFormatToObj( } if (width>0 && numChars<0) { - numChars = TclGetCharLength(segment); + numChars = Tcl_GetCharLength(segment); } if (!gotMinus && width>0) { if (numChars < width) { @@ -2952,7 +2544,7 @@ Tcl_AppendFormatToObj( } } - TclGetStringFromObj(segment, &segmentNumBytes); + (void)Tcl_GetStringFromObj(segment, &segmentNumBytes); if (segmentNumBytes > limit) { if (allocSegment) { Tcl_DecrRefCount(segment); @@ -3019,7 +2611,7 @@ Tcl_Obj * Tcl_Format( Tcl_Interp *interp, const char *format, - int objc, + size_t objc, Tcl_Obj *const objv[]) { int result; @@ -3052,7 +2644,8 @@ AppendPrintfToObjVA( const char *format, va_list argList) { - int code, objc; + int code; + size_t objc; Tcl_Obj **objv, *list; const char *p; @@ -3097,7 +2690,7 @@ AppendPrintfToObjVA( */ q = Tcl_UtfPrev(end, bytes); - if (!Tcl_UtfCharComplete(q, (int)(end - q))) { + if (!Tcl_UtfCharComplete(q, (end - q))) { end = q; } @@ -3108,7 +2701,7 @@ AppendPrintfToObjVA( } Tcl_ListObjAppendElement(NULL, list, - Tcl_NewStringObj(bytes , (int)(end - bytes))); + Tcl_NewStringObj(bytes , (end - bytes))); break; } @@ -3158,7 +2751,7 @@ AppendPrintfToObjVA( seekingConversion = 0; break; case '*': - lastNum = (int) va_arg(argList, int); + lastNum = va_arg(argList, int); Tcl_ListObjAppendElement(NULL, list, Tcl_NewWideIntObj(lastNum)); p++; break; @@ -3166,7 +2759,7 @@ AppendPrintfToObjVA( case '5': case '6': case '7': case '8': case '9': { char *end; - lastNum = (int) strtoul(p, &end, 10); + lastNum = strtoul(p, &end, 10); p = end; break; } @@ -3218,7 +2811,7 @@ AppendPrintfToObjVA( if (code != TCL_OK) { Tcl_AppendPrintfToObj(objPtr, "Unable to format \"%s\" with supplied arguments: %s", - format, Tcl_GetString(list)); + format, TclGetString(list)); } Tcl_DecrRefCount(list); } @@ -3299,15 +2892,15 @@ Tcl_ObjPrintf( char * TclGetStringStorage( Tcl_Obj *objPtr, - unsigned int *sizePtr) + size_t *sizePtr) { - UniCharString *stringPtr; + String *stringPtr; - if (!TclHasInternalRep(objPtr, &tclUniCharStringType) || objPtr->bytes == NULL) { - return TclGetStringFromObj(objPtr, (int *)sizePtr); + if (!TclHasInternalRep(objPtr, &tclStringType) || objPtr->bytes == NULL) { + return Tcl_GetStringFromObj(objPtr, sizePtr); } - stringPtr = GET_UNICHAR_STRING(objPtr); + stringPtr = GET_STRING(objPtr); *sizePtr = stringPtr->allocated; return objPtr->bytes; } @@ -3333,13 +2926,14 @@ Tcl_Obj * TclStringRepeat( Tcl_Interp *interp, Tcl_Obj *objPtr, - int count, + size_t count, int flags) { Tcl_Obj *objResultPtr; int inPlace = flags & TCL_STRING_IN_PLACE; - int length = 0, unichar = 0, done = 1; + size_t length = 0, unichar = 0, done = 1; int binary = TclIsPureByteArray(objPtr); + size_t maxCount; /* assert (count >= 2) */ @@ -3351,8 +2945,8 @@ TclStringRepeat( */ if (!binary) { - if (TclHasInternalRep(objPtr, &tclUniCharStringType)) { - UniCharString *stringPtr = GET_UNICHAR_STRING(objPtr); + if (TclHasInternalRep(objPtr, &tclStringType)) { + String *stringPtr = GET_STRING(objPtr); if (stringPtr->hasUnicode) { unichar = 1; } @@ -3361,13 +2955,18 @@ TclStringRepeat( if (binary) { /* Result will be pure byte array. Pre-size it */ - Tcl_GetByteArrayFromObj(objPtr, &length); - } else if (unichar) { + (void)Tcl_GetByteArrayFromObj(objPtr, &length); + maxCount = TCL_SIZE_SMAX; + } + else if (unichar) { /* Result will be pure Tcl_UniChar array. Pre-size it. */ - TclGetUnicodeFromObj_(objPtr, &length); - } else { + (void)Tcl_GetUnicodeFromObj(objPtr, &length); + maxCount = TCL_SIZE_SMAX/sizeof(Tcl_UniChar); + } + else { /* Result will be concat of string reps. Pre-size it. */ - Tcl_GetStringFromObj(objPtr, &length); + (void)Tcl_GetStringFromObj(objPtr, &length); + maxCount = TCL_SIZE_SMAX; } if (length == 0) { @@ -3375,10 +2974,14 @@ TclStringRepeat( return objPtr; } - if (count > INT_MAX/length) { + /* maxCount includes space for null */ + if (count > (maxCount-1)) { if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "max size for a Tcl value (%d bytes) exceeded", INT_MAX)); + Tcl_SetObjResult( + interp, + Tcl_ObjPrintf("max size for a Tcl value (%" TCL_Z_MODIFIER + "u bytes) exceeded", + TCL_SIZE_SMAX)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); } return NULL; @@ -3389,6 +2992,7 @@ TclStringRepeat( objResultPtr = (!inPlace || Tcl_IsShared(objPtr)) ? Tcl_DuplicateObj(objPtr) : objPtr; + /* Allocate count*length space */ Tcl_SetByteArrayLength(objResultPtr, count*length); /* PANIC? */ Tcl_SetByteArrayLength(objResultPtr, length); while (count - done > done) { @@ -3396,7 +3000,7 @@ TclStringRepeat( done *= 2; } TclAppendBytesToByteArray(objResultPtr, - TclGetByteArrayFromObj(objResultPtr, NULL), + Tcl_GetByteArrayFromObj(objResultPtr, (size_t *)NULL), (count - done) * length); } else if (unichar) { /* @@ -3404,7 +3008,7 @@ TclStringRepeat( */ if (!inPlace || Tcl_IsShared(objPtr)) { - objResultPtr = TclNewUnicodeObj(TclGetUnicodeFromObj_(objPtr, NULL), length); + objResultPtr = Tcl_NewUnicodeObj(Tcl_GetUnicode(objPtr), length); } else { TclInvalidateStringRep(objPtr); objResultPtr = objPtr; @@ -3415,7 +3019,7 @@ TclStringRepeat( Tcl_SetObjResult(interp, Tcl_ObjPrintf( "string size overflow: unable to alloc %" TCL_Z_MODIFIER "u bytes", - UNICHAR_STRING_SIZE(count*length))); + STRING_SIZE(count*length))); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); } return NULL; @@ -3425,7 +3029,7 @@ TclStringRepeat( Tcl_AppendObjToObj(objResultPtr, objResultPtr); done *= 2; } - TclAppendUnicodeToObj(objResultPtr, TclGetUnicodeFromObj_(objResultPtr, NULL), + Tcl_AppendUnicodeToObj(objResultPtr, Tcl_GetUnicode(objResultPtr), (count - done) * length); } else { /* @@ -3433,7 +3037,7 @@ TclStringRepeat( */ if (!inPlace || Tcl_IsShared(objPtr)) { - objResultPtr = Tcl_NewStringObj(Tcl_GetString(objPtr), length); + objResultPtr = Tcl_NewStringObj(TclGetString(objPtr), length); } else { TclFreeInternalRep(objPtr); objResultPtr = objPtr; @@ -3441,7 +3045,7 @@ TclStringRepeat( if (0 == Tcl_AttemptSetObjLength(objResultPtr, count*length)) { if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "string size overflow: unable to alloc %u bytes", + "string size overflow: unable to alloc %" TCL_Z_MODIFIER "u bytes", count*length)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); } @@ -3452,10 +3056,11 @@ TclStringRepeat( Tcl_AppendObjToObj(objResultPtr, objResultPtr); done *= 2; } - Tcl_AppendToObj(objResultPtr, Tcl_GetString(objResultPtr), + Tcl_AppendToObj(objResultPtr, TclGetString(objResultPtr), (count - done) * length); } return objResultPtr; + } /* @@ -3483,7 +3088,8 @@ TclStringCat( int flags) { Tcl_Obj *objResultPtr, * const *ov; - int oc, length = 0, binary = 1; + int oc, binary = 1; + size_t 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 */ @@ -3522,7 +3128,7 @@ TclStringCat( binary = 0; if (ov > objv+1 && ISCONTINUATION(TclGetString(objPtr))) { forceUniChar = 1; - } else if ((objPtr->typePtr) && (objPtr->typePtr != &tclUniCharStringType)) { + } else if ((objPtr->typePtr) && (objPtr->typePtr != &tclStringType)) { /* Prevent shimmer of non-string types. */ allowUniChar = 0; } @@ -3530,7 +3136,7 @@ TclStringCat( } else { /* assert (objPtr->typePtr != NULL) -- stork! */ binary = 0; - if (TclHasInternalRep(objPtr, &tclUniCharStringType)) { + if (TclHasInternalRep(objPtr, &tclStringType)) { /* Have a pure Unicode value; ask to preserve it */ requestUniChar = 1; } else { @@ -3545,7 +3151,7 @@ TclStringCat( * Result will be pure byte array. Pre-size it */ - int numBytes; + size_t numBytes = 0; ov = objv; oc = objc; do { @@ -3558,13 +3164,14 @@ TclStringCat( */ if (TclIsPureByteArray(objPtr)) { - Tcl_GetByteArrayFromObj(objPtr, &numBytes); /* PANIC? */ + (void)Tcl_GetByteArrayFromObj(objPtr, &numBytes); /* PANIC? */ if (numBytes) { last = objc - oc; if (length == 0) { first = last; - } else if (numBytes > INT_MAX - length) { + } + if (length > (TCL_SIZE_SMAX-numBytes)) { goto overflow; } length += numBytes; @@ -3582,14 +3189,15 @@ TclStringCat( Tcl_Obj *objPtr = *ov++; if ((objPtr->bytes == NULL) || (objPtr->length)) { - int numChars; + size_t numChars; - TclGetUnicodeFromObj_(objPtr, &numChars); /* PANIC? */ + (void)Tcl_GetUnicodeFromObj(objPtr, &numChars); /* PANIC? */ if (numChars) { last = objc - oc; if (length == 0) { first = last; - } else if (numChars > INT_MAX - length) { + } + if (length > ((TCL_SIZE_SMAX/sizeof(Tcl_UniChar))-numChars)) { goto overflow; } length += numChars; @@ -3617,7 +3225,7 @@ TclStringCat( /* No string rep; Take the chance we can avoid making it */ pendingPtr = objPtr; } else { - Tcl_GetStringFromObj(objPtr, &length); /* PANIC? */ + (void)Tcl_GetStringFromObj(objPtr, &length); /* PANIC? */ } } while (--oc && (length == 0) && (pendingPtr == NULL)); @@ -3631,7 +3239,7 @@ TclStringCat( first = last = objc - oc - 1; if (oc && (length == 0)) { - int numBytes; + size_t numBytes; /* assert ( pendingPtr != NULL ) */ @@ -3643,20 +3251,20 @@ TclStringCat( do { Tcl_Obj *objPtr = *ov++; - Tcl_GetStringFromObj(objPtr, &numBytes); /* PANIC? */ + (void)Tcl_GetStringFromObj(objPtr, &numBytes); /* PANIC? */ } while (--oc && numBytes == 0 && pendingPtr->bytes == NULL); if (numBytes) { last = objc -oc -1; } if (oc || numBytes) { - Tcl_GetStringFromObj(pendingPtr, &length); + (void)Tcl_GetStringFromObj(pendingPtr, &length); } if (length == 0) { if (numBytes) { first = last; } - } else if (numBytes > INT_MAX - length) { + } else if (numBytes > (TCL_SIZE_SMAX - length)) { goto overflow; } length += numBytes; @@ -3664,15 +3272,16 @@ TclStringCat( } while (oc && (length == 0)); while (oc) { - int numBytes; + size_t numBytes; Tcl_Obj *objPtr = *ov++; /* assert ( length > 0 && pendingPtr == NULL ) */ - Tcl_GetStringFromObj(objPtr, &numBytes); /* PANIC? */ + TclGetString(objPtr); /* PANIC? */ + numBytes = objPtr->length; if (numBytes) { last = objc - oc; - if (numBytes > INT_MAX - length) { + if (numBytes > (TCL_SIZE_SMAX - length)) { goto overflow; } length += numBytes; @@ -3699,10 +3308,10 @@ TclStringCat( */ if (inPlace && !Tcl_IsShared(*objv)) { - int start; + size_t start = 0; objResultPtr = *objv++; objc--; - Tcl_GetByteArrayFromObj(objResultPtr, &start); + (void)Tcl_GetByteArrayFromObj(objResultPtr, &start); dst = Tcl_SetByteArrayLength(objResultPtr, length) + start; } else { objResultPtr = Tcl_NewByteArrayObj(NULL, length); @@ -3718,7 +3327,7 @@ TclStringCat( */ if (TclIsPureByteArray(objPtr)) { - int more; + size_t more = 0; unsigned char *src = Tcl_GetByteArrayFromObj(objPtr, &more); memcpy(dst, src, more); dst += more; @@ -3729,48 +3338,48 @@ TclStringCat( Tcl_UniChar *dst; if (inPlace && !Tcl_IsShared(*objv)) { - int start; + size_t start; objResultPtr = *objv++; objc--; /* Ugly interface! Force resize of the unicode array. */ - TclGetUnicodeFromObj_(objResultPtr, &start); + (void)Tcl_GetUnicodeFromObj(objResultPtr, &start); Tcl_InvalidateStringRep(objResultPtr); if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) { if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "concatenation failed: unable to alloc %" TCL_Z_MODIFIER "u bytes", - UNICHAR_STRING_SIZE(length))); + STRING_SIZE(length))); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); } return NULL; } - dst = TclGetUnicodeFromObj_(objResultPtr, NULL) + start; + dst = Tcl_GetUnicode(objResultPtr) + start; } else { Tcl_UniChar ch = 0; /* Ugly interface! No scheme to init array size. */ - objResultPtr = TclNewUnicodeObj(&ch, 0); /* PANIC? */ + objResultPtr = Tcl_NewUnicodeObj(&ch, 0); /* PANIC? */ if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) { Tcl_DecrRefCount(objResultPtr); if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "concatenation failed: unable to alloc %" TCL_Z_MODIFIER "u bytes", - UNICHAR_STRING_SIZE(length))); + STRING_SIZE(length))); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); } return NULL; } - dst = TclGetUnicodeFromObj_(objResultPtr, NULL); + dst = Tcl_GetUnicode(objResultPtr); } while (objc--) { Tcl_Obj *objPtr = *objv++; if ((objPtr->bytes == NULL) || (objPtr->length)) { - int more; - Tcl_UniChar *src = TclGetUnicodeFromObj_(objPtr, &more); + size_t more; + Tcl_UniChar *src = Tcl_GetUnicodeFromObj(objPtr, &more); memcpy(dst, src, more * sizeof(Tcl_UniChar)); dst += more; } @@ -3780,21 +3389,21 @@ TclStringCat( char *dst; if (inPlace && !Tcl_IsShared(*objv)) { - int start; + size_t start; objResultPtr = *objv++; objc--; - Tcl_GetStringFromObj(objResultPtr, &start); + (void)Tcl_GetStringFromObj(objResultPtr, &start); if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) { if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "concatenation failed: unable to alloc %u bytes", + "concatenation failed: unable to alloc %" TCL_Z_MODIFIER "u bytes", length)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); } return NULL; } - dst = Tcl_GetString(objResultPtr) + start; + dst = TclGetString(objResultPtr) + start; /* assert ( length > start ) */ TclFreeInternalRep(objResultPtr); @@ -3804,19 +3413,19 @@ TclStringCat( Tcl_DecrRefCount(objResultPtr); if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "concatenation failed: unable to alloc %u bytes", + "concatenation failed: unable to alloc %" TCL_Z_MODIFIER "u bytes", length)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); } return NULL; } - dst = Tcl_GetString(objResultPtr); + dst = TclGetString(objResultPtr); } while (objc--) { Tcl_Obj *objPtr = *objv++; if ((objPtr->bytes == NULL) || (objPtr->length)) { - int more; + size_t more; char *src = Tcl_GetStringFromObj(objPtr, &more); memcpy(dst, src, more); @@ -3831,7 +3440,7 @@ TclStringCat( overflow: if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "max size for a Tcl value (%d bytes) exceeded", INT_MAX)); + "max size for a Tcl value (%" TCL_Z_MODIFIER "u bytes) exceeded", TCL_SIZE_SMAX)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); } return NULL; @@ -3859,10 +3468,11 @@ TclStringCmp( Tcl_Obj *value2Ptr, int checkEq, /* comparison is only for equality */ int nocase, /* comparison is not case sensitive */ - int reqlength) /* requested length */ + size_t reqlength) /* requested length */ { char *s1, *s2; - int empty, length, match, s1len, s2len; + int empty, match; + size_t length, s1len = 0, s2len = 0; memCmpFn_t memCmpFn; if ((reqlength == 0) || (value1Ptr == value2Ptr)) { @@ -3883,8 +3493,8 @@ TclStringCmp( s1 = (char *) Tcl_GetByteArrayFromObj(value1Ptr, &s1len); s2 = (char *) Tcl_GetByteArrayFromObj(value2Ptr, &s2len); memCmpFn = memcmp; - } else if (TclHasInternalRep(value1Ptr, &tclUniCharStringType) - && TclHasInternalRep(value2Ptr, &tclUniCharStringType)) { + } else if (TclHasInternalRep(value1Ptr, &tclStringType) + && TclHasInternalRep(value2Ptr, &tclStringType)) { /* * Do a unicode-specific comparison if both of the args are of * String type. If the char length == byte length, we can do a @@ -3893,12 +3503,12 @@ TclStringCmp( */ if (nocase) { - s1 = (char *) TclGetUnicodeFromObj_(value1Ptr, &s1len); - s2 = (char *) TclGetUnicodeFromObj_(value2Ptr, &s2len); - memCmpFn = (memCmpFn_t)(void *)TclUniCharNcasecmp; + s1 = (char *) Tcl_GetUnicodeFromObj(value1Ptr, &s1len); + s2 = (char *) Tcl_GetUnicodeFromObj(value2Ptr, &s2len); + memCmpFn = (memCmpFn_t)TclUniCharNcasecmp; } else { - s1len = TclGetCharLength(value1Ptr); - s2len = TclGetCharLength(value2Ptr); + s1len = Tcl_GetCharLength(value1Ptr); + s2len = Tcl_GetCharLength(value2Ptr); if ((s1len == value1Ptr->length) && (value1Ptr->bytes != NULL) && (s2len == value2Ptr->length) @@ -3907,8 +3517,8 @@ TclStringCmp( s2 = value2Ptr->bytes; memCmpFn = memcmp; } else { - s1 = (char *) TclGetUnicodeFromObj_(value1Ptr, NULL); - s2 = (char *) TclGetUnicodeFromObj_(value2Ptr, NULL); + s1 = (char *) Tcl_GetUnicode(value1Ptr); + s2 = (char *) Tcl_GetUnicode(value2Ptr); if ( #if defined(WORDS_BIGENDIAN) && (TCL_UTF_MAX > 3) 1 @@ -3920,7 +3530,7 @@ TclStringCmp( s1len *= sizeof(Tcl_UniChar); s2len *= sizeof(Tcl_UniChar); } else { - memCmpFn = (memCmpFn_t)(void *)TclUniCharNcmp; + memCmpFn = (memCmpFn_t) TclUniCharNcmp; } } } @@ -3931,7 +3541,7 @@ TclStringCmp( case -1: s1 = 0; s1len = 0; - s2 = TclGetStringFromObj(value2Ptr, &s2len); + s2 = Tcl_GetStringFromObj(value2Ptr, &s2len); break; case 0: match = -1; @@ -3946,7 +3556,7 @@ TclStringCmp( case -1: s2 = 0; s2len = 0; - s1 = TclGetStringFromObj(value1Ptr, &s1len); + s1 = Tcl_GetStringFromObj(value1Ptr, &s1len); break; case 0: match = 1; @@ -3957,8 +3567,8 @@ TclStringCmp( goto matchdone; } } else { - s1 = TclGetStringFromObj(value1Ptr, &s1len); - s2 = TclGetStringFromObj(value2Ptr, &s2len); + s1 = Tcl_GetStringFromObj(value1Ptr, &s1len); + s2 = Tcl_GetStringFromObj(value2Ptr, &s2len); } if (!nocase && checkEq) { /* @@ -3977,27 +3587,27 @@ TclStringCmp( * length was requested. */ - if ((reqlength < 0) && !nocase) { - memCmpFn = (memCmpFn_t)(void *)TclpUtfNcmp2; + if ((reqlength == TCL_INDEX_NONE) && !nocase) { + memCmpFn = (memCmpFn_t) TclpUtfNcmp2; } else { s1len = Tcl_NumUtfChars(s1, s1len); s2len = Tcl_NumUtfChars(s2, s2len); - memCmpFn = (memCmpFn_t)(void *) + memCmpFn = (memCmpFn_t) (nocase ? Tcl_UtfNcasecmp : Tcl_UtfNcmp); } } } length = (s1len < s2len) ? s1len : s2len; - if (reqlength > 0 && reqlength < length) { - length = reqlength; - } else if (reqlength < 0) { + if (reqlength == TCL_INDEX_NONE) { /* * The requested length is negative, so we ignore it by setting it * to length + 1 so we correct the match var. */ reqlength = length + 1; + } else if (reqlength > 0 && reqlength < length) { + length = reqlength; } if (checkEq && (s1len != s2len)) { @@ -4041,14 +3651,14 @@ Tcl_Obj * TclStringFirst( Tcl_Obj *needle, Tcl_Obj *haystack, - int start) + size_t start) { - int lh, ln = TclGetCharLength(needle); - Tcl_Obj *result; - int value = -1; + size_t lh = 0, ln = Tcl_GetCharLength(needle); + size_t value = TCL_INDEX_NONE; Tcl_UniChar *checkStr, *endStr, *uh, *un; + Tcl_Obj *obj; - if (start < 0) { + if (start == TCL_INDEX_NONE) { start = 0; } if (ln == 0) { @@ -4106,8 +3716,8 @@ TclStringFirst( * do only the well-defined Tcl_UniChar array search. */ - un = TclGetUnicodeFromObj_(needle, &ln); - uh = TclGetUnicodeFromObj_(haystack, &lh); + un = Tcl_GetUnicodeFromObj(needle, &ln); + uh = Tcl_GetUnicodeFromObj(haystack, &lh); if ((lh < ln) || (start > lh - ln)) { /* Don't start the loop if there cannot be a valid answer */ goto firstEnd; @@ -4122,8 +3732,8 @@ TclStringFirst( } } firstEnd: - TclNewIndexObj(result, value); - return result; + TclNewIndexObj(obj, value); + return obj; } /* @@ -4148,12 +3758,12 @@ Tcl_Obj * TclStringLast( Tcl_Obj *needle, Tcl_Obj *haystack, - int last) + size_t last) { - int lh, ln = TclGetCharLength(needle); - Tcl_Obj *result; - int value = -1; + size_t lh = 0, ln = Tcl_GetCharLength(needle); + size_t value = TCL_INDEX_NONE; Tcl_UniChar *checkStr, *uh, *un; + Tcl_Obj *obj; if (ln == 0) { /* @@ -4169,7 +3779,7 @@ TclStringLast( unsigned char *check, *bh = Tcl_GetByteArrayFromObj(haystack, &lh); unsigned char *bn = Tcl_GetByteArrayFromObj(needle, &ln); - if (last >= lh) { + if (last + 1 >= lh + 1) { last = lh - 1; } if (last + 1 < ln) { @@ -4189,10 +3799,10 @@ TclStringLast( goto lastEnd; } - uh = TclGetUnicodeFromObj_(haystack, &lh); - un = TclGetUnicodeFromObj_(needle, &ln); + uh = Tcl_GetUnicodeFromObj(haystack, &lh); + un = Tcl_GetUnicodeFromObj(needle, &ln); - if (last >= lh) { + if (last + 1 >= lh + 1) { last = lh - 1; } if (last + 1 < ln) { @@ -4209,8 +3819,8 @@ TclStringLast( checkStr--; } lastEnd: - TclNewIndexObj(result, value); - return result; + TclNewIndexObj(obj, value); + return obj; } /* @@ -4235,7 +3845,7 @@ static void ReverseBytes( unsigned char *to, /* Copy bytes into here... */ unsigned char *from, /* ...from here... */ - int count) /* Until this many are copied, */ + size_t count) /* Until this many are copied, */ /* reversing as you go. */ { unsigned char *src = from + count; @@ -4260,7 +3870,7 @@ TclStringReverse( Tcl_Obj *objPtr, int flags) { - UniCharString *stringPtr; + String *stringPtr; Tcl_UniChar ch = 0; int inPlace = flags & TCL_STRING_IN_PLACE; #if TCL_UTF_MAX < 4 @@ -4268,22 +3878,22 @@ TclStringReverse( #endif if (TclIsPureByteArray(objPtr)) { - int numBytes; + size_t numBytes = 0; unsigned char *from = Tcl_GetByteArrayFromObj(objPtr, &numBytes); if (!inPlace || Tcl_IsShared(objPtr)) { objPtr = Tcl_NewByteArrayObj(NULL, numBytes); } - ReverseBytes(TclGetByteArrayFromObj(objPtr, NULL), from, numBytes); + ReverseBytes(Tcl_GetByteArrayFromObj(objPtr, (size_t *)NULL), from, numBytes); return objPtr; } SetStringFromAny(NULL, objPtr); - stringPtr = GET_UNICHAR_STRING(objPtr); + stringPtr = GET_STRING(objPtr); if (stringPtr->hasUnicode) { - Tcl_UniChar *from = TclGetUnicodeFromObj_(objPtr, NULL); - stringPtr = GET_UNICHAR_STRING(objPtr); + Tcl_UniChar *from = Tcl_GetUnicode(objPtr); + stringPtr = GET_STRING(objPtr); Tcl_UniChar *src = from + stringPtr->numChars; Tcl_UniChar *to; @@ -4293,10 +3903,10 @@ TclStringReverse( * Tcl_SetObjLength into growing the unicode rep buffer. */ - objPtr = TclNewUnicodeObj(&ch, 1); + objPtr = Tcl_NewUnicodeObj(&ch, 1); Tcl_SetObjLength(objPtr, stringPtr->numChars); - to = TclGetUnicodeFromObj_(objPtr, NULL); - stringPtr = GET_UNICHAR_STRING(objPtr); + to = Tcl_GetUnicode(objPtr); + stringPtr = GET_STRING(objPtr); while (--src >= from) { #if TCL_UTF_MAX < 4 ch = *src; @@ -4349,8 +3959,8 @@ TclStringReverse( } if (objPtr->bytes) { - int numChars = stringPtr->numChars; - int numBytes = objPtr->length; + size_t numChars = stringPtr->numChars; + size_t numBytes = objPtr->length; char *to, *from = objPtr->bytes; if (!inPlace || Tcl_IsShared(objPtr)) { @@ -4359,7 +3969,7 @@ TclStringReverse( } to = objPtr->bytes; - if (numChars < numBytes) { + if ((numChars == TCL_INDEX_NONE) || (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, @@ -4369,7 +3979,7 @@ TclStringReverse( * Pass 1. Reverse the bytes of each multi-byte character. */ - int bytesLeft = numBytes; + size_t bytesLeft = numBytes; int chw; while (bytesLeft) { @@ -4379,7 +3989,7 @@ TclStringReverse( * skip calling Tcl_UtfCharComplete() here. */ - int bytesInChar = TclUtfToUCS4(from, &chw); + size_t bytesInChar = TclUtfToUCS4(from, &chw); ReverseBytes((unsigned char *)to, (unsigned char *)from, bytesInChar); @@ -4427,18 +4037,14 @@ Tcl_Obj * TclStringReplace( Tcl_Interp *interp, /* For error reporting, may be NULL */ Tcl_Obj *objPtr, /* String to act upon */ - int first, /* First index to replace */ - int count, /* How many chars to replace */ + size_t first, /* First index to replace */ + size_t count, /* How many chars to replace */ Tcl_Obj *insertPtr, /* Replacement string, may be NULL */ int flags) /* TCL_STRING_IN_PLACE => attempt in-place */ { int inPlace = flags & TCL_STRING_IN_PLACE; Tcl_Obj *result; - /* Caller is expected to pass sensible arguments */ - assert ( count >= 0 ) ; - assert ( first >= 0 ) ; - /* Replace nothing with nothing */ if ((insertPtr == NULL) && (count == 0)) { if (inPlace) { @@ -4456,7 +4062,7 @@ TclStringReplace( */ if (TclIsPureByteArray(objPtr)) { - int numBytes; + size_t numBytes = 0; unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &numBytes); if (insertPtr == NULL) { @@ -4479,7 +4085,7 @@ TclStringReplace( } if (TclIsPureByteArray(insertPtr)) { - int newBytes; + size_t newBytes = 0; unsigned char *iBytes = Tcl_GetByteArrayFromObj(insertPtr, &newBytes); @@ -4494,11 +4100,11 @@ TclStringReplace( return objPtr; } - if (newBytes > INT_MAX - (numBytes - count)) { + if (newBytes > (TCL_SIZE_SMAX - (numBytes - count))) { if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "max size for a Tcl value (%d bytes) exceeded", - INT_MAX)); + "max size for a Tcl value (%" TCL_Z_MODIFIER "u bytes) exceeded", + TCL_SIZE_SMAX)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); } return NULL; @@ -4524,17 +4130,17 @@ TclStringReplace( /* The traditional implementation... */ { - int numChars; - Tcl_UniChar *ustring = TclGetUnicodeFromObj_(objPtr, &numChars); + size_t numChars; + Tcl_UniChar *ustring = Tcl_GetUnicodeFromObj(objPtr, &numChars); /* TODO: Is there an in-place option worth pursuing here? */ - result = TclNewUnicodeObj(ustring, first); + result = Tcl_NewUnicodeObj(ustring, first); if (insertPtr) { Tcl_AppendObjToObj(result, insertPtr); } - if (first + count < numChars) { - TclAppendUnicodeToObj(result, ustring + first + count, + if ((first + count) < numChars) { + Tcl_AppendUnicodeToObj(result, ustring + first + count, numChars - first - count); } @@ -4564,7 +4170,7 @@ FillUnicodeRep( Tcl_Obj *objPtr) /* The object in which to fill the unicode * rep. */ { - UniCharString *stringPtr = GET_UNICHAR_STRING(objPtr); + String *stringPtr = GET_STRING(objPtr); ExtendUnicodeRepWithString(objPtr, objPtr->bytes, objPtr->length, stringPtr->numChars); @@ -4574,25 +4180,24 @@ static void ExtendUnicodeRepWithString( Tcl_Obj *objPtr, const char *bytes, - int numBytes, - int numAppendChars) + size_t numBytes, + size_t numAppendChars) { - UniCharString *stringPtr = GET_UNICHAR_STRING(objPtr); - int needed, numOrigChars = 0; + String *stringPtr = GET_STRING(objPtr); + size_t needed, numOrigChars = 0; Tcl_UniChar *dst, unichar = 0; if (stringPtr->hasUnicode) { numOrigChars = stringPtr->numChars; } - if (numAppendChars == -1) { + if (numAppendChars == TCL_INDEX_NONE) { TclNumUtfCharsM(numAppendChars, bytes, numBytes); } needed = numOrigChars + numAppendChars; - uniCharStringCheckLimits(needed); if (needed > stringPtr->maxChars) { GrowUnicodeBuffer(objPtr, needed); - stringPtr = GET_UNICHAR_STRING(objPtr); + stringPtr = GET_STRING(objPtr); } stringPtr->hasUnicode = 1; @@ -4604,14 +4209,6 @@ ExtendUnicodeRepWithString( dst = stringPtr->unicode + numOrigChars; if (numAppendChars-- > 0) { bytes += TclUtfToUniChar(bytes, &unichar); -#if TCL_UTF_MAX > 3 - /* join upper/lower surrogate */ - if (bytes && (stringPtr->unicode[numOrigChars - 1] | 0x3FF) == 0xDBFF && (unichar | 0x3FF) == 0xDFFF) { - stringPtr->numChars--; - unichar = ((stringPtr->unicode[numOrigChars - 1] & 0x3FF) << 10) + (unichar & 0x3FF) + 0x10000; - dst--; - } -#endif *dst++ = unichar; while (numAppendChars-- > 0) { bytes += TclUtfToUniChar(bytes, &unichar); @@ -4646,10 +4243,10 @@ DupStringInternalRep( Tcl_Obj *copyPtr) /* Object with internal rep to set. Must not * currently have an internal rep.*/ { - UniCharString *srcStringPtr = GET_UNICHAR_STRING(srcPtr); - UniCharString *copyStringPtr = NULL; + String *srcStringPtr = GET_STRING(srcPtr); + String *copyStringPtr = NULL; - if (srcStringPtr->numChars == -1) { + if (srcStringPtr->numChars == TCL_INDEX_NONE) { /* * The String struct in the source value holds zero useful data. Don't * bother copying it. Don't even bother allocating space in which to @@ -4667,17 +4264,17 @@ DupStringInternalRep( } else { copyMaxChars = srcStringPtr->maxChars; } - copyStringPtr = uniCharStringAttemptAlloc(copyMaxChars); + copyStringPtr = stringAttemptAlloc(copyMaxChars); if (copyStringPtr == NULL) { copyMaxChars = srcStringPtr->numChars; - copyStringPtr = uniCharStringAlloc(copyMaxChars); + copyStringPtr = stringAlloc(copyMaxChars); } copyStringPtr->maxChars = copyMaxChars; memcpy(copyStringPtr->unicode, srcStringPtr->unicode, srcStringPtr->numChars * sizeof(Tcl_UniChar)); copyStringPtr->unicode[srcStringPtr->numChars] = 0; } else { - copyStringPtr = uniCharStringAlloc(0); + copyStringPtr = stringAlloc(0); copyStringPtr->maxChars = 0; copyStringPtr->unicode[0] = 0; } @@ -4692,8 +4289,8 @@ DupStringInternalRep( copyStringPtr->allocated = copyPtr->bytes ? copyPtr->length : 0; - SET_UNICHAR_STRING(copyPtr, copyStringPtr); - copyPtr->typePtr = &tclUniCharStringType; + SET_STRING(copyPtr, copyStringPtr); + copyPtr->typePtr = &tclStringType; } /* @@ -4718,8 +4315,8 @@ SetStringFromAny( TCL_UNUSED(Tcl_Interp *), Tcl_Obj *objPtr) /* The object to convert. */ { - if (!TclHasInternalRep(objPtr, &tclUniCharStringType)) { - UniCharString *stringPtr = uniCharStringAlloc(0); + if (!TclHasInternalRep(objPtr, &tclStringType)) { + String *stringPtr = stringAlloc(0); /* * Convert whatever we have into an untyped value. Just A String. @@ -4737,8 +4334,8 @@ SetStringFromAny( stringPtr->allocated = objPtr->length; stringPtr->maxChars = 0; stringPtr->hasUnicode = 0; - SET_UNICHAR_STRING(objPtr, stringPtr); - objPtr->typePtr = &tclUniCharStringType; + SET_STRING(objPtr, stringPtr); + objPtr->typePtr = &tclStringType; } return TCL_OK; } @@ -4765,7 +4362,7 @@ static void UpdateStringOfString( Tcl_Obj *objPtr) /* Object with string rep to update. */ { - UniCharString *stringPtr = GET_UNICHAR_STRING(objPtr); + String *stringPtr = GET_STRING(objPtr); /* * This routine is only called when we need to generate the @@ -4785,21 +4382,21 @@ UpdateStringOfString( } } -static int +static size_t ExtendStringRepWithUnicode( Tcl_Obj *objPtr, const Tcl_UniChar *unicode, - int numChars) + size_t numChars) { /* * Pre-condition: this is the "string" Tcl_ObjType. */ - int i, origLength, size = 0; + size_t i, origLength, size = 0; char *dst; - UniCharString *stringPtr = GET_UNICHAR_STRING(objPtr); + String *stringPtr = GET_STRING(objPtr); - if (numChars < 0) { + if (numChars == TCL_INDEX_NONE) { numChars = UnicodeLength(unicode); } @@ -4821,11 +4418,8 @@ ExtendStringRepWithUnicode( goto copyBytes; } - for (i = 0; i < numChars && size >= 0; i++) { - size += (unsigned int)TclUtfCount(unicode[i]); - } - if (size < 0) { - Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); + for (i = 0; i < numChars; i++) { + size += TclUtfCount(unicode[i]); } /* @@ -4851,7 +4445,7 @@ ExtendStringRepWithUnicode( * * FreeStringInternalRep -- * - * Deallocate the storage associated with a (UniChar)String data object's internal + * Deallocate the storage associated with a String data object's internal * representation. * * Results: @@ -4867,7 +4461,7 @@ static void FreeStringInternalRep( Tcl_Obj *objPtr) /* Object with internal rep to free. */ { - ckfree(GET_STRING(objPtr)); + Tcl_Free(GET_STRING(objPtr)); objPtr->typePtr = NULL; } diff --git a/generic/tclStringRep.h b/generic/tclStringRep.h index bce9092..ab52ea8 100644 --- a/generic/tclStringRep.h +++ b/generic/tclStringRep.h @@ -43,6 +43,11 @@ * Unicode reps 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! */ typedef struct { @@ -58,30 +63,21 @@ typedef struct { * space allocated for the unicode array. */ int hasUnicode; /* Boolean determining whether the string has * a Unicode representation. */ - unsigned short unicode[TCLFLEXARRAY]; /* The array of Unicode chars. The actual size + Tcl_UniChar unicode[TCLFLEXARRAY]; /* The array of Unicode chars. The actual size * of this field depends on the 'maxChars' * field above. */ } String; -#define STRING_MAXCHARS \ - (int)(((size_t)UINT_MAX - offsetof(String, unicode))/sizeof(unsigned short) - 1) #define STRING_SIZE(numChars) \ - (offsetof(String, unicode) + sizeof(unsigned short) + ((numChars) * sizeof(unsigned short))) -#define stringCheckLimits(numChars) \ - do { \ - if ((numChars) < 0 || (numChars) > STRING_MAXCHARS) { \ - Tcl_Panic("max length for a Tcl unicode value (%d chars) exceeded", \ - STRING_MAXCHARS); \ - } \ - } while (0) + (offsetof(String, unicode) + sizeof(Tcl_UniChar) + ((numChars) * sizeof(Tcl_UniChar))) #define stringAttemptAlloc(numChars) \ - (String *) attemptckalloc(STRING_SIZE(numChars)) + (String *) Tcl_AttemptAlloc(STRING_SIZE(numChars)) #define stringAlloc(numChars) \ - (String *) ckalloc(STRING_SIZE(numChars)) + (String *) Tcl_Alloc(STRING_SIZE(numChars)) #define stringRealloc(ptr, numChars) \ - (String *) ckrealloc((ptr), STRING_SIZE(numChars)) + (String *) Tcl_Realloc((ptr), STRING_SIZE(numChars)) #define stringAttemptRealloc(ptr, numChars) \ - (String *) attemptckrealloc((ptr), STRING_SIZE(numChars)) + (String *) Tcl_AttemptRealloc((ptr), STRING_SIZE(numChars)) #define GET_STRING(objPtr) \ ((String *) (objPtr)->internalRep.twoPtrValue.ptr1) #define SET_STRING(objPtr, stringPtr) \ diff --git a/generic/tclStubCall.c b/generic/tclStubCall.c new file mode 100644 index 0000000..e0d85a6 --- /dev/null +++ b/generic/tclStubCall.c @@ -0,0 +1,117 @@ +/* + * tclStubCall.c -- + * + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#include "tclInt.h" +#ifndef _WIN32 +# include <dlfcn.h> +#else +# define dlopen(a,b) (void *)LoadLibraryW(JOIN(L,a)) +# define dlsym(a,b) (void *)GetProcAddress((HMODULE)(a),b) +# define dlerror() "" +#endif + +MODULE_SCOPE void *tclStubsHandle; + +/* + *---------------------------------------------------------------------- + * + * TclStubCall -- + * + * Load the Tcl core dynamically, version "9.0" (or higher, in future versions). + * + * Results: + * Returns a function from the Tcl dynamic library or a function + * returning NULL if that function cannot be found. See PROCNAME table. + * + * The functions Tcl_MainEx and Tcl_MainExW never return. + * Tcl_GetMemoryInfo and Tcl_StaticLibrary return (void), + * Tcl_SetExitProc returns its previous exitProc and + * Tcl_SetPreInitScript returns the previous script. This means that + * those 6 functions cannot be used to initialize the stub-table, + * only the first 4 functions in the table can do that. + * + *---------------------------------------------------------------------- + */ + +/* Table containing which function will be returned, depending on the "arg" */ +static const char PROCNAME[][24] = { + "_Tcl_SetPanicProc", /* Default, whenever "arg" <= 0 or "arg" > 8 */ + "_Tcl_InitSubsystems", /* "arg" == (void *)1 */ + "_Tcl_FindExecutable", /* "arg" == (void *)2 */ + "_TclZipfs_AppHook", /* "arg" == (void *)3 */ + "_Tcl_MainExW", /* "arg" == (void *)4 */ + "_Tcl_MainEx", /* "arg" == (void *)5 */ + "_Tcl_StaticLibrary", /* "arg" == (void *)6 */ + "_Tcl_SetExitProc", /* "arg" == (void *)7 */ + "_Tcl_GetMemoryInfo", /* "arg" == (void *)8 */ + "_Tcl_SetPreInitScript" /* "arg" == (void *)9 */ +}; + +MODULE_SCOPE const void *nullVersionProc(void) { + return NULL; +} + +static const char CANNOTCALL[] = "Cannot call %s from stubbed extension\n"; +static const char CANNOTFIND[] = "Cannot find %s: %s\n"; + +MODULE_SCOPE void * +TclStubCall(void *arg) +{ + static void *stubFn[] = {NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL}; + size_t index = PTR2UINT(arg); + + if (index >= sizeof(PROCNAME)/sizeof(PROCNAME[0])) { + /* Any other value means Tcl_SetPanicProc() with non-null panicProc */ + index = 0; + } + if (tclStubsHandle == INT2PTR(-1)) { + if ((index == 0) && (arg != NULL)) { + ((Tcl_PanicProc *)arg)(CANNOTCALL, PROCNAME[index] + 1); + } else { + fprintf(stderr, CANNOTCALL, PROCNAME[index] + 1); + abort(); + } + } + if (!stubFn[index]) { + if (!tclStubsHandle) { + tclStubsHandle = dlopen(CFG_RUNTIME_DLLFILE, RTLD_NOW|RTLD_LOCAL); + if (!tclStubsHandle) { +#if defined(_WIN32) + tclStubsHandle = dlopen(CFG_RUNTIME_BINDIR "\\" CFG_RUNTIME_DLLFILE, RTLD_NOW|RTLD_LOCAL); +#elif defined(__CYGWIN__) + tclStubsHandle = dlopen(CFG_RUNTIME_BINDIR "/" CFG_RUNTIME_DLLFILE, RTLD_NOW|RTLD_LOCAL); +#else + tclStubsHandle = dlopen(CFG_RUNTIME_LIBDIR "/" CFG_RUNTIME_DLLFILE, RTLD_NOW|RTLD_LOCAL); +#endif + } + if (!tclStubsHandle) { + if ((index == 0) && (arg != NULL)) { + ((Tcl_PanicProc *)arg)(CANNOTFIND, CFG_RUNTIME_DLLFILE, dlerror()); + } else { + fprintf(stderr, CANNOTFIND, CFG_RUNTIME_DLLFILE, dlerror()); + abort(); + } + } + } + stubFn[index] = dlsym(tclStubsHandle, PROCNAME[index] + 1); + if (!stubFn[index]) { + stubFn[index] = dlsym(tclStubsHandle, PROCNAME[index]); + if (!stubFn[index]) { + stubFn[index] = (void *)nullVersionProc; + } + } + } + return stubFn[index]; +} + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index ddc0bc9..1186aa3 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -41,15 +41,8 @@ #undef Tcl_NewStringObj #undef Tcl_GetUnicode #undef Tcl_GetUnicodeFromObj -#undef Tcl_AppendUnicodeToObj #undef Tcl_NewUnicodeObj #undef Tcl_SetUnicodeObj -#undef Tcl_UniCharNcasecmp -#undef Tcl_UniCharCaseMatch -#undef Tcl_UniCharLen -#undef Tcl_UniCharNcmp -#undef Tcl_GetRange -#undef Tcl_GetUniChar #undef Tcl_DumpActiveMemory #undef Tcl_ValidateAllMemory #undef Tcl_FindHashEntry @@ -62,6 +55,13 @@ #undef TclSockMinimumBuffers #undef Tcl_SetIntObj #undef Tcl_SetLongObj +#undef Tcl_ListObjGetElements +#undef Tcl_ListObjLength +#undef Tcl_DictObjSize +#undef Tcl_SplitList +#undef Tcl_SplitPath +#undef Tcl_FSSplitPath +#undef Tcl_ParseArgsObjv #undef TclpInetNtoa #undef TclWinGetServByName #undef TclWinGetSockOpt @@ -69,158 +69,158 @@ #undef TclWinNToHS #undef TclStaticLibrary #undef Tcl_BackgroundError -#undef TclGuessPackageName -#undef TclGetLoadedPackages #define TclStaticLibrary Tcl_StaticLibrary #undef Tcl_UniCharToUtfDString #undef Tcl_UtfToUniCharDString #undef Tcl_UtfToUniChar -#undef Tcl_MacOSXOpenBundleResources -#undef TclWinConvertWSAError -#undef TclWinConvertError -#undef Tcl_NumUtfChars -#undef Tcl_GetCharLength -#undef Tcl_UtfAtIndex -#undef Tcl_GetRange -#undef Tcl_GetUniChar +#undef Tcl_UniCharLen #undef TclObjInterpProc - -#if defined(_WIN32) || defined(__CYGWIN__) -#define TclWinConvertWSAError (void (*)(DWORD))(void *)Tcl_WinConvertError -#define TclWinConvertError (void (*)(DWORD))(void *)Tcl_WinConvertError +#if !defined(_WIN32) && !defined(__CYGWIN__) +#undef Tcl_WinConvertError +#define Tcl_WinConvertError 0 #endif +#undef Tcl_Close +#define Tcl_Close 0 +#undef TclGetByteArrayFromObj +#define TclGetByteArrayFromObj 0 +#undef Tcl_GetByteArrayFromObj +#define Tcl_GetByteArrayFromObj 0 +#define TclUnusedStubEntry 0 -#if TCL_UTF_MAX > 3 && defined(TCL_NO_DEPRECATED) -static void uniCodePanic(void) { - Tcl_Panic("Tcl is compiled without the the UTF16 compatibility layer (-DTCL_NO_DEPRECATED)"); +#if TCL_UTF_MAX < 4 +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_GetUnicode (unsigned short *(*)(Tcl_Obj *))(void *)uniCodePanic -# define Tcl_GetUnicodeFromObj (unsigned short *(*)(Tcl_Obj *, int *))(void *)uniCodePanic -# define TclGetUnicodeFromObj (unsigned short *(*)(Tcl_Obj *, size_t *))(void *)uniCodePanic -# define Tcl_NewUnicodeObj (Tcl_Obj *(*)(const unsigned short *, int))(void *)uniCodePanic -# define Tcl_SetUnicodeObj (void(*)(Tcl_Obj *, const unsigned short *, int))(void *)uniCodePanic -# define Tcl_AppendUnicodeToObj (void(*)(Tcl_Obj *, const unsigned short *, int))(void *)uniCodePanic -# define Tcl_UtfAtIndex (const char *(*)(const char *, int))(void *)uniCodePanic -# define Tcl_GetCharLength (int(*)(Tcl_Obj *))(void *)uniCodePanic -# define Tcl_UniCharNcmp (int(*)(const unsigned short *, const unsigned short *, unsigned long))(void *)uniCodePanic -# define Tcl_UniCharNcasecmp (int(*)(const unsigned short *, const unsigned short *, unsigned long))(void *)uniCodePanic -# define Tcl_UniCharCaseMatch (int(*)(const unsigned short *, const unsigned short *, int))(void *)uniCodePanic -# define Tcl_GetRange (Tcl_Obj *(*)(Tcl_Obj *, int, int))(void *)uniCodePanic -# define Tcl_GetUniChar (int(*)(Tcl_Obj *, int))(void *)uniCodePanic -# define Tcl_NumUtfChars (int(*)(const char *, int))(void *)uniCodePanic +# define Tcl_GetUnicodeFromObj (Tcl_UniChar *(*)(Tcl_Obj *, size_t *))(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 #endif -#define TclUtfCharComplete UtfCharComplete -#define TclUtfNext UtfNext -#define TclUtfPrev UtfPrev - -static int TclUtfCharComplete(const char *src, int length) { - if ((unsigned)((unsigned char)*(src) - 0xF0) < 5) { - return length < 3; - } - return Tcl_UtfCharComplete(src, length); -} - -static const char *TclUtfNext(const char *src) { - if ((unsigned)((unsigned char)*(src) - 0xF0) < 5) { - return src + 1; - } - return Tcl_UtfNext(src); -} - -static const char *TclUtfPrev(const char *src, const char *start) { - if ((src >= start + 3) && ((src[-1] & 0xC0) == 0x80) - && ((src[-2] & 0xC0) == 0x80) && ((src[-3] & 0xC0) == 0x80)) { - return src - 3; - } - return Tcl_UtfPrev(src, start); -} +#define TclUtfCharComplete Tcl_UtfCharComplete +#define TclUtfNext Tcl_UtfNext +#define TclUtfPrev Tcl_UtfPrev int TclListObjGetElements(Tcl_Interp *interp, Tcl_Obj *listPtr, - size_t *objcPtr, Tcl_Obj ***objvPtr) { - int n, result = Tcl_ListObjGetElements(interp, listPtr, &n, objvPtr); - if ((result == TCL_OK) && objcPtr) { + int *objcPtr, Tcl_Obj ***objvPtr) { + size_t 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)) { + if (interp) { + Tcl_AppendResult(interp, "List too large to be processed", NULL); + } + return TCL_ERROR; + } *objcPtr = n; } return result; } int TclListObjLength(Tcl_Interp *interp, Tcl_Obj *listPtr, - size_t *lengthPtr) { - int n; + int *lengthPtr) { + size_t n = TCL_INDEX_NONE; int result = Tcl_ListObjLength(interp, listPtr, &n); - if ((result == TCL_OK) && lengthPtr) { + if (lengthPtr) { + if ((sizeof(int) != sizeof(size_t)) && (result == TCL_OK) && (n > INT_MAX)) { + if (interp) { + Tcl_AppendResult(interp, "List too large to be processed", NULL); + } + return TCL_ERROR; + } *lengthPtr = n; } return result; } int TclDictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr, - size_t *sizePtr) { - int n, result = Tcl_DictObjSize(interp, dictPtr, &n); - if ((result == TCL_OK) && sizePtr) { + int *sizePtr) { + size_t 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)) { + if (interp) { + Tcl_AppendResult(interp, "Dict too large to be processed", NULL); + } + return TCL_ERROR; + } *sizePtr = n; } return result; } -int TclSplitList(Tcl_Interp *interp, const char *listStr, size_t *argcPtr, +int TclSplitList(Tcl_Interp *interp, const char *listStr, int *argcPtr, const char ***argvPtr) { - int n; + size_t n = TCL_INDEX_NONE; int result = Tcl_SplitList(interp, listStr, &n, argvPtr); - if ((result == TCL_OK) && argcPtr) { + if (argcPtr) { + if ((sizeof(int) != sizeof(size_t)) && (result == TCL_OK) && (n > INT_MAX)) { + if (interp) { + Tcl_AppendResult(interp, "List too large to be processed", NULL); + } + Tcl_Free((void *)*argvPtr); + return TCL_ERROR; + } *argcPtr = n; } return result; } -void TclSplitPath(const char *path, size_t *argcPtr, const char ***argvPtr) { - int n; +void TclSplitPath(const char *path, int *argcPtr, const char ***argvPtr) { + size_t n = TCL_INDEX_NONE; Tcl_SplitPath(path, &n, argvPtr); if (argcPtr) { + if ((sizeof(int) != sizeof(size_t)) && (n > INT_MAX)) { + n = TCL_INDEX_NONE; /* No other way to return an error-situation */ + Tcl_Free((void *)*argvPtr); + *argvPtr = NULL; + } *argcPtr = n; } } -Tcl_Obj *TclFSSplitPath(Tcl_Obj *pathPtr, size_t *lenPtr) { - int n; +Tcl_Obj *TclFSSplitPath(Tcl_Obj *pathPtr, int *lenPtr) { + size_t n = TCL_INDEX_NONE; Tcl_Obj *result = Tcl_FSSplitPath(pathPtr, &n); - if (result && lenPtr) { + if (lenPtr) { + if ((sizeof(int) != sizeof(size_t)) && result && (n > INT_MAX)) { + Tcl_DecrRefCount(result); + return NULL; + } *lenPtr = n; } return result; } int TclParseArgsObjv(Tcl_Interp *interp, - const Tcl_ArgvInfo *argTable, size_t *objcPtr, Tcl_Obj *const *objv, + const Tcl_ArgvInfo *argTable, int *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv) { - int n, result; - if (*objcPtr > INT_MAX) { - if (interp) { - Tcl_AppendResult(interp, "Tcl_ParseArgsObjv cannot handle *objcPtr > INT_MAX", NULL); - } - return TCL_ERROR; - } - n = (int)*objcPtr; - result = Tcl_ParseArgsObjv(interp, argTable, &n, objv, remObjv); - *objcPtr = n; + size_t n = (*objcPtr < 0) ? TCL_INDEX_NONE: (size_t)*objcPtr ; + int result = Tcl_ParseArgsObjv(interp, argTable, &n, objv, remObjv); + *objcPtr = (int)n; return result; } #define TclBN_mp_add mp_add +#define TclBN_mp_add_d mp_add_d #define TclBN_mp_and mp_and #define TclBN_mp_clamp mp_clamp #define TclBN_mp_clear mp_clear #define TclBN_mp_clear_multi mp_clear_multi #define TclBN_mp_cmp mp_cmp +#define TclBN_mp_cmp_d mp_cmp_d #define TclBN_mp_cmp_mag mp_cmp_mag #define TclBN_mp_cnt_lsb mp_cnt_lsb #define TclBN_mp_copy mp_copy #define TclBN_mp_count_bits mp_count_bits #define TclBN_mp_div mp_div +#define TclBN_mp_div_d mp_div_d #define TclBN_mp_div_2 mp_div_2 #define TclBN_mp_div_2d mp_div_2d #define TclBN_mp_exch mp_exch +#define TclBN_mp_expt_u32 mp_expt_u32 #define TclBN_mp_get_mag_u64 mp_get_mag_u64 #define TclBN_mp_grow mp_grow #define TclBN_mp_init mp_init #define TclBN_mp_init_copy mp_init_copy #define TclBN_mp_init_multi mp_init_multi +#define TclBN_mp_init_set mp_init_set #define TclBN_mp_init_size mp_init_size #define TclBN_mp_init_i64 mp_init_i64 #define TclBN_mp_init_u64 mp_init_u64 @@ -228,6 +228,7 @@ int TclParseArgsObjv(Tcl_Interp *interp, #define TclBN_mp_mod mp_mod #define TclBN_mp_mod_2d mp_mod_2d #define TclBN_mp_mul mp_mul +#define TclBN_mp_mul_d mp_mul_d #define TclBN_mp_mul_2 mp_mul_2 #define TclBN_mp_mul_2d mp_mul_2d #define TclBN_mp_neg mp_neg @@ -235,7 +236,6 @@ int TclParseArgsObjv(Tcl_Interp *interp, #define TclBN_mp_pack mp_pack #define TclBN_mp_pack_count mp_pack_count #define TclBN_mp_radix_size mp_radix_size -#define TclBN_mp_reverse mp_reverse #define TclBN_mp_read_radix mp_read_radix #define TclBN_mp_rshd mp_rshd #define TclBN_mp_set_i64 mp_set_i64 @@ -244,11 +244,8 @@ int TclParseArgsObjv(Tcl_Interp *interp, #define TclBN_mp_sqr mp_sqr #define TclBN_mp_sqrt mp_sqrt #define TclBN_mp_sub mp_sub +#define TclBN_mp_sub_d mp_sub_d #define TclBN_mp_signed_rsh mp_signed_rsh -#define TclBN_mp_tc_and TclBN_mp_and -#define TclBN_mp_tc_div_2d mp_signed_rsh -#define TclBN_mp_tc_or TclBN_mp_or -#define TclBN_mp_tc_xor TclBN_mp_xor #define TclBN_mp_to_radix mp_to_radix #define TclBN_mp_to_ubin mp_to_ubin #define TclBN_mp_ubin_size mp_ubin_size @@ -256,7 +253,7 @@ int TclParseArgsObjv(Tcl_Interp *interp, #define TclBN_mp_xor mp_xor #define TclBN_mp_zero mp_zero #define TclBN_s_mp_add s_mp_add -#define TclBN_s_mp_balance_mul s_mp_balance_mul +#define TclBN_mp_balance_mul s_mp_balance_mul #define TclBN_mp_karatsuba_mul s_mp_karatsuba_mul #define TclBN_mp_karatsuba_sqr s_mp_karatsuba_sqr #define TclBN_s_mp_mul_digs s_mp_mul_digs @@ -267,261 +264,17 @@ int TclParseArgsObjv(Tcl_Interp *interp, #define TclBN_s_mp_sub s_mp_sub #define TclBN_mp_toom_mul s_mp_toom_mul #define TclBN_mp_toom_sqr s_mp_toom_sqr -#define TclUnusedStubEntry 0 - -/* See bug 510001: TclSockMinimumBuffers needs plat imp */ -#if defined(_WIN64) || defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8 -# define TclSockMinimumBuffersOld 0 -#else -#define TclSockMinimumBuffersOld sockMinimumBuffersOld -static int TclSockMinimumBuffersOld(int sock, int size) -{ - return TclSockMinimumBuffers(INT2PTR(sock), size); -} -#endif - -mp_err TclBN_mp_set_int(mp_int *a, unsigned long i) -{ - TclBN_mp_set_u64(a, i); - return MP_OKAY; -} -static mp_err TclBN_mp_set_long(mp_int *a, unsigned long i) -{ - TclBN_mp_set_u64(a, i); - return MP_OKAY; -} - -#define TclBN_mp_set_ul (void (*)(mp_int *a, unsigned long i))(void *)TclBN_mp_set_long - -mp_err MP_WUR TclBN_mp_expt_u32(const mp_int *a, unsigned int b, mp_int *c) { - return mp_expt_u32(a, b, c); -} -mp_err TclBN_mp_add_d(const mp_int *a, unsigned int b, mp_int *c) { - return mp_add_d(a, b, c); -} -mp_err TclBN_mp_cmp_d(const mp_int *a, unsigned int b) { - return mp_cmp_d(a, b); -} -mp_err TclBN_mp_sub_d(const mp_int *a, unsigned int b, mp_int *c) { - return mp_sub_d(a, b, c); -} -mp_err TclBN_mp_div_d(const mp_int *a, unsigned int b, mp_int *c, unsigned int *d) { - mp_digit d2; - mp_err result = mp_div_d(a, b, c, (d ? &d2 : NULL)); - if (d) { - *d = d2; - } - return result; -} -mp_err TclBN_mp_div_ld(const mp_int *a, uint64_t b, mp_int *c, uint64_t *d) { - mp_err result; - mp_digit d2; - - if ((b | (mp_digit)-1) != (mp_digit)-1) { - return MP_VAL; - } - result = mp_div_d(a, (mp_digit)b, c, (d ? &d2 : NULL)); - if (d) { - *d = d2; - } - return result; -} -mp_err TclBN_mp_init_set(mp_int *a, unsigned int b) { - return mp_init_set(a, b); -} -mp_err TclBN_mp_mul_d(const mp_int *a, unsigned int b, mp_int *c) { - return mp_mul_d(a, b, c); -} - -#if defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8 -# define TclBN_mp_expt_d_ex 0 -# define TclBN_mp_to_unsigned_bin 0 -# define TclBN_mp_to_unsigned_bin_n 0 -# define TclBN_mp_toradix_n 0 -# undef TclBN_mp_sqr -# define TclBN_mp_sqr 0 -# undef TclBN_mp_div_3 -# define TclBN_mp_div_3 0 -# define TclBN_mp_init_l 0 -# define TclBN_mp_init_ul 0 -# define TclBN_mp_set 0 -# define TclSetStartupScriptPath 0 -# define TclGetStartupScriptPath 0 -# define TclSetStartupScriptFileName 0 -# define TclGetStartupScriptFileName 0 -# define TclPrecTraceProc 0 -# define TclpInetNtoa 0 -# define TclWinGetServByName 0 -# define TclWinGetSockOpt 0 -# define TclWinSetSockOpt 0 -# define TclWinNToHS 0 -# define TclWinGetPlatformId 0 -# define TclWinResetInterfaces 0 -# define TclWinSetInterfaces 0 -# define TclWinGetPlatformId 0 -# define Tcl_Backslash 0 -# define Tcl_GetDefaultEncodingDir 0 -# define Tcl_SetDefaultEncodingDir 0 -# define Tcl_EvalTokens 0 -# define Tcl_CreateMathFunc 0 -# define Tcl_GetMathFuncInfo 0 -# define Tcl_ListMathFuncs 0 -# define Tcl_SetIntObj 0 -# define Tcl_SetLongObj 0 -# define Tcl_NewIntObj 0 -# define Tcl_NewLongObj 0 -# define Tcl_DbNewLongObj 0 -# define Tcl_BackgroundError 0 -# define Tcl_FreeResult 0 -# define Tcl_ChannelSeekProc 0 -# define Tcl_ChannelCloseProc 0 -# define Tcl_Close 0 -# define Tcl_MacOSXOpenBundleResources 0 -# define TclGuessPackageName 0 -# define TclGetLoadedPackages 0 -# undef TclSetPreInitScript -# define TclSetPreInitScript 0 -# define TclInitCompiledLocals 0 -#else - -#define TclGuessPackageName guessPackageName -static int TclGuessPackageName( - TCL_UNUSED(const char *), - TCL_UNUSED(Tcl_DString *)) { - return 0; -} -#define TclGetLoadedPackages getLoadedPackages -static int TclGetLoadedPackages( - Tcl_Interp *interp, /* Interpreter in which to return information - * or error message. */ - const char *targetName) /* Name of target interpreter or NULL. If - * NULL, return info about all interps; - * otherwise, just return info about this - * interpreter. */ -{ - return TclGetLoadedLibraries(interp, targetName, NULL); -} - -mp_err TclBN_mp_div_3(const mp_int *a, mp_int *c, unsigned int *d) { - mp_digit d2; - mp_err result = mp_div_d(a, 3, c, &d2); - if (d) { - *d = d2; - } - return result; -} - -int TclBN_mp_expt_d_ex(const mp_int *a, unsigned int b, mp_int *c, - TCL_UNUSED(int) /*fast*/) -{ - return TclBN_mp_expt_u32(a, b, c); -} - -mp_err TclBN_mp_to_unsigned_bin(const mp_int *a, unsigned char *b) -{ - return TclBN_mp_to_ubin(a, b, INT_MAX, NULL); -} - -mp_err TclBN_mp_to_unsigned_bin_n(const mp_int *a, unsigned char *b, unsigned long *outlen) -{ - size_t n = TclBN_mp_ubin_size(a); - if (*outlen < (unsigned long)n) { - return MP_VAL; - } - *outlen = (unsigned long)n; - return TclBN_mp_to_ubin(a, b, n, NULL); -} - -void TclBN_reverse(unsigned char *s, int len) -{ - if (len > 0) { - TclBN_s_mp_reverse(s, (size_t)len); - } -} - -mp_err TclBN_mp_init_ul(mp_int *a, unsigned long b) -{ - return TclBN_mp_init_u64(a,b); -} - -mp_err TclBN_mp_init_l(mp_int *a, long b) -{ - return TclBN_mp_init_i64(a,b); -} - -void TclBN_mp_set(mp_int *a, unsigned int b) { - TclBN_mp_set_u64(a, b); -} - -mp_err TclBN_mp_toradix_n(const mp_int *a, char *str, int radix, int maxlen) -{ - if (maxlen < 0) { - return MP_VAL; - } - return TclBN_mp_to_radix(a, str, maxlen, NULL, radix); -} - -#define TclSetStartupScriptPath setStartupScriptPath -static void TclSetStartupScriptPath(Tcl_Obj *path) -{ - Tcl_SetStartupScript(path, NULL); -} -#define TclGetStartupScriptPath getStartupScriptPath -static Tcl_Obj *TclGetStartupScriptPath(void) -{ - return Tcl_GetStartupScript(NULL); -} -#define TclSetStartupScriptFileName setStartupScriptFileName -static void TclSetStartupScriptFileName( - const char *fileName) -{ - Tcl_SetStartupScript(Tcl_NewStringObj(fileName,-1), NULL); -} -#define TclGetStartupScriptFileName getStartupScriptFileName -static const char *TclGetStartupScriptFileName(void) -{ - Tcl_Obj *path = Tcl_GetStartupScript(NULL); - if (path == NULL) { - return NULL; - } - return Tcl_GetString(path); -} -#if defined(_WIN32) || defined(__CYGWIN__) -#undef TclWinNToHS -#undef TclWinGetPlatformId -#undef TclWinResetInterfaces -#undef TclWinSetInterfaces -static void -doNothing(void) -{ - /* dummy implementation, no need to do anything */ -} -#define TclWinNToHS winNToHS -static unsigned short TclWinNToHS(unsigned short ns) { - return ntohs(ns); -} -#define TclWinGetPlatformId winGetPlatformId -static int -TclWinGetPlatformId(void) -{ - return 2; /* VER_PLATFORM_WIN32_NT */; -} -#define TclWinResetInterfaces doNothing -#define TclWinSetInterfaces (void (*) (int)) doNothing +#ifndef MAC_OSX_TCL /* On UNIX, fill with other stub entries */ +# define Tcl_MacOSXOpenVersionedBundleResources 0 +# define Tcl_MacOSXNotifierAddRunLoopMode 0 #endif -#endif /* TCL_NO_DEPRECATED */ - -#define TclpCreateTempFile_ TclpCreateTempFile -#define TclUnixWaitForFile_ TclUnixWaitForFile -#ifdef MAC_OSX_TCL /* On UNIX, fill with other stub entries */ -#define TclMacOSXNotifierAddRunLoopMode Tcl_MacOSXNotifierAddRunLoopMode +#ifdef _WIN32 +# define Tcl_CreateFileHandler 0 +# define Tcl_DeleteFileHandler 0 +# define Tcl_GetOpenFile 0 #else -#define TclMacOSXGetFileAttribute (int (*)(Tcl_Interp *, int, Tcl_Obj *, Tcl_Obj **))(void *)TclpCreateProcess -#define TclMacOSXSetFileAttribute (int (*)(Tcl_Interp *, int, Tcl_Obj *, Tcl_Obj *))(void *)isatty -#define TclMacOSXCopyFileAttributes (int (*)(const char *, const char *, const Tcl_StatBuf *))(void *)TclUnixCopyFile -#define TclMacOSXMatchType (int (*)(Tcl_Interp *, const char *, const char *, Tcl_StatBuf *, Tcl_GlobTypeData *))(void *)TclpMakeFile -#define TclMacOSXNotifierAddRunLoopMode (void (*)(const void *))(void *)TclpOpenFile +# define TclpIsAtty isatty #endif #ifdef _WIN32 @@ -529,44 +282,18 @@ TclWinGetPlatformId(void) # define TclUnixCopyFile 0 # define TclUnixOpenTemporaryFile 0 # define TclpReaddir 0 +# undef TclpIsAtty # define TclpIsAtty 0 #elif defined(__CYGWIN__) # define TclpIsAtty isatty -#if defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8 static void doNothing(void) { /* dummy implementation, no need to do anything */ } -#endif -# define TclWinAddProcess (void (*) (void *, unsigned int)) doNothing +# define TclWinAddProcess (void (*) (void *, size_t)) doNothing # define TclWinFlushDirtyChannels doNothing -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 -#define TclWinSetSockOpt winSetSockOpt -static int -TclWinSetSockOpt(SOCKET s, int level, int optname, - const char *optval, int optlen) -{ - return setsockopt((int) s, level, optname, optval, optlen); -} - -#define TclWinGetSockOpt winGetSockOpt -static int -TclWinGetSockOpt(SOCKET s, int level, int optname, - char *optval, int *optlen) -{ - return getsockopt((int) s, level, optname, optval, optlen); -} - -#define TclWinGetServByName winGetServByName -static struct servent * -TclWinGetServByName(const char *name, const char *proto) -{ - return getservbyname(name, proto); -} -#endif /* TCL_NO_DEPRECATED */ - #define TclWinNoBackslash winNoBackslash static char * TclWinNoBackslash(char *path) @@ -589,34 +316,11 @@ void *TclWinGetTclInstance() return hInstance; } -int +size_t TclpGetPid(Tcl_Pid pid) { - return (int)(size_t)pid; -} - -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 -#undef Tcl_WinUtfToTChar -char * -Tcl_WinUtfToTChar( - const char *string, - int len, - Tcl_DString *dsPtr) -{ - Tcl_DStringInit(dsPtr); - return (char *)Tcl_UtfToChar16DString(string, len, dsPtr); -} -#undef Tcl_WinTCharToUtf -char * -Tcl_WinTCharToUtf( - const char *string, - int len, - Tcl_DString *dsPtr) -{ - Tcl_DStringInit(dsPtr); - return Tcl_Char16ToUtfDString((const unsigned short *)string, len >> 1, dsPtr); + return (size_t)pid; } -#endif /* !defined(TCL_NO_DEPRECATED) */ #if defined(TCL_WIDE_INT_IS_LONG) /* On Cygwin64, long is 64-bit while on Win64 long is 32-bit. Therefore @@ -656,16 +360,6 @@ static int exprIntObj(Tcl_Interp *interp, Tcl_Obj*expr, int *ptr){ return result; } #define Tcl_ExprLongObj (int(*)(Tcl_Interp*,Tcl_Obj*,long*))exprIntObj -#if TCL_UTF_MAX < 4 && !defined(TCL_NO_DEPRECATED) -static int uniCharNcmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned int n){ - return Tcl_UniCharNcmp(ucs, uct, (unsigned long)n); -} -#define Tcl_UniCharNcmp (int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned long))(void *)uniCharNcmp -static int uniCharNcasecmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned int n){ - return Tcl_UniCharNcasecmp(ucs, uct, (unsigned long)n); -} -#define Tcl_UniCharNcasecmp (int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned long))(void *)uniCharNcasecmp -#endif static int utfNcmp(const char *s1, const char *s2, unsigned int n){ return Tcl_UtfNcmp(s1, s2, (unsigned long)n); } @@ -677,172 +371,12 @@ static int utfNcasecmp(const char *s1, const char *s2, unsigned int n){ #endif /* TCL_WIDE_INT_IS_LONG */ -#endif /* __CYGWIN__ */ - -#if defined(TCL_NO_DEPRECATED) -# define Tcl_SeekOld 0 -# define Tcl_TellOld 0 -# undef Tcl_SetBooleanObj -# define Tcl_SetBooleanObj 0 -# undef Tcl_PkgPresent -# define Tcl_PkgPresent 0 -# undef Tcl_PkgProvide -# define Tcl_PkgProvide 0 -# undef Tcl_PkgRequire -# define Tcl_PkgRequire 0 -# undef Tcl_GetIndexFromObj -# define Tcl_GetIndexFromObj 0 -# define Tcl_NewBooleanObj 0 -# undef Tcl_DbNewBooleanObj -# define Tcl_DbNewBooleanObj 0 -# undef Tcl_SetBooleanObj -# define Tcl_SetBooleanObj 0 -# undef Tcl_SetVar -# define Tcl_SetVar 0 -# undef Tcl_UnsetVar -# define Tcl_UnsetVar 0 -# undef Tcl_GetVar -# define Tcl_GetVar 0 -# undef Tcl_TraceVar -# define Tcl_TraceVar 0 -# undef Tcl_UntraceVar -# define Tcl_UntraceVar 0 -# undef Tcl_VarTraceInfo -# define Tcl_VarTraceInfo 0 -# undef Tcl_UpVar -# define Tcl_UpVar 0 -# undef Tcl_AddErrorInfo -# define Tcl_AddErrorInfo 0 -# undef Tcl_AddObjErrorInfo -# define Tcl_AddObjErrorInfo 0 -# undef Tcl_Eval -# define Tcl_Eval 0 -# undef Tcl_GlobalEval -# define Tcl_GlobalEval 0 -# undef Tcl_SaveResult -# define Tcl_SaveResult 0 -# undef Tcl_RestoreResult -# define Tcl_RestoreResult 0 -# undef Tcl_DiscardResult -# define Tcl_DiscardResult 0 -# undef Tcl_SetResult -# define Tcl_SetResult 0 -# undef Tcl_EvalObj -# define Tcl_EvalObj 0 -# undef Tcl_GlobalEvalObj -# define Tcl_GlobalEvalObj 0 -# define TclBackgroundException 0 -# undef TclpReaddir -# define TclpReaddir 0 -# define TclSetStartupScript 0 -# define TclGetStartupScript 0 -# define TclGetIntForIndex 0 -# define TclCreateNamespace 0 -# define TclDeleteNamespace 0 -# define TclAppendExportList 0 -# define TclExport 0 -# define TclImport 0 -# define TclForgetImport 0 -# define TclGetCurrentNamespace_ 0 -# define TclGetGlobalNamespace_ 0 -# define TclFindNamespace 0 -# define TclFindCommand 0 -# define TclGetCommandFromObj 0 -# define TclGetCommandFullName 0 -# define TclCopyChannelOld 0 -# define Tcl_AppendResultVA 0 -# define Tcl_AppendStringsToObjVA 0 -# define Tcl_SetErrorCodeVA 0 -# define Tcl_PanicVA 0 -# define Tcl_VarEvalVA 0 -# undef TclpGetDate -# define TclpGetDate 0 -# undef TclpLocaltime -# define TclpLocaltime 0 -# undef TclpGmtime -# define TclpGmtime 0 -# define TclpLocaltime_unix 0 -# define TclpGmtime_unix 0 -# define Tcl_SetExitProc 0 -# define Tcl_SetPanicProc 0 -# define Tcl_FindExecutable 0 -#if TCL_UTF_MAX < 4 -# define Tcl_GetUnicode 0 -# define Tcl_AppendUnicodeToObj 0 -# define Tcl_UniCharCaseMatch 0 -# define Tcl_UniCharNcasecmp 0 -# define Tcl_UniCharNcmp 0 -#endif -# undef Tcl_StringMatch -# define Tcl_StringMatch 0 -# define TclBN_reverse 0 -# undef TclBN_s_mp_mul_digs_fast -# define TclBN_s_mp_mul_digs_fast 0 -# undef TclBN_s_mp_sqr_fast -# define TclBN_s_mp_sqr_fast 0 -# undef TclBN_mp_karatsuba_mul -# define TclBN_mp_karatsuba_mul 0 -# undef TclBN_mp_karatsuba_sqr -# define TclBN_mp_karatsuba_sqr 0 -# undef TclBN_mp_toom_mul -# define TclBN_mp_toom_mul 0 -# undef TclBN_mp_toom_sqr -# define TclBN_mp_toom_sqr 0 -# undef TclBN_s_mp_add -# define TclBN_s_mp_add 0 -# undef TclBN_s_mp_mul_digs -# define TclBN_s_mp_mul_digs 0 -# undef TclBN_s_mp_sqr -# define TclBN_s_mp_sqr 0 -# undef TclBN_s_mp_sub -# define TclBN_s_mp_sub 0 -# define Tcl_MakeSafe 0 -# define TclpHasSockets 0 -#else /* TCL_NO_DEPRECATED */ -# define Tcl_SeekOld seekOld -# define Tcl_TellOld tellOld -# define TclBackgroundException Tcl_BackgroundException -# define TclSetStartupScript Tcl_SetStartupScript -# define TclGetStartupScript Tcl_GetStartupScript -# define TclGetIntForIndex Tcl_GetIntForIndex -# define TclCreateNamespace Tcl_CreateNamespace -# define TclDeleteNamespace Tcl_DeleteNamespace -# define TclAppendExportList Tcl_AppendExportList -# define TclExport Tcl_Export -# define TclImport Tcl_Import -# define TclForgetImport Tcl_ForgetImport -# define TclGetCurrentNamespace_ Tcl_GetCurrentNamespace -# define TclGetGlobalNamespace_ Tcl_GetGlobalNamespace -# define TclFindNamespace Tcl_FindNamespace -# define TclFindCommand Tcl_FindCommand -# define TclGetCommandFromObj Tcl_GetCommandFromObj -# define TclGetCommandFullName Tcl_GetCommandFullName -# define TclpLocaltime_unix TclpLocaltime -# define TclpGmtime_unix TclpGmtime -# define Tcl_MakeSafe TclMakeSafe - -int TclpHasSockets(TCL_UNUSED(Tcl_Interp *)) {return TCL_OK;} - -static int -seekOld( - Tcl_Channel chan, /* The channel on which to seek. */ - int offset, /* Offset to seek to. */ - int mode) /* Relative to which location to seek? */ -{ - return Tcl_Seek(chan, offset, mode); -} - -static int -tellOld( - Tcl_Channel chan) /* The channel to return pos for. */ -{ - return Tcl_Tell(chan); -} -#endif /* !TCL_NO_DEPRECATED */ - -#if defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8 -#define Tcl_WinUtfToTChar 0 -#define Tcl_WinTCharToUtf 0 +#else /* __CYGWIN__ */ +# define TclWinGetTclInstance 0 +# define TclpGetPid 0 +# define TclWinFlushDirtyChannels 0 +# define TclWinNoBackslash 0 +# define TclWinAddProcess 0 #endif /* @@ -876,7 +410,7 @@ static const TclIntStubs tclIntStubs = { TclCleanupChildren, /* 5 */ TclCleanupCommand, /* 6 */ TclCopyAndCollapse, /* 7 */ - TclCopyChannelOld, /* 8 */ + 0, /* 8 */ TclCreatePipeline, /* 9 */ TclCreateProc, /* 10 */ TclDeleteCompiledLocalVars, /* 11 */ @@ -902,23 +436,23 @@ static const TclIntStubs tclIntStubs = { TclGetExtension, /* 31 */ TclGetFrame, /* 32 */ 0, /* 33 */ - TclGetIntForIndex, /* 34 */ + 0, /* 34 */ 0, /* 35 */ 0, /* 36 */ - TclGetLoadedPackages, /* 37 */ + 0, /* 37 */ TclGetNamespaceForQualName, /* 38 */ TclGetObjInterpProc, /* 39 */ TclGetOpenMode, /* 40 */ TclGetOriginalCommand, /* 41 */ TclpGetUserHome, /* 42 */ TclGetObjInterpProc2, /* 43 */ - TclGuessPackageName, /* 44 */ + 0, /* 44 */ TclHideUnsafeCommands, /* 45 */ TclInExit, /* 46 */ 0, /* 47 */ 0, /* 48 */ 0, /* 49 */ - TclInitCompiledLocals, /* 50 */ + 0, /* 50 */ TclInterpInit, /* 51 */ 0, /* 52 */ TclInvokeObjectCommand, /* 53 */ @@ -945,7 +479,7 @@ static const TclIntStubs tclIntStubs = { TclpFree, /* 74 */ TclpGetClicks, /* 75 */ TclpGetSeconds, /* 76 */ - TclpGetTime, /* 77 */ + 0, /* 77 */ 0, /* 78 */ 0, /* 79 */ 0, /* 80 */ @@ -956,7 +490,7 @@ static const TclIntStubs tclIntStubs = { 0, /* 85 */ 0, /* 86 */ 0, /* 87 */ - TclPrecTraceProc, /* 88 */ + 0, /* 88 */ TclPreventAliasLoop, /* 89 */ 0, /* 90 */ TclProcCleanupProc, /* 91 */ @@ -969,10 +503,10 @@ static const TclIntStubs tclIntStubs = { TclServiceIdle, /* 98 */ 0, /* 99 */ 0, /* 100 */ - TclSetPreInitScript, /* 101 */ + 0, /* 101 */ TclSetupEnv, /* 102 */ TclSockGetPort, /* 103 */ - TclSockMinimumBuffersOld, /* 104 */ + 0, /* 104 */ 0, /* 105 */ 0, /* 106 */ 0, /* 107 */ @@ -980,28 +514,28 @@ static const TclIntStubs tclIntStubs = { TclUpdateReturnInfo, /* 109 */ TclSockMinimumBuffers, /* 110 */ Tcl_AddInterpResolvers, /* 111 */ - TclAppendExportList, /* 112 */ - TclCreateNamespace, /* 113 */ - TclDeleteNamespace, /* 114 */ - TclExport, /* 115 */ - TclFindCommand, /* 116 */ - TclFindNamespace, /* 117 */ + 0, /* 112 */ + 0, /* 113 */ + 0, /* 114 */ + 0, /* 115 */ + 0, /* 116 */ + 0, /* 117 */ Tcl_GetInterpResolvers, /* 118 */ Tcl_GetNamespaceResolvers, /* 119 */ Tcl_FindNamespaceVar, /* 120 */ - TclForgetImport, /* 121 */ - TclGetCommandFromObj, /* 122 */ - TclGetCommandFullName, /* 123 */ - TclGetCurrentNamespace_, /* 124 */ - TclGetGlobalNamespace_, /* 125 */ + 0, /* 121 */ + 0, /* 122 */ + 0, /* 123 */ + 0, /* 124 */ + 0, /* 125 */ Tcl_GetVariableFullName, /* 126 */ - TclImport, /* 127 */ + 0, /* 127 */ Tcl_PopCallFrame, /* 128 */ Tcl_PushCallFrame, /* 129 */ Tcl_RemoveInterpResolvers, /* 130 */ Tcl_SetNamespaceResolvers, /* 131 */ - TclpHasSockets, /* 132 */ - TclpGetDate, /* 133 */ + 0, /* 132 */ + 0, /* 133 */ 0, /* 134 */ 0, /* 135 */ 0, /* 136 */ @@ -1026,8 +560,8 @@ static const TclIntStubs tclIntStubs = { 0, /* 155 */ TclRegError, /* 156 */ TclVarTraceExists, /* 157 */ - TclSetStartupScriptFileName, /* 158 */ - TclGetStartupScriptFileName, /* 159 */ + 0, /* 158 */ + 0, /* 159 */ 0, /* 160 */ TclChannelTransform, /* 161 */ TclChannelEventScriptInvoker, /* 162 */ @@ -1035,8 +569,8 @@ static const TclIntStubs tclIntStubs = { TclExpandCodeArray, /* 164 */ TclpSetInitialEncodings, /* 165 */ TclListObjSetElement, /* 166 */ - TclSetStartupScriptPath, /* 167 */ - TclGetStartupScriptPath, /* 168 */ + 0, /* 167 */ + 0, /* 168 */ TclpUtfNcmp2, /* 169 */ TclCheckInterpTraces, /* 170 */ TclCheckExecutionTraces, /* 171 */ @@ -1046,12 +580,12 @@ static const TclIntStubs tclIntStubs = { TclCallVarTraces, /* 175 */ TclCleanupVar, /* 176 */ TclVarErrMsg, /* 177 */ - TclSetStartupScript, /* 178 */ - TclGetStartupScript, /* 179 */ + 0, /* 178 */ + 0, /* 179 */ 0, /* 180 */ 0, /* 181 */ - TclpLocaltime, /* 182 */ - TclpGmtime, /* 183 */ + 0, /* 182 */ + 0, /* 183 */ 0, /* 184 */ 0, /* 185 */ 0, /* 186 */ @@ -1104,7 +638,7 @@ static const TclIntStubs tclIntStubs = { TclGetSrcInfoForPc, /* 233 */ TclVarHashCreateVar, /* 234 */ TclInitVarHashTable, /* 235 */ - TclBackgroundException, /* 236 */ + 0, /* 236 */ TclResetCancellation, /* 237 */ TclNRInterpProc, /* 238 */ TclNRInterpProcCore, /* 239 */ @@ -1135,121 +669,46 @@ static const TclIntStubs tclIntStubs = { static const TclIntPlatStubs tclIntPlatStubs = { TCL_STUB_MAGIC, 0, -#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */ - TclGetAndDetachPids, /* 0 */ + 0, /* 0 */ TclpCloseFile, /* 1 */ TclpCreateCommandChannel, /* 2 */ TclpCreatePipe, /* 3 */ - TclpCreateProcess, /* 4 */ - TclUnixWaitForFile_, /* 5 */ - TclpMakeFile, /* 6 */ - TclpOpenFile, /* 7 */ - TclUnixWaitForFile, /* 8 */ - TclpCreateTempFile, /* 9 */ - TclpReaddir, /* 10 */ - TclpLocaltime_unix, /* 11 */ - TclpGmtime_unix, /* 12 */ - TclpInetNtoa, /* 13 */ - TclUnixCopyFile, /* 14 */ - TclMacOSXGetFileAttribute, /* 15 */ - TclMacOSXSetFileAttribute, /* 16 */ - TclMacOSXCopyFileAttributes, /* 17 */ - TclMacOSXMatchType, /* 18 */ - TclMacOSXNotifierAddRunLoopMode, /* 19 */ - 0, /* 20 */ - 0, /* 21 */ - TclpCreateTempFile_, /* 22 */ - 0, /* 23 */ - 0, /* 24 */ - 0, /* 25 */ - 0, /* 26 */ - 0, /* 27 */ - 0, /* 28 */ - TclWinCPUID, /* 29 */ - TclUnixOpenTemporaryFile, /* 30 */ -#endif /* UNIX */ -#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ - TclWinConvertError, /* 0 */ - TclWinConvertWSAError, /* 1 */ - TclWinGetServByName, /* 2 */ - TclWinGetSockOpt, /* 3 */ TclWinGetTclInstance, /* 4 */ TclUnixWaitForFile, /* 5 */ - TclWinNToHS, /* 6 */ - TclWinSetSockOpt, /* 7 */ + TclpMakeFile, /* 6 */ + TclpOpenFile, /* 7 */ TclpGetPid, /* 8 */ - TclWinGetPlatformId, /* 9 */ - TclpReaddir, /* 10 */ + TclpCreateTempFile, /* 9 */ + 0, /* 10 */ TclGetAndDetachPids, /* 11 */ - TclpCloseFile, /* 12 */ - TclpCreateCommandChannel, /* 13 */ - TclpCreatePipe, /* 14 */ + 0, /* 12 */ + 0, /* 13 */ + 0, /* 14 */ TclpCreateProcess, /* 15 */ TclpIsAtty, /* 16 */ TclUnixCopyFile, /* 17 */ - TclpMakeFile, /* 18 */ - TclpOpenFile, /* 19 */ + 0, /* 18 */ + 0, /* 19 */ TclWinAddProcess, /* 20 */ - TclpInetNtoa, /* 21 */ - TclpCreateTempFile, /* 22 */ - 0, /* 23 */ - TclWinNoBackslash, /* 24 */ - 0, /* 25 */ - TclWinSetInterfaces, /* 26 */ - TclWinFlushDirtyChannels, /* 27 */ - TclWinResetInterfaces, /* 28 */ - TclWinCPUID, /* 29 */ - TclUnixOpenTemporaryFile, /* 30 */ -#endif /* WIN */ -#ifdef MAC_OSX_TCL /* MACOSX */ - TclGetAndDetachPids, /* 0 */ - TclpCloseFile, /* 1 */ - TclpCreateCommandChannel, /* 2 */ - TclpCreatePipe, /* 3 */ - TclpCreateProcess, /* 4 */ - TclUnixWaitForFile_, /* 5 */ - TclpMakeFile, /* 6 */ - TclpOpenFile, /* 7 */ - TclUnixWaitForFile, /* 8 */ - TclpCreateTempFile, /* 9 */ - TclpReaddir, /* 10 */ - TclpLocaltime_unix, /* 11 */ - TclpGmtime_unix, /* 12 */ - TclpInetNtoa, /* 13 */ - TclUnixCopyFile, /* 14 */ - TclMacOSXGetFileAttribute, /* 15 */ - TclMacOSXSetFileAttribute, /* 16 */ - TclMacOSXCopyFileAttributes, /* 17 */ - TclMacOSXMatchType, /* 18 */ - TclMacOSXNotifierAddRunLoopMode, /* 19 */ - 0, /* 20 */ 0, /* 21 */ - TclpCreateTempFile_, /* 22 */ + 0, /* 22 */ 0, /* 23 */ - 0, /* 24 */ + TclWinNoBackslash, /* 24 */ 0, /* 25 */ 0, /* 26 */ - 0, /* 27 */ + TclWinFlushDirtyChannels, /* 27 */ 0, /* 28 */ TclWinCPUID, /* 29 */ TclUnixOpenTemporaryFile, /* 30 */ -#endif /* MACOSX */ }; static const TclPlatStubs tclPlatStubs = { TCL_STUB_MAGIC, 0, -#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ - Tcl_WinUtfToTChar, /* 0 */ - Tcl_WinTCharToUtf, /* 1 */ - 0, /* 2 */ - Tcl_WinConvertError, /* 3 */ -#endif /* WIN */ -#ifdef MAC_OSX_TCL /* MACOSX */ - Tcl_MacOSXOpenBundleResources, /* 0 */ + 0, /* 0 */ Tcl_MacOSXOpenVersionedBundleResources, /* 1 */ Tcl_MacOSXNotifierAddRunLoopMode, /* 2 */ -#endif /* MACOSX */ + Tcl_WinConvertError, /* 3 */ }; const TclTomMathStubs tclTomMathStubs = { @@ -1272,7 +731,7 @@ const TclTomMathStubs tclTomMathStubs = { TclBN_mp_div_d, /* 14 */ TclBN_mp_div_2, /* 15 */ TclBN_mp_div_2d, /* 16 */ - TclBN_mp_div_3, /* 17 */ + 0, /* 17 */ TclBN_mp_exch, /* 18 */ TclBN_mp_expt_u32, /* 19 */ TclBN_mp_grow, /* 20 */ @@ -1294,47 +753,47 @@ const TclTomMathStubs tclTomMathStubs = { TclBN_mp_read_radix, /* 36 */ TclBN_mp_rshd, /* 37 */ TclBN_mp_shrink, /* 38 */ - TclBN_mp_set, /* 39 */ - TclBN_mp_sqr, /* 40 */ + 0, /* 39 */ + 0, /* 40 */ TclBN_mp_sqrt, /* 41 */ TclBN_mp_sub, /* 42 */ TclBN_mp_sub_d, /* 43 */ - TclBN_mp_to_unsigned_bin, /* 44 */ - TclBN_mp_to_unsigned_bin_n, /* 45 */ - TclBN_mp_toradix_n, /* 46 */ + 0, /* 44 */ + 0, /* 45 */ + 0, /* 46 */ TclBN_mp_ubin_size, /* 47 */ TclBN_mp_xor, /* 48 */ TclBN_mp_zero, /* 49 */ - TclBN_reverse, /* 50 */ - TclBN_s_mp_mul_digs_fast, /* 51 */ - TclBN_s_mp_sqr_fast, /* 52 */ - TclBN_mp_karatsuba_mul, /* 53 */ - TclBN_mp_karatsuba_sqr, /* 54 */ - TclBN_mp_toom_mul, /* 55 */ - TclBN_mp_toom_sqr, /* 56 */ - TclBN_s_mp_add, /* 57 */ - TclBN_s_mp_mul_digs, /* 58 */ - TclBN_s_mp_sqr, /* 59 */ - TclBN_s_mp_sub, /* 60 */ - TclBN_mp_init_ul, /* 61 */ - TclBN_mp_set_ul, /* 62 */ + 0, /* 50 */ + 0, /* 51 */ + 0, /* 52 */ + 0, /* 53 */ + 0, /* 54 */ + 0, /* 55 */ + 0, /* 56 */ + 0, /* 57 */ + 0, /* 58 */ + 0, /* 59 */ + 0, /* 60 */ + 0, /* 61 */ + 0, /* 62 */ TclBN_mp_cnt_lsb, /* 63 */ - TclBN_mp_init_l, /* 64 */ + 0, /* 64 */ TclBN_mp_init_i64, /* 65 */ TclBN_mp_init_u64, /* 66 */ - TclBN_mp_expt_d_ex, /* 67 */ + 0, /* 67 */ TclBN_mp_set_u64, /* 68 */ TclBN_mp_get_mag_u64, /* 69 */ TclBN_mp_set_i64, /* 70 */ TclBN_mp_unpack, /* 71 */ TclBN_mp_pack, /* 72 */ - TclBN_mp_tc_and, /* 73 */ - TclBN_mp_tc_or, /* 74 */ - TclBN_mp_tc_xor, /* 75 */ + 0, /* 73 */ + 0, /* 74 */ + 0, /* 75 */ TclBN_mp_signed_rsh, /* 76 */ TclBN_mp_pack_count, /* 77 */ TclBN_mp_to_ubin, /* 78 */ - TclBN_mp_div_ld, /* 79 */ + 0, /* 79 */ TclBN_mp_to_radix, /* 80 */ }; @@ -1356,24 +815,8 @@ const TclStubs tclStubs = { Tcl_DbCkalloc, /* 6 */ Tcl_DbCkfree, /* 7 */ Tcl_DbCkrealloc, /* 8 */ -#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */ - Tcl_CreateFileHandler, /* 9 */ -#endif /* UNIX */ -#if defined(_WIN32) /* WIN */ - 0, /* 9 */ -#endif /* WIN */ -#ifdef MAC_OSX_TCL /* MACOSX */ Tcl_CreateFileHandler, /* 9 */ -#endif /* MACOSX */ -#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */ Tcl_DeleteFileHandler, /* 10 */ -#endif /* UNIX */ -#if defined(_WIN32) /* WIN */ - 0, /* 10 */ -#endif /* WIN */ -#ifdef MAC_OSX_TCL /* MACOSX */ - Tcl_DeleteFileHandler, /* 10 */ -#endif /* MACOSX */ Tcl_SetTimer, /* 11 */ Tcl_Sleep, /* 12 */ Tcl_WaitForEvent, /* 13 */ @@ -1385,52 +828,52 @@ const TclStubs tclStubs = { Tcl_DbDecrRefCount, /* 19 */ Tcl_DbIncrRefCount, /* 20 */ Tcl_DbIsShared, /* 21 */ - Tcl_DbNewBooleanObj, /* 22 */ + 0, /* 22 */ Tcl_DbNewByteArrayObj, /* 23 */ Tcl_DbNewDoubleObj, /* 24 */ Tcl_DbNewListObj, /* 25 */ - Tcl_DbNewLongObj, /* 26 */ + 0, /* 26 */ Tcl_DbNewObj, /* 27 */ Tcl_DbNewStringObj, /* 28 */ Tcl_DuplicateObj, /* 29 */ TclFreeObj, /* 30 */ Tcl_GetBoolean, /* 31 */ Tcl_GetBooleanFromObj, /* 32 */ - Tcl_GetByteArrayFromObj, /* 33 */ + TclGetByteArrayFromObj, /* 33 */ Tcl_GetDouble, /* 34 */ Tcl_GetDoubleFromObj, /* 35 */ - Tcl_GetIndexFromObj, /* 36 */ + 0, /* 36 */ Tcl_GetInt, /* 37 */ Tcl_GetIntFromObj, /* 38 */ Tcl_GetLongFromObj, /* 39 */ Tcl_GetObjType, /* 40 */ - Tcl_GetStringFromObj, /* 41 */ + TclGetStringFromObj, /* 41 */ Tcl_InvalidateStringRep, /* 42 */ Tcl_ListObjAppendList, /* 43 */ Tcl_ListObjAppendElement, /* 44 */ - Tcl_ListObjGetElements, /* 45 */ + TclListObjGetElements, /* 45 */ Tcl_ListObjIndex, /* 46 */ - Tcl_ListObjLength, /* 47 */ + TclListObjLength, /* 47 */ Tcl_ListObjReplace, /* 48 */ - Tcl_NewBooleanObj, /* 49 */ + 0, /* 49 */ Tcl_NewByteArrayObj, /* 50 */ Tcl_NewDoubleObj, /* 51 */ - Tcl_NewIntObj, /* 52 */ + 0, /* 52 */ Tcl_NewListObj, /* 53 */ - Tcl_NewLongObj, /* 54 */ + 0, /* 54 */ Tcl_NewObj, /* 55 */ Tcl_NewStringObj, /* 56 */ - Tcl_SetBooleanObj, /* 57 */ + 0, /* 57 */ Tcl_SetByteArrayLength, /* 58 */ Tcl_SetByteArrayObj, /* 59 */ Tcl_SetDoubleObj, /* 60 */ - Tcl_SetIntObj, /* 61 */ + 0, /* 61 */ Tcl_SetListObj, /* 62 */ - Tcl_SetLongObj, /* 63 */ + 0, /* 63 */ Tcl_SetObjLength, /* 64 */ Tcl_SetStringObj, /* 65 */ - Tcl_AddErrorInfo, /* 66 */ - Tcl_AddObjErrorInfo, /* 67 */ + 0, /* 66 */ + 0, /* 67 */ Tcl_AllowExceptions, /* 68 */ Tcl_AppendElement, /* 69 */ Tcl_AppendResult, /* 70 */ @@ -1439,8 +882,8 @@ const TclStubs tclStubs = { Tcl_AsyncInvoke, /* 73 */ Tcl_AsyncMark, /* 74 */ Tcl_AsyncReady, /* 75 */ - Tcl_BackgroundError, /* 76 */ - Tcl_Backslash, /* 77 */ + 0, /* 76 */ + 0, /* 77 */ Tcl_BadChannelOption, /* 78 */ Tcl_CallWhenDeleted, /* 79 */ Tcl_CancelIdleCall, /* 80 */ @@ -1458,7 +901,7 @@ const TclStubs tclStubs = { Tcl_CreateEventSource, /* 92 */ Tcl_CreateExitHandler, /* 93 */ Tcl_CreateInterp, /* 94 */ - Tcl_CreateMathFunc, /* 95 */ + 0, /* 95 */ Tcl_CreateObjCommand, /* 96 */ Tcl_CreateChild, /* 97 */ Tcl_CreateTimerHandler, /* 98 */ @@ -1492,9 +935,9 @@ const TclStubs tclStubs = { Tcl_Eof, /* 126 */ Tcl_ErrnoId, /* 127 */ Tcl_ErrnoMsg, /* 128 */ - Tcl_Eval, /* 129 */ + 0, /* 129 */ Tcl_EvalFile, /* 130 */ - Tcl_EvalObj, /* 131 */ + 0, /* 131 */ Tcl_EventuallyFree, /* 132 */ Tcl_Exit, /* 133 */ Tcl_ExposeCommand, /* 134 */ @@ -1507,10 +950,10 @@ const TclStubs tclStubs = { Tcl_ExprObj, /* 141 */ Tcl_ExprString, /* 142 */ Tcl_Finalize, /* 143 */ - Tcl_FindExecutable, /* 144 */ + 0, /* 144 */ Tcl_FirstHashEntry, /* 145 */ Tcl_Flush, /* 146 */ - Tcl_FreeResult, /* 147 */ + 0, /* 147 */ Tcl_GetAlias, /* 148 */ Tcl_GetAliasObj, /* 149 */ Tcl_GetAssocData, /* 150 */ @@ -1530,26 +973,18 @@ const TclStubs tclStubs = { Tcl_GetParent, /* 164 */ Tcl_GetNameOfExecutable, /* 165 */ Tcl_GetObjResult, /* 166 */ -#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */ - Tcl_GetOpenFile, /* 167 */ -#endif /* UNIX */ -#if defined(_WIN32) /* WIN */ - 0, /* 167 */ -#endif /* WIN */ -#ifdef MAC_OSX_TCL /* MACOSX */ Tcl_GetOpenFile, /* 167 */ -#endif /* MACOSX */ Tcl_GetPathType, /* 168 */ Tcl_Gets, /* 169 */ Tcl_GetsObj, /* 170 */ Tcl_GetServiceMode, /* 171 */ Tcl_GetChild, /* 172 */ Tcl_GetStdChannel, /* 173 */ - Tcl_GetStringResult, /* 174 */ - Tcl_GetVar, /* 175 */ + 0, /* 174 */ + 0, /* 175 */ Tcl_GetVar2, /* 176 */ - Tcl_GlobalEval, /* 177 */ - Tcl_GlobalEvalObj, /* 178 */ + 0, /* 177 */ + 0, /* 178 */ Tcl_HideCommand, /* 179 */ Tcl_Init, /* 180 */ Tcl_InitHashTable, /* 181 */ @@ -1561,7 +996,7 @@ const TclStubs tclStubs = { Tcl_LinkVar, /* 187 */ 0, /* 188 */ Tcl_MakeFileChannel, /* 189 */ - Tcl_MakeSafe, /* 190 */ + 0, /* 190 */ Tcl_MakeTcpClientChannel, /* 191 */ Tcl_Merge, /* 192 */ Tcl_NextHashEntry, /* 193 */ @@ -1591,7 +1026,7 @@ const TclStubs tclStubs = { Tcl_ResetResult, /* 217 */ Tcl_ScanElement, /* 218 */ Tcl_ScanCountedElement, /* 219 */ - Tcl_SeekOld, /* 220 */ + 0, /* 220 */ Tcl_ServiceAll, /* 221 */ Tcl_ServiceEvent, /* 222 */ Tcl_SetAssocData, /* 223 */ @@ -1601,55 +1036,55 @@ const TclStubs tclStubs = { Tcl_SetErrno, /* 227 */ Tcl_SetErrorCode, /* 228 */ Tcl_SetMaxBlockTime, /* 229 */ - Tcl_SetPanicProc, /* 230 */ + 0, /* 230 */ Tcl_SetRecursionLimit, /* 231 */ - Tcl_SetResult, /* 232 */ + 0, /* 232 */ Tcl_SetServiceMode, /* 233 */ Tcl_SetObjErrorCode, /* 234 */ Tcl_SetObjResult, /* 235 */ Tcl_SetStdChannel, /* 236 */ - Tcl_SetVar, /* 237 */ + 0, /* 237 */ Tcl_SetVar2, /* 238 */ Tcl_SignalId, /* 239 */ Tcl_SignalMsg, /* 240 */ Tcl_SourceRCFile, /* 241 */ - Tcl_SplitList, /* 242 */ - Tcl_SplitPath, /* 243 */ - Tcl_StaticLibrary, /* 244 */ - Tcl_StringMatch, /* 245 */ - Tcl_TellOld, /* 246 */ - Tcl_TraceVar, /* 247 */ + TclSplitList, /* 242 */ + TclSplitPath, /* 243 */ + 0, /* 244 */ + 0, /* 245 */ + 0, /* 246 */ + 0, /* 247 */ Tcl_TraceVar2, /* 248 */ Tcl_TranslateFileName, /* 249 */ Tcl_Ungets, /* 250 */ Tcl_UnlinkVar, /* 251 */ Tcl_UnregisterChannel, /* 252 */ - Tcl_UnsetVar, /* 253 */ + 0, /* 253 */ Tcl_UnsetVar2, /* 254 */ - Tcl_UntraceVar, /* 255 */ + 0, /* 255 */ Tcl_UntraceVar2, /* 256 */ Tcl_UpdateLinkedVar, /* 257 */ - Tcl_UpVar, /* 258 */ + 0, /* 258 */ Tcl_UpVar2, /* 259 */ Tcl_VarEval, /* 260 */ - Tcl_VarTraceInfo, /* 261 */ + 0, /* 261 */ Tcl_VarTraceInfo2, /* 262 */ Tcl_Write, /* 263 */ Tcl_WrongNumArgs, /* 264 */ Tcl_DumpActiveMemory, /* 265 */ Tcl_ValidateAllMemory, /* 266 */ - Tcl_AppendResultVA, /* 267 */ - Tcl_AppendStringsToObjVA, /* 268 */ + 0, /* 267 */ + 0, /* 268 */ Tcl_HashStats, /* 269 */ Tcl_ParseVar, /* 270 */ - Tcl_PkgPresent, /* 271 */ + 0, /* 271 */ Tcl_PkgPresentEx, /* 272 */ - Tcl_PkgProvide, /* 273 */ - Tcl_PkgRequire, /* 274 */ - Tcl_SetErrorCodeVA, /* 275 */ - Tcl_VarEvalVA, /* 276 */ + 0, /* 273 */ + 0, /* 274 */ + 0, /* 275 */ + 0, /* 276 */ Tcl_WaitPid, /* 277 */ - Tcl_PanicVA, /* 278 */ + 0, /* 278 */ Tcl_GetVersion, /* 279 */ Tcl_InitMemory, /* 280 */ Tcl_StackChannel, /* 281 */ @@ -1661,7 +1096,7 @@ const TclStubs tclStubs = { Tcl_CreateEncoding, /* 287 */ Tcl_CreateThreadExitHandler, /* 288 */ Tcl_DeleteThreadExitHandler, /* 289 */ - Tcl_DiscardResult, /* 290 */ + 0, /* 290 */ Tcl_EvalEx, /* 291 */ Tcl_EvalObjv, /* 292 */ Tcl_EvalObjEx, /* 293 */ @@ -1683,10 +1118,10 @@ const TclStubs tclStubs = { Tcl_MutexUnlock, /* 309 */ Tcl_ConditionNotify, /* 310 */ Tcl_ConditionWait, /* 311 */ - Tcl_NumUtfChars, /* 312 */ + TclNumUtfChars, /* 312 */ Tcl_ReadChars, /* 313 */ - Tcl_RestoreResult, /* 314 */ - Tcl_SaveResult, /* 315 */ + 0, /* 314 */ + 0, /* 315 */ Tcl_SetSystemEncoding, /* 316 */ Tcl_SetVar2Ex, /* 317 */ Tcl_ThreadAlert, /* 318 */ @@ -1696,7 +1131,7 @@ const TclStubs tclStubs = { Tcl_UniCharToTitle, /* 322 */ Tcl_UniCharToUpper, /* 323 */ Tcl_UniCharToUtf, /* 324 */ - Tcl_UtfAtIndex, /* 325 */ + TclUtfAtIndex, /* 325 */ TclUtfCharComplete, /* 326 */ Tcl_UtfBackslash, /* 327 */ Tcl_UtfFindFirst, /* 328 */ @@ -1712,8 +1147,8 @@ const TclStubs tclStubs = { Tcl_WriteChars, /* 338 */ Tcl_WriteObj, /* 339 */ Tcl_GetString, /* 340 */ - Tcl_GetDefaultEncodingDir, /* 341 */ - Tcl_SetDefaultEncodingDir, /* 342 */ + 0, /* 341 */ + 0, /* 342 */ Tcl_AlertNotifier, /* 343 */ Tcl_ServiceModeHook, /* 344 */ Tcl_UniCharIsAlnum, /* 345 */ @@ -1724,11 +1159,11 @@ const TclStubs tclStubs = { Tcl_UniCharIsUpper, /* 350 */ Tcl_UniCharIsWordChar, /* 351 */ Tcl_Char16Len, /* 352 */ - Tcl_UniCharNcmp, /* 353 */ + 0, /* 353 */ Tcl_Char16ToUtfDString, /* 354 */ Tcl_UtfToChar16DString, /* 355 */ Tcl_GetRegExpFromObj, /* 356 */ - Tcl_EvalTokens, /* 357 */ + 0, /* 357 */ Tcl_FreeParse, /* 358 */ Tcl_LogCommandInfo, /* 359 */ Tcl_ParseBraces, /* 360 */ @@ -1751,10 +1186,10 @@ const TclStubs tclStubs = { Tcl_RegExpGetInfo, /* 377 */ Tcl_NewUnicodeObj, /* 378 */ Tcl_SetUnicodeObj, /* 379 */ - Tcl_GetCharLength, /* 380 */ - Tcl_GetUniChar, /* 381 */ - Tcl_GetUnicode, /* 382 */ - Tcl_GetRange, /* 383 */ + TclGetCharLength, /* 380 */ + TclGetUniChar, /* 381 */ + 0, /* 382 */ + TclGetRange, /* 383 */ Tcl_AppendUnicodeToObj, /* 384 */ Tcl_RegExpMatchObj, /* 385 */ Tcl_SetNotifier, /* 386 */ @@ -1772,11 +1207,11 @@ const TclStubs tclStubs = { Tcl_ChannelName, /* 398 */ Tcl_ChannelVersion, /* 399 */ Tcl_ChannelBlockModeProc, /* 400 */ - Tcl_ChannelCloseProc, /* 401 */ + 0, /* 401 */ Tcl_ChannelClose2Proc, /* 402 */ Tcl_ChannelInputProc, /* 403 */ Tcl_ChannelOutputProc, /* 404 */ - Tcl_ChannelSeekProc, /* 405 */ + 0, /* 405 */ Tcl_ChannelSetOptionProc, /* 406 */ Tcl_ChannelGetOptionProc, /* 407 */ Tcl_ChannelWatchProc, /* 408 */ @@ -1790,10 +1225,10 @@ const TclStubs tclStubs = { Tcl_SpliceChannel, /* 416 */ Tcl_ClearChannelHandlers, /* 417 */ Tcl_IsChannelExisting, /* 418 */ - Tcl_UniCharNcasecmp, /* 419 */ - Tcl_UniCharCaseMatch, /* 420 */ - Tcl_FindHashEntry, /* 421 */ - Tcl_CreateHashEntry, /* 422 */ + 0, /* 419 */ + 0, /* 420 */ + 0, /* 421 */ + 0, /* 422 */ Tcl_InitCustomHashTable, /* 423 */ Tcl_InitObjHashTable, /* 424 */ Tcl_CommandTraceInfo, /* 425 */ @@ -1805,9 +1240,9 @@ const TclStubs tclStubs = { Tcl_AttemptDbCkrealloc, /* 431 */ Tcl_AttemptSetObjLength, /* 432 */ Tcl_GetChannelThread, /* 433 */ - Tcl_GetUnicodeFromObj, /* 434 */ - Tcl_GetMathFuncInfo, /* 435 */ - Tcl_ListMathFuncs, /* 436 */ + TclGetUnicodeFromObj, /* 434 */ + 0, /* 435 */ + 0, /* 436 */ Tcl_SubstObj, /* 437 */ Tcl_DetachChannel, /* 438 */ Tcl_IsStandardChannel, /* 439 */ @@ -1832,7 +1267,7 @@ const TclStubs tclStubs = { Tcl_FSChdir, /* 458 */ Tcl_FSConvertToPathType, /* 459 */ Tcl_FSJoinPath, /* 460 */ - Tcl_FSSplitPath, /* 461 */ + TclFSSplitPath, /* 461 */ Tcl_FSEqualPaths, /* 462 */ Tcl_FSGetNormalizedPath, /* 463 */ Tcl_FSJoinToPath, /* 464 */ @@ -1868,7 +1303,7 @@ const TclStubs tclStubs = { Tcl_DictObjPut, /* 494 */ Tcl_DictObjGet, /* 495 */ Tcl_DictObjRemove, /* 496 */ - Tcl_DictObjSize, /* 497 */ + TclDictObjSize, /* 497 */ Tcl_DictObjFirst, /* 498 */ Tcl_DictObjNext, /* 499 */ Tcl_DictObjDone, /* 500 */ @@ -1890,7 +1325,7 @@ const TclStubs tclStubs = { Tcl_GetCommandFromObj, /* 516 */ Tcl_GetCommandFullName, /* 517 */ Tcl_FSEvalFileEx, /* 518 */ - Tcl_SetExitProc, /* 519 */ + 0, /* 519 */ Tcl_LimitAddHandler, /* 520 */ Tcl_LimitRemoveHandler, /* 521 */ Tcl_LimitReady, /* 522 */ @@ -1975,7 +1410,7 @@ const TclStubs tclStubs = { Tcl_GetBlockSizeFromStat, /* 601 */ Tcl_SetEnsembleParameterList, /* 602 */ Tcl_GetEnsembleParameterList, /* 603 */ - Tcl_ParseArgsObjv, /* 604 */ + TclParseArgsObjv, /* 604 */ Tcl_GetErrorLine, /* 605 */ Tcl_SetErrorLine, /* 606 */ Tcl_TransferResult, /* 607 */ @@ -2022,9 +1457,9 @@ const TclStubs tclStubs = { Tcl_UtfToUniCharDString, /* 648 */ TclGetBytesFromObj, /* 649 */ Tcl_GetBytesFromObj, /* 650 */ - TclGetStringFromObj, /* 651 */ - TclGetUnicodeFromObj, /* 652 */ - TclGetByteArrayFromObj, /* 653 */ + Tcl_GetStringFromObj, /* 651 */ + Tcl_GetUnicodeFromObj, /* 652 */ + Tcl_GetByteArrayFromObj, /* 653 */ Tcl_UtfCharComplete, /* 654 */ Tcl_UtfNext, /* 655 */ Tcl_UtfPrev, /* 656 */ @@ -2032,19 +1467,19 @@ const TclStubs tclStubs = { Tcl_ExternalToUtfDStringEx, /* 658 */ Tcl_UtfToExternalDStringEx, /* 659 */ Tcl_AsyncMarkFromSignal, /* 660 */ - TclListObjGetElements, /* 661 */ - TclListObjLength, /* 662 */ - TclDictObjSize, /* 663 */ - TclSplitList, /* 664 */ - TclSplitPath, /* 665 */ - TclFSSplitPath, /* 666 */ - TclParseArgsObjv, /* 667 */ + Tcl_ListObjGetElements, /* 661 */ + Tcl_ListObjLength, /* 662 */ + Tcl_DictObjSize, /* 663 */ + Tcl_SplitList, /* 664 */ + Tcl_SplitPath, /* 665 */ + Tcl_FSSplitPath, /* 666 */ + Tcl_ParseArgsObjv, /* 667 */ Tcl_UniCharLen, /* 668 */ - TclNumUtfChars, /* 669 */ - TclGetCharLength, /* 670 */ - TclUtfAtIndex, /* 671 */ - TclGetRange, /* 672 */ - TclGetUniChar, /* 673 */ + Tcl_NumUtfChars, /* 669 */ + Tcl_GetCharLength, /* 670 */ + Tcl_UtfAtIndex, /* 671 */ + Tcl_GetRange, /* 672 */ + Tcl_GetUniChar, /* 673 */ Tcl_GetBool, /* 674 */ Tcl_GetBoolFromObj, /* 675 */ Tcl_CreateObjCommand2, /* 676 */ diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c index f06b2d1..55001cf 100644 --- a/generic/tclStubLib.c +++ b/generic/tclStubLib.c @@ -71,8 +71,8 @@ Tcl_InitStubs( */ if (!stubsPtr || (stubsPtr->magic != (((exact&0xFF00) >= 0x900) ? magic : TCL_STUB_MAGIC))) { - iPtr->result = (char *)"interpreter uses an incompatible stubs mechanism"; - iPtr->freeProc = 0; /* TCL_STATIC */ + iPtr->legacyResult = "interpreter uses an incompatible stubs mechanism"; + iPtr->legacyFreeProc = 0; /* TCL_STATIC */ return NULL; } diff --git a/generic/tclStubLibTbl.c b/generic/tclStubLibTbl.c index 0391502..ad34494 100644 --- a/generic/tclStubLibTbl.c +++ b/generic/tclStubLibTbl.c @@ -13,6 +13,8 @@ #include "tclInt.h" +MODULE_SCOPE void *tclStubsHandle; + /* *---------------------------------------------------------------------- * @@ -32,18 +34,26 @@ MODULE_SCOPE const char * TclInitStubTable( const char *version) /* points to the version field of a - TclStubInfoType structure variable. */ + structure variable. */ { - tclStubsPtr = ((const TclStubInfoType *) version)->stubs; + if (version) { + if (tclStubsHandle == NULL) { + /* This can only happen with -DBUILD_STATIC, so simulate + * that the loading of Tcl succeeded, although we didn't + * actually load it dynamically */ + tclStubsHandle = (void *)1; + } + tclStubsPtr = ((const TclStubs **) version)[-1]; - if (tclStubsPtr->hooks) { - tclPlatStubsPtr = tclStubsPtr->hooks->tclPlatStubs; - tclIntStubsPtr = tclStubsPtr->hooks->tclIntStubs; - tclIntPlatStubsPtr = tclStubsPtr->hooks->tclIntPlatStubs; - } else { - tclPlatStubsPtr = NULL; - tclIntStubsPtr = NULL; - tclIntPlatStubsPtr = NULL; + if (tclStubsPtr->hooks) { + tclPlatStubsPtr = tclStubsPtr->hooks->tclPlatStubs; + tclIntStubsPtr = tclStubsPtr->hooks->tclIntStubs; + tclIntPlatStubsPtr = tclStubsPtr->hooks->tclIntPlatStubs; + } else { + tclPlatStubsPtr = NULL; + tclIntStubsPtr = NULL; + tclIntPlatStubsPtr = NULL; + } } return version; diff --git a/generic/tclTest.c b/generic/tclTest.c index c5eb6eb..d8f004a 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -16,17 +16,9 @@ */ #undef STATIC_BUILD -#undef BUILD_tcl #ifndef USE_TCL_STUBS # define USE_TCL_STUBS #endif -#undef TCL_UTF_MAX -#ifdef TCL_NO_DEPRECATED -# define TCL_UTF_MAX 4 -#else -# define TCL_NO_DEPRECATED -# define TCL_UTF_MAX 3 -#endif #include "tclInt.h" #ifdef TCL_WITH_EXTERNAL_TOMMATH # include "tommath.h" @@ -143,15 +135,6 @@ typedef struct { } TclEncoding; /* - * The counter below is used to determine if the TestsaveresultFree routine - * was called for a result. - */ - -#ifndef TCL_NO_DEPRECATED -static int freeCount; -#endif /* TCL_NO_DEPRECATED */ - -/* * Boolean flag used by the "testsetmainloop" and "testexitmainloop" commands. */ @@ -180,15 +163,6 @@ typedef struct TestChannel { static TestChannel *firstDetached; -#ifdef __GNUC__ -/* - * The rest of this file shouldn't warn about deprecated functions; they're - * there because we intend them to be so and know that this file is OK to - * touch those fields. - */ -#pragma GCC diagnostic ignored "-Wdeprecated-declarations" -#endif - /* * Forward declarations for procedures defined later in this file: */ @@ -241,7 +215,7 @@ static int ObjTraceProc(void *clientData, Tcl_Obj *const objv[]); static void ObjTraceDeleteProc(void *clientData); static void PrintParse(Tcl_Interp *interp, Tcl_Parse *parsePtr); -static void SpecialFree(char *blockPtr); +static void SpecialFree(void *blockPtr); static int StaticInitProc(Tcl_Interp *interp); static Tcl_CmdProc TestasyncCmd; static Tcl_ObjCmdProc TestbumpinterpepochObjCmd; @@ -249,7 +223,6 @@ static Tcl_ObjCmdProc TestbytestringObjCmd; static Tcl_ObjCmdProc TestsetbytearraylengthObjCmd; static Tcl_ObjCmdProc TestpurebytesobjObjCmd; static Tcl_ObjCmdProc TeststringbytesObjCmd; -static Tcl_ObjCmdProc Testutf16stringObjCmd; static Tcl_CmdProc TestcmdinfoCmd; static Tcl_CmdProc TestcmdtokenCmd; static Tcl_CmdProc TestcmdtraceCmd; @@ -301,10 +274,6 @@ static Tcl_ObjCmdProc TestregexpObjCmd; static Tcl_ObjCmdProc TestreturnObjCmd; static void TestregexpXflags(const char *string, size_t length, int *cflagsPtr, int *eflagsPtr); -#ifndef TCL_NO_DEPRECATED -static Tcl_ObjCmdProc TestsaveresultCmd; -static void TestsaveresultFree(char *blockPtr); -#endif /* TCL_NO_DEPRECATED */ static Tcl_CmdProc TestsetassocdataCmd; static Tcl_CmdProc TestsetCmd; static Tcl_CmdProc Testset2Cmd; @@ -314,7 +283,7 @@ static Tcl_CmdProc TestsetplatformCmd; static Tcl_CmdProc TeststaticlibraryCmd; static Tcl_CmdProc TesttranslatefilenameCmd; static Tcl_CmdProc TestupvarCmd; -static Tcl_ObjCmdProc TestWrongNumArgsObjCmd; +static Tcl_ObjCmdProc2 TestWrongNumArgsObjCmd; static Tcl_ObjCmdProc TestGetIndexFromObjStructObjCmd; static Tcl_CmdProc TestChannelCmd; static Tcl_CmdProc TestChannelEventCmd; @@ -561,11 +530,11 @@ Tcltest_Init( "-appinitprocclosestderr", "-appinitprocsetrcfile", NULL }; - if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) { + if (Tcl_InitStubs(interp, "8.7-", 0) == NULL) { return TCL_ERROR; } #ifndef TCL_WITH_EXTERNAL_TOMMATH - if (Tcl_TomMath_InitStubs(interp, "8.5-") == NULL) { + if (Tcl_TomMath_InitStubs(interp, "8.7-") == NULL) { return TCL_ERROR; } #endif @@ -598,8 +567,7 @@ Tcltest_Init( Tcl_CreateObjCommand(interp, "testsetbytearraylength", TestsetbytearraylengthObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testbytestring", TestbytestringObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "teststringbytes", TeststringbytesObjCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "testutf16string", Testutf16stringObjCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "testwrongnumargs", TestWrongNumArgsObjCmd, + Tcl_CreateObjCommand2(interp, "testwrongnumargs", TestWrongNumArgsObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testfilesystem", TestFilesystemObjCmd, NULL, NULL); @@ -696,10 +664,6 @@ Tcltest_Init( NULL, NULL); Tcl_CreateObjCommand(interp, "testreturn", TestreturnObjCmd, NULL, NULL); -#ifndef TCL_NO_DEPRECATED - Tcl_CreateObjCommand(interp, "testsaveresult", TestsaveresultCmd, - NULL, NULL); -#endif Tcl_CreateCommand(interp, "testservicemode", TestServiceModeCmd, NULL, NULL); Tcl_CreateCommand(interp, "testsetassocdata", TestsetassocdataCmd, @@ -835,7 +799,7 @@ Tcltest_SafeInit( { Tcl_CmdInfo info; - if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) { + if (Tcl_InitStubs(interp, "8.7-", 0) == NULL) { return TCL_ERROR; } if (Tcl_GetCommandInfo(interp, "::tcl::build-info", &info)) { @@ -891,8 +855,8 @@ TestasyncCmd( if (argc != 3) { goto wrongNumArgs; } - asyncPtr = (TestAsyncHandler *)ckalloc(sizeof(TestAsyncHandler)); - asyncPtr->command = (char *)ckalloc(strlen(argv[2]) + 1); + asyncPtr = (TestAsyncHandler *)Tcl_Alloc(sizeof(TestAsyncHandler)); + asyncPtr->command = (char *)Tcl_Alloc(strlen(argv[2]) + 1); strcpy(asyncPtr->command, argv[2]); Tcl_MutexLock(&asyncTestMutex); asyncPtr->id = nextId; @@ -910,8 +874,8 @@ TestasyncCmd( asyncPtr = firstHandler; firstHandler = asyncPtr->nextPtr; Tcl_AsyncDelete(asyncPtr->handler); - ckfree(asyncPtr->command); - ckfree(asyncPtr); + Tcl_Free(asyncPtr->command); + Tcl_Free(asyncPtr); } Tcl_MutexUnlock(&asyncTestMutex); return TCL_OK; @@ -934,8 +898,8 @@ TestasyncCmd( prevPtr->nextPtr = asyncPtr->nextPtr; } Tcl_AsyncDelete(asyncPtr->handler); - ckfree(asyncPtr->command); - ckfree(asyncPtr); + Tcl_Free(asyncPtr->command); + Tcl_Free(asyncPtr); break; } Tcl_MutexUnlock(&asyncTestMutex); @@ -1019,7 +983,7 @@ AsyncHandlerProc( TclFormatInt(string, code); listArgv[0] = asyncPtr->command; - listArgv[1] = Tcl_GetString(Tcl_GetObjResult(interp)); + listArgv[1] = Tcl_GetStringResult(interp); listArgv[2] = string; listArgv[3] = NULL; cmd = Tcl_Merge(3, listArgv); @@ -1031,7 +995,7 @@ AsyncHandlerProc( * invoked, it's possible. Better error checking is needed here. */ } - ckfree(cmd); + Tcl_Free(cmd); return code; } @@ -1682,9 +1646,9 @@ TestdelCmd( return TCL_ERROR; } - dPtr = (DelCmd *)ckalloc(sizeof(DelCmd)); + dPtr = (DelCmd *)Tcl_Alloc(sizeof(DelCmd)); dPtr->interp = interp; - dPtr->deleteCmd = (char *)ckalloc(strlen(argv[3]) + 1); + dPtr->deleteCmd = (char *)Tcl_Alloc(strlen(argv[3]) + 1); strcpy(dPtr->deleteCmd, argv[3]); Tcl_CreateCommand(child, argv[2], DelCmdProc, dPtr, @@ -1702,8 +1666,8 @@ DelCmdProc( DelCmd *dPtr = (DelCmd *) clientData; Tcl_AppendResult(interp, dPtr->deleteCmd, NULL); - ckfree(dPtr->deleteCmd); - ckfree(dPtr); + Tcl_Free(dPtr->deleteCmd); + Tcl_Free(dPtr); return TCL_OK; } @@ -1715,8 +1679,8 @@ DelDeleteProc( Tcl_EvalEx(dPtr->interp, dPtr->deleteCmd, TCL_INDEX_NONE, 0); Tcl_ResetResult(dPtr->interp); - ckfree(dPtr->deleteCmd); - ckfree(dPtr); + Tcl_Free(dPtr->deleteCmd); + Tcl_Free(dPtr); } /* @@ -1835,7 +1799,7 @@ TestdoubledigitsObjCmd( } str = TclDoubleDigits(d, ndigits, type, &decpt, &signum, &endPtr); strObj = Tcl_NewStringObj(str, endPtr-str); - ckfree(str); + Tcl_Free(str); retval = Tcl_NewListObj(1, &strObj); Tcl_ListObjAppendElement(NULL, retval, Tcl_NewWideIntObj(decpt)); strObj = Tcl_NewStringObj(signum ? "-" : "+", 1); @@ -1912,11 +1876,11 @@ TestdstringCmd( } else if (strcmp(argv[2], "staticlarge") == 0) { Tcl_AppendResult(interp, "first0 first1 first2 first3 first4 first5 first6 first7 first8 first9\nsecond0 second1 second2 second3 second4 second5 second6 second7 second8 second9\nthird0 third1 third2 third3 third4 third5 third6 third7 third8 third9\nfourth0 fourth1 fourth2 fourth3 fourth4 fourth5 fourth6 fourth7 fourth8 fourth9\nfifth0 fifth1 fifth2 fifth3 fifth4 fifth5 fifth6 fifth7 fifth8 fifth9\nsixth0 sixth1 sixth2 sixth3 sixth4 sixth5 sixth6 sixth7 sixth8 sixth9\nseventh0 seventh1 seventh2 seventh3 seventh4 seventh5 seventh6 seventh7 seventh8 seventh9\n", NULL); } else if (strcmp(argv[2], "free") == 0) { - char *s = (char *)ckalloc(100); + char *s = (char *)Tcl_Alloc(100); strcpy(s, "This is a malloc-ed string"); Tcl_SetResult(interp, s, TCL_DYNAMIC); } else if (strcmp(argv[2], "special") == 0) { - char *s = (char *)ckalloc(100) + 16; + char *s = (char *)Tcl_Alloc(100) + 16; strcpy(s, "This is a specially-allocated string"); Tcl_SetResult(interp, s, SpecialFree); } else { @@ -1970,9 +1934,9 @@ TestdstringCmd( */ static void SpecialFree( - char *blockPtr /* Block to free. */ + void *blockPtr /* Block to free. */ ) { - ckfree(blockPtr - 16); + Tcl_Free(((char *)blockPtr) - 16); } /* @@ -2000,7 +1964,7 @@ TestencodingObjCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Encoding encoding; - int index, length; + size_t length; const char *string; TclEncoding *encodingPtr; static const char *const optionStrings[] = { @@ -2008,7 +1972,7 @@ TestencodingObjCmd( }; enum options { ENC_CREATE, ENC_DELETE, ENC_NULLENGTH - }; + } index; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "command ?args?"); @@ -2020,7 +1984,7 @@ TestencodingObjCmd( return TCL_ERROR; } - switch ((enum options) index) { + switch (index) { case ENC_CREATE: { Tcl_EncodingType type; @@ -2028,15 +1992,15 @@ TestencodingObjCmd( Tcl_WrongNumArgs(interp, 2, objv, "name toutfcmd fromutfcmd"); return TCL_ERROR; } - encodingPtr = (TclEncoding*)ckalloc(sizeof(TclEncoding)); + encodingPtr = (TclEncoding*)Tcl_Alloc(sizeof(TclEncoding)); encodingPtr->interp = interp; string = Tcl_GetStringFromObj(objv[3], &length); - encodingPtr->toUtfCmd = (char *)ckalloc(length + 1); + encodingPtr->toUtfCmd = (char *)Tcl_Alloc(length + 1); memcpy(encodingPtr->toUtfCmd, string, length + 1); string = Tcl_GetStringFromObj(objv[4], &length); - encodingPtr->fromUtfCmd = (char *)ckalloc(length + 1); + encodingPtr->fromUtfCmd = (char *)Tcl_Alloc(length + 1); memcpy(encodingPtr->fromUtfCmd, string, length + 1); string = Tcl_GetStringFromObj(objv[2], &length); @@ -2150,9 +2114,9 @@ EncodingFreeProc( { TclEncoding *encodingPtr = (TclEncoding *)clientData; - ckfree(encodingPtr->toUtfCmd); - ckfree(encodingPtr->fromUtfCmd); - ckfree(encodingPtr); + Tcl_Free(encodingPtr->toUtfCmd); + Tcl_Free(encodingPtr->fromUtfCmd); + Tcl_Free(encodingPtr); } /* @@ -2307,7 +2271,7 @@ TesteventObjCmd( "position specifier", TCL_EXACT, &posIndex) != TCL_OK) { return TCL_ERROR; } - ev = (TestEvent *)ckalloc(sizeof(TestEvent)); + ev = (TestEvent *)Tcl_Alloc(sizeof(TestEvent)); ev->header.proc = TesteventProc; ev->header.nextPtr = NULL; ev->interp = interp; @@ -3174,12 +3138,12 @@ TestlinkCmd( } if (argv[5][0] != 0) { if (stringVar != NULL) { - ckfree(stringVar); + Tcl_Free(stringVar); } if (strcmp(argv[5], "-") == 0) { stringVar = NULL; } else { - stringVar = (char *)ckalloc(strlen(argv[5]) + 1); + stringVar = (char *)Tcl_Alloc(strlen(argv[5]) + 1); strcpy(stringVar, argv[5]); } } @@ -3281,12 +3245,12 @@ TestlinkCmd( } if (argv[5][0] != 0) { if (stringVar != NULL) { - ckfree(stringVar); + Tcl_Free(stringVar); } if (strcmp(argv[5], "-") == 0) { stringVar = NULL; } else { - stringVar = (char *)ckalloc(strlen(argv[5]) + 1); + stringVar = (char *)Tcl_Alloc(strlen(argv[5]) + 1); strcpy(stringVar, argv[5]); } Tcl_UpdateLinkedVar(interp, "string"); @@ -3403,7 +3367,7 @@ TestlinkarrayCmd( static const char *LinkOption[] = { "update", "remove", "create", NULL }; - enum LinkOptionEnum { LINK_UPDATE, LINK_REMOVE, LINK_CREATE }; + enum LinkOptionEnum {LINK_UPDATE, LINK_REMOVE, LINK_CREATE} optionIndex; static const char *LinkType[] = { "char", "uchar", "short", "ushort", "int", "uint", "long", "ulong", "wide", "uwide", "float", "double", "string", "char*", "binary", NULL @@ -3416,7 +3380,7 @@ TestlinkarrayCmd( TCL_LINK_FLOAT, TCL_LINK_DOUBLE, TCL_LINK_STRING, TCL_LINK_CHARS, TCL_LINK_BINARY }; - int optionIndex, typeIndex, readonly, i, size, length; + int typeIndex, readonly, i, size, length; char *name, *arg; Tcl_WideInt addr; @@ -3428,7 +3392,7 @@ TestlinkarrayCmd( &optionIndex) != TCL_OK) { return TCL_ERROR; } - switch ((enum LinkOptionEnum) optionIndex) { + switch (optionIndex) { case LINK_UPDATE: for (i=2; i<objc; i++) { Tcl_UpdateLinkedVar(interp, Tcl_GetString(objv[i])); @@ -3733,7 +3697,7 @@ CleanupTestSetassocdataTests( void *clientData, /* Data to be released. */ TCL_UNUSED(Tcl_Interp *)) { - ckfree(clientData); + Tcl_Free(clientData); } /* @@ -3879,10 +3843,10 @@ PrintParse( Tcl_Obj *objPtr; const char *typeString; Tcl_Token *tokenPtr; - int i; + size_t i; objPtr = Tcl_GetObjResult(interp); - if (parsePtr->commentSize > 0) { + if (parsePtr->commentSize + 1 > 1) { Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewStringObj(parsePtr->commentStart, parsePtr->commentSize)); @@ -3893,7 +3857,7 @@ PrintParse( Tcl_NewStringObj(parsePtr->commandStart, parsePtr->commandSize)); Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewWideIntObj(parsePtr->numWords)); - for (i = 0; i < parsePtr->numTokens; i++) { + for (i = 0; i < (size_t)parsePtr->numTokens; i++) { tokenPtr = &parsePtr->tokenPtr[i]; switch (tokenPtr->type) { case TCL_TOKEN_EXPAND_WORD: @@ -4139,7 +4103,8 @@ TestregexpObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int i, ii, indices, stringLength, match, about; + int i, indices, stringLength, match, about; + size_t ii; int hasxflags, cflags, eflags; Tcl_RegExp regExpr; const char *string; @@ -4156,7 +4121,7 @@ TestregexpObjCmd( REGEXP_MULTI, REGEXP_NOCROSS, REGEXP_NEWL, REGEXP_XFLAGS, REGEXP_LAST - }; + } index; indices = 0; about = 0; @@ -4166,7 +4131,6 @@ TestregexpObjCmd( for (i = 1; i < objc; i++) { const char *name; - int index; name = Tcl_GetString(objv[i]); if (name[0] != '-') { @@ -4176,7 +4140,7 @@ TestregexpObjCmd( &index) != TCL_OK) { return TCL_ERROR; } - switch ((enum optionsEnum) index) { + switch (index) { case REGEXP_INDICES: indices = 1; break; @@ -4252,12 +4216,12 @@ TestregexpObjCmd( if (objc > 2 && (cflags®_EXPECT) && indices) { const char *varName; const char *value; - int start, end; + size_t start, end; char resinfo[TCL_INTEGER_SPACE * 2]; varName = Tcl_GetString(objv[2]); TclRegExpRangeUniChar(regExpr, TCL_INDEX_NONE, &start, &end); - sprintf(resinfo, "%d %d", start, end-1); + sprintf(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 \"", @@ -4271,7 +4235,7 @@ TestregexpObjCmd( Tcl_RegExpGetInfo(regExpr, &info); varName = Tcl_GetString(objv[2]); - sprintf(resinfo, "%ld", info.extendStart); + sprintf(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 \"", @@ -4292,11 +4256,11 @@ TestregexpObjCmd( Tcl_RegExpGetInfo(regExpr, &info); for (i = 0; i < objc; i++) { - int start, end; + size_t start, end; Tcl_Obj *newPtr, *varPtr, *valuePtr; varPtr = objv[i]; - ii = ((cflags®_EXPECT) && i == objc-1) ? TCL_INDEX_NONE : i; + ii = ((cflags®_EXPECT) && i == objc-1) ? TCL_INDEX_NONE : (size_t)i; if (indices) { Tcl_Obj *objs[2]; @@ -4315,19 +4279,19 @@ TestregexpObjCmd( * instead of the first character after the match. */ - if (end >= 0) { + if (end != TCL_INDEX_NONE) { end--; } - objs[0] = Tcl_NewWideIntObj(start); - objs[1] = Tcl_NewWideIntObj(end); + objs[0] = Tcl_NewWideIntObj((Tcl_WideInt)((Tcl_WideUInt)(start + 1U)) - 1); + objs[1] = Tcl_NewWideIntObj((Tcl_WideInt)((Tcl_WideUInt)(end + 1U)) - 1); newPtr = Tcl_NewListObj(2, objs); } else { if (ii == TCL_INDEX_NONE) { TclRegExpRangeUniChar(regExpr, ii, &start, &end); newPtr = Tcl_GetRange(objPtr, start, end); - } else if (ii > info.nsubs || info.matches[ii].end <= 0) { + } else if (ii > info.nsubs || info.matches[ii].end + 1 <= 1) { newPtr = Tcl_NewObj(); } else { newPtr = Tcl_GetRange(objPtr, info.matches[ii].start, @@ -4500,7 +4464,7 @@ TestsetassocdataCmd( return TCL_ERROR; } - buf = (char *)ckalloc(strlen(argv[2]) + 1); + buf = (char *)Tcl_Alloc(strlen(argv[2]) + 1); strcpy(buf, argv[2]); /* @@ -4510,7 +4474,7 @@ TestsetassocdataCmd( oldData = (char *) Tcl_GetAssocData(interp, argv[1], &procPtr); if ((oldData != NULL) && (procPtr == CleanupTestSetassocdataTests)) { - ckfree(oldData); + Tcl_Free(oldData); } Tcl_SetAssocData(interp, argv[1], CleanupTestSetassocdataTests, buf); @@ -4894,7 +4858,7 @@ TestpanicCmd( char *argString = Tcl_Merge(argc-1, argv+1); Tcl_Panic("%s", argString); - ckfree(argString); + Tcl_Free(argString); return TCL_OK; } @@ -5074,8 +5038,8 @@ GetTimesObjCmd( fprintf(stderr, "alloc & free 100000 6 word items\n"); Tcl_GetTime(&start); for (i = 0; i < 100000; i++) { - objPtr = (Tcl_Obj *)ckalloc(sizeof(Tcl_Obj)); - ckfree(objPtr); + objPtr = (Tcl_Obj *)Tcl_Alloc(sizeof(Tcl_Obj)); + Tcl_Free(objPtr); } Tcl_GetTime(&stop); timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec); @@ -5083,10 +5047,10 @@ GetTimesObjCmd( /* alloc 5000 times */ fprintf(stderr, "alloc 5000 6 word items\n"); - objv = (Tcl_Obj **)ckalloc(5000 * sizeof(Tcl_Obj *)); + objv = (Tcl_Obj **)Tcl_Alloc(5000 * sizeof(Tcl_Obj *)); Tcl_GetTime(&start); for (i = 0; i < 5000; i++) { - objv[i] = (Tcl_Obj *)ckalloc(sizeof(Tcl_Obj)); + objv[i] = (Tcl_Obj *)Tcl_Alloc(sizeof(Tcl_Obj)); } Tcl_GetTime(&stop); timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec); @@ -5096,7 +5060,7 @@ GetTimesObjCmd( fprintf(stderr, "free 5000 6 word items\n"); Tcl_GetTime(&start); for (i = 0; i < 5000; i++) { - ckfree(objv[i]); + Tcl_Free(objv[i]); } Tcl_GetTime(&stop); timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec); @@ -5122,7 +5086,7 @@ GetTimesObjCmd( Tcl_GetTime(&stop); timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec); fprintf(stderr, " %.3f usec per Tcl_DecrRefCount\n", timePer/5000); - ckfree(objv); + Tcl_Free(objv); /* TclGetString 100000 times */ fprintf(stderr, "Tcl_GetStringFromObj of \"12345\" 100000 times\n"); @@ -5348,7 +5312,7 @@ TestpurebytesobjObjCmd( if (objc == 2) { const char *s = Tcl_GetString(objv[1]); objPtr->length = objv[1]->length; - objPtr->bytes = (char *)ckalloc(objPtr->length + 1); + objPtr->bytes = (char *)Tcl_Alloc(objPtr->length + 1); memcpy(objPtr->bytes, s, objPtr->length); objPtr->bytes[objPtr->length] = 0; } @@ -5448,43 +5412,6 @@ TestbytestringObjCmd( /* *---------------------------------------------------------------------- * - * Testutf16stringObjCmd -- - * - * This specifically tests the Tcl_GetUnicode and Tcl_NewUnicodeObj - * C functions which broke in Tcl 8.7 and were undetected by the - * existing test suite. Bug [b79df322a9] - * - * Results: - * Returns the TCL_OK result code. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -static int -Testutf16stringObjCmd( - TCL_UNUSED(void *), - Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ - Tcl_Obj *const objv[]) /* The argument objects. */ -{ - const unsigned short *p; - - if (objc != 2) { - Tcl_WrongNumArgs(interp, 1, objv, "string"); - return TCL_ERROR; - } - - p = Tcl_GetUnicode(objv[1]); - Tcl_SetObjResult(interp, Tcl_NewUnicodeObj(p, TCL_INDEX_NONE)); - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * * TestsetCmd -- * * Implements the "testset{err,noerr}" cmds that are used when testing @@ -5567,139 +5494,6 @@ Testset2Cmd( /* *---------------------------------------------------------------------- * - * TestsaveresultCmd -- - * - * Implements the "testsaveresult" cmd that is used when testing the - * Tcl_SaveResult, Tcl_RestoreResult, and Tcl_DiscardResult interfaces. - * - * Results: - * A standard Tcl result. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -#ifndef TCL_NO_DEPRECATED -static int -TestsaveresultCmd( - TCL_UNUSED(void *), - Tcl_Interp *interp,/* Current interpreter. */ - int objc, /* Number of arguments. */ - Tcl_Obj *const objv[]) /* The argument objects. */ -{ - Interp* iPtr = (Interp*) interp; - int discard, result, index; - Tcl_SavedResult state; - Tcl_Obj *objPtr; - static const char *const optionStrings[] = { - "append", "dynamic", "free", "object", "small", NULL - }; - enum options { - RESULT_APPEND, RESULT_DYNAMIC, RESULT_FREE, RESULT_OBJECT, RESULT_SMALL - }; - - /* - * Parse arguments - */ - - if (objc != 4) { - Tcl_WrongNumArgs(interp, 1, objv, "type script discard"); - return TCL_ERROR; - } - if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0, - &index) != TCL_OK) { - return TCL_ERROR; - } - if (Tcl_GetBooleanFromObj(interp, objv[3], &discard) != TCL_OK) { - return TCL_ERROR; - } - - freeCount = 0; - objPtr = NULL; - switch ((enum options) index) { - case RESULT_SMALL: - Tcl_AppendResult(interp, "small result", NULL); - break; - case RESULT_APPEND: - Tcl_AppendResult(interp, "append result", NULL); - break; - case RESULT_FREE: { - char *buf = (char *)ckalloc(200); - - strcpy(buf, "free result"); - Tcl_SetResult(interp, buf, TCL_DYNAMIC); - break; - } - case RESULT_DYNAMIC: - Tcl_SetResult(interp, (char *)"dynamic result", TestsaveresultFree); - break; - case RESULT_OBJECT: - objPtr = Tcl_NewStringObj("object result", TCL_INDEX_NONE); - Tcl_SetObjResult(interp, objPtr); - break; - } - - Tcl_SaveResult(interp, &state); - - if (((enum options) index) == RESULT_OBJECT) { - result = Tcl_EvalObjEx(interp, objv[2], 0); - } else { - result = Tcl_EvalEx(interp, Tcl_GetString(objv[2]), TCL_INDEX_NONE, 0); - } - - if (discard) { - Tcl_DiscardResult(&state); - } else { - Tcl_RestoreResult(interp, &state); - result = TCL_OK; - } - - switch ((enum options) index) { - case RESULT_DYNAMIC: { - int presentOrFreed = (iPtr->freeProc == TestsaveresultFree) ^ freeCount; - - Tcl_AppendElement(interp, presentOrFreed ? "presentOrFreed" : "missingOrLeak"); - break; - } - case RESULT_OBJECT: - Tcl_AppendElement(interp, Tcl_GetObjResult(interp) == objPtr - ? "same" : "different"); - break; - default: - break; - } - return result; -} - -/* - *---------------------------------------------------------------------- - * - * TestsaveresultFree -- - * - * Special purpose freeProc used by TestsaveresultCmd. - * - * Results: - * None. - * - * Side effects: - * Increments the freeCount. - * - *---------------------------------------------------------------------- - */ - -static void -TestsaveresultFree( - TCL_UNUSED(char *)) -{ - freeCount++; -} -#endif /* TCL_NO_DEPRECATED */ - -/* - *---------------------------------------------------------------------- - * * TestmainthreadCmd -- * * Implements the "testmainthread" cmd that is used to test the @@ -5878,7 +5672,7 @@ TestChannelCmd( *nextPtrPtr = curPtr->nextPtr; curPtr->nextPtr = NULL; chan = curPtr->chan; - ckfree(curPtr); + Tcl_Free(curPtr); break; } } @@ -5947,7 +5741,7 @@ TestChannelCmd( /* Remember the channel in the pool of detached channels */ - det = (TestChannel *)ckalloc(sizeof(TestChannel)); + det = (TestChannel *)Tcl_Alloc(sizeof(TestChannel)); det->chan = chan; det->nextPtr = firstDetached; firstDetached = det; @@ -6383,7 +6177,7 @@ TestChannelEventCmd( return TCL_ERROR; } - esPtr = (EventScriptRecord *)ckalloc(sizeof(EventScriptRecord)); + esPtr = (EventScriptRecord *)Tcl_Alloc(sizeof(EventScriptRecord)); esPtr->nextPtr = statePtr->scriptRecordPtr; statePtr->scriptRecordPtr = esPtr; @@ -6440,7 +6234,7 @@ TestChannelEventCmd( Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr, TclChannelEventScriptInvoker, esPtr); Tcl_DecrRefCount(esPtr->scriptPtr); - ckfree(esPtr); + Tcl_Free(esPtr); return TCL_OK; } @@ -6481,7 +6275,7 @@ TestChannelEventCmd( Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr, TclChannelEventScriptInvoker, esPtr); Tcl_DecrRefCount(esPtr->scriptPtr); - ckfree(esPtr); + Tcl_Free(esPtr); } statePtr->scriptRecordPtr = NULL; return TCL_OK; @@ -6681,13 +6475,13 @@ static int TestWrongNumArgsObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ + size_t objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int i, length; + size_t i, length; const char *msg; - if (objc < 3) { + if (objc + 1 < 4) { goto insufArgs; } @@ -7331,7 +7125,7 @@ TestUtfNextCmd( int objc, Tcl_Obj *const objv[]) { - int numBytes; + size_t numBytes; char *bytes; const char *result, *first; char buffer[32]; @@ -7392,7 +7186,7 @@ TestUtfPrevCmd( int objc, Tcl_Obj *const objv[]) { - int numBytes, offset; + size_t numBytes, offset; char *bytes; const char *result; @@ -7407,7 +7201,7 @@ TestUtfPrevCmd( if (TCL_OK != Tcl_GetIntForIndex(interp, objv[2], numBytes, &offset)) { return TCL_ERROR; } - if (offset < 0) { + if (offset == TCL_INDEX_NONE) { offset = 0; } if (offset > numBytes) { @@ -7433,7 +7227,7 @@ TestNumUtfCharsCmd( Tcl_Obj *const objv[]) { if (objc > 1) { - int numBytes, len, limit = TCL_INDEX_NONE; + size_t numBytes, len, limit = TCL_INDEX_NONE; const char *bytes = Tcl_GetStringFromObj(objv[1], &numBytes); if (objc > 2) { @@ -7501,7 +7295,7 @@ TestGetIntForIndexCmd( int objc, Tcl_Obj *const objv[]) { - int result; + size_t result; Tcl_WideInt endvalue; if (objc != 3) { @@ -7515,7 +7309,8 @@ TestGetIntForIndexCmd( if (Tcl_GetIntForIndex(interp, objv[1], endvalue, &result) != TCL_OK) { return TCL_ERROR; } - Tcl_SetObjResult(interp, Tcl_NewWideIntObj(result)); + /* Make sure that (size_t)-2 is output as "-2" and (size_t)-3 as "-3", even for 32-bit */ + Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt)((Tcl_WideUInt)(result + 3U)) - 3)); return TCL_OK; } @@ -7619,7 +7414,7 @@ TestHashSystemHashCmd( Tcl_SetHashValue(hPtr, INT2PTR(i+42)); } - if (hash.numEntries != limit) { + if (hash.numEntries != (size_t)limit) { Tcl_AppendResult(interp, "unexpected maximal size", NULL); Tcl_DeleteHashTable(&hash); return TCL_ERROR; @@ -7755,7 +7550,7 @@ TestNRELevels( static ptrdiff_t *refDepth = NULL; ptrdiff_t depth; Tcl_Obj *levels[6]; - int i = 0; + size_t i = 0; NRE_callback *cbPtr = iPtr->execEnvPtr->callbackPtr; if (refDepth == NULL) { @@ -7765,9 +7560,9 @@ TestNRELevels( depth = (refDepth - &depth); levels[0] = Tcl_NewWideIntObj(depth); - levels[1] = Tcl_NewWideIntObj(iPtr->numLevels); - levels[2] = Tcl_NewWideIntObj(iPtr->cmdFramePtr->level); - levels[3] = Tcl_NewWideIntObj(iPtr->varFramePtr->level); + levels[1] = Tcl_NewWideIntObj((Tcl_WideInt)((Tcl_WideUInt)(iPtr->numLevels + 1U)) - 1); + levels[2] = Tcl_NewWideIntObj((Tcl_WideInt)((Tcl_WideUInt)(iPtr->cmdFramePtr->level + 1U)) - 1); + levels[3] = Tcl_NewWideIntObj((Tcl_WideInt)((Tcl_WideUInt)(iPtr->varFramePtr->level + 1U)) - 1); levels[4] = Tcl_NewWideIntObj(iPtr->execEnvPtr->execStackPtr->tosPtr - iPtr->execEnvPtr->execStackPtr->stackWords); @@ -8181,7 +7976,7 @@ TestparseargsCmd( result[1] = Tcl_NewWideIntObj(count); result[2] = Tcl_NewListObj(count, remObjv); Tcl_SetObjResult(interp, Tcl_NewListObj(3, result)); - ckfree(remObjv); + Tcl_Free(remObjv); return TCL_OK; } @@ -8308,7 +8103,7 @@ HashVarFree( Tcl_Var var) { if (VarHashRefCount(var) < 2) { - ckfree(var); + Tcl_Free(var); } else { VarHashRefCount(var)--; } @@ -8324,7 +8119,7 @@ MyCompiledVarFree( if (resVarInfo->var) { HashVarFree(resVarInfo->var); } - ckfree(vInfoPtr); + Tcl_Free(vInfoPtr); } #define TclVarHashGetValue(hPtr) \ @@ -8358,7 +8153,7 @@ MyCompiledVarFetch( } hPtr = Tcl_CreateHashEntry((Tcl_HashTable *) &iPtr->globalNsPtr->varTable, - (char *) resVarInfo->nameObj, &isNewVar); + resVarInfo->nameObj, &isNewVar); if (hPtr) { var = (Tcl_Var) TclVarHashGetValue(hPtr); } else { @@ -8367,7 +8162,7 @@ MyCompiledVarFetch( resVarInfo->var = var; /* - * Increment the reference counter to avoid ckfree() of the variable in + * Increment the reference counter to avoid Tcl_Free() of the variable in * Tcl's FreeVarEntry(); for cleanup, we provide our own HashVarFree(); */ @@ -8379,12 +8174,12 @@ static int InterpCompiledVarResolver( TCL_UNUSED(Tcl_Interp *), const char *name, - TCL_UNUSED(int) /*length*/, + TCL_UNUSED(size_t) /*length*/, TCL_UNUSED(Tcl_Namespace *), Tcl_ResolvedVarInfo **rPtr) { if (*name == 'T') { - MyResolvedVarInfo *resVarInfo = (MyResolvedVarInfo *)ckalloc(sizeof(MyResolvedVarInfo)); + MyResolvedVarInfo *resVarInfo = (MyResolvedVarInfo *)Tcl_Alloc(sizeof(MyResolvedVarInfo)); resVarInfo->vInfo.fetchProc = MyCompiledVarFetch; resVarInfo->vInfo.deleteProc = MyCompiledVarFree; diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c index c9a910a..131601d 100644 --- a/generic/tclTestObj.c +++ b/generic/tclTestObj.c @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ -#undef BUILD_tcl + #ifndef USE_TCL_STUBS # define USE_TCL_STUBS #endif @@ -25,14 +25,6 @@ #endif #include "tclStringRep.h" -#ifdef __GNUC__ -/* - * The rest of this file shouldn't warn about deprecated functions; they're - * there because we intend them to be so and know that this file is OK to - * touch those fields. - */ -#pragma GCC diagnostic ignored "-Wdeprecated-declarations" -#endif /* * Forward declarations for functions defined later in this file: @@ -61,7 +53,7 @@ static void VarPtrDeleteProc(void *clientData, TCL_UNUSED(Tcl_Interp *)) for (i = 0; i < NUMBER_OF_OBJECT_VARS; i++) { if (varPtr[i]) Tcl_DecrRefCount(varPtr[i]); } - ckfree(varPtr); + Tcl_Free(varPtr); } static Tcl_Obj **GetVarPtr(Tcl_Interp *interp) @@ -101,7 +93,7 @@ TclObjTest_Init( */ Tcl_Obj **varPtr; - varPtr = (Tcl_Obj **) ckalloc(NUMBER_OF_OBJECT_VARS *sizeof(varPtr[0])); + varPtr = (Tcl_Obj **) Tcl_Alloc(NUMBER_OF_OBJECT_VARS *sizeof(varPtr[0])); if (!varPtr) { return TCL_ERROR; } @@ -159,7 +151,7 @@ TestbignumobjCmd( enum options { BIGNUM_SET, BIGNUM_GET, BIGNUM_MULT10, BIGNUM_DIV10, BIGNUM_ISEVEN, BIGNUM_RADIXSIZE - }; + } idx; int index; size_t varIndex; const char *string; @@ -171,7 +163,7 @@ TestbignumobjCmd( return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[1], subcmds, "option", 0, - &index) != TCL_OK) { + &idx) != TCL_OK) { return TCL_ERROR; } if (GetVariableIndex(interp, objv[2], &varIndex) != TCL_OK) { @@ -179,7 +171,7 @@ TestbignumobjCmd( } varPtr = GetVarPtr(interp); - switch ((enum options)index) { + switch (idx) { case BIGNUM_SET: if (objc != 4) { Tcl_WrongNumArgs(interp, 2, objv, "var value"); @@ -617,7 +609,7 @@ TestindexobjCmd( return TCL_ERROR; } - argv = (const char **)ckalloc((objc-3) * sizeof(char *)); + argv = (const char **)Tcl_Alloc((objc-3) * sizeof(char *)); for (i = 4; i < objc; i++) { argv[i-4] = Tcl_GetString(objv[i]); } @@ -626,7 +618,7 @@ TestindexobjCmd( result = Tcl_GetIndexFromObj((setError? interp : NULL), objv[3], argv, "token", TCL_INDEX_TEMP_TABLE|(allowAbbrev? 0 : TCL_EXACT), &index); - ckfree(argv); + Tcl_Free((void *)argv); if (result == TCL_OK) { Tcl_SetWideIntObj(Tcl_GetObjResult(interp), index); } @@ -921,7 +913,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); @@ -1258,9 +1250,9 @@ TeststringobjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - unsigned short *unicode; - size_t varIndex; - int size, option, i; + Tcl_UniChar *unicode; + size_t size, varIndex; + int option, i; Tcl_WideInt length; #define MAX_STRINGS 11 const char *string, *strings[MAX_STRINGS+1]; @@ -1361,21 +1353,17 @@ TeststringobjCmd( goto wrongNumArgs; } Tcl_SetWideIntObj(Tcl_GetObjResult(interp), (varPtr[varIndex] != NULL) - ? varPtr[varIndex]->length : -1); + ? (Tcl_WideInt)varPtr[varIndex]->length : (Tcl_WideInt)-1); break; case 5: /* length2 */ if (objc != 3) { goto wrongNumArgs; } if (varPtr[varIndex] != NULL) { - const Tcl_ObjType *objType = Tcl_GetObjType("string"); - if (objType != NULL) { - Tcl_ConvertToType(NULL, varPtr[varIndex], objType); - strPtr = (String *)varPtr[varIndex]->internalRep.twoPtrValue.ptr1; - length = (int) strPtr->allocated; - } else { - length = -1; - } + Tcl_ConvertToType(NULL, varPtr[varIndex], + Tcl_GetObjType("string")); + strPtr = (String *)varPtr[varIndex]->internalRep.twoPtrValue.ptr1; + length = strPtr->allocated; } else { length = -1; } @@ -1426,26 +1414,22 @@ TeststringobjCmd( goto wrongNumArgs; } if (varPtr[varIndex] != NULL) { - const Tcl_ObjType *objType = Tcl_GetObjType("string"); - if (objType != NULL) { - Tcl_ConvertToType(NULL, varPtr[varIndex],objType); - strPtr = (String *)varPtr[varIndex]->internalRep.twoPtrValue.ptr1; - length = strPtr->maxChars; - } else { - length = -1; - } + Tcl_ConvertToType(NULL, varPtr[varIndex], + Tcl_GetObjType("string")); + strPtr = (String *)varPtr[varIndex]->internalRep.twoPtrValue.ptr1; + length = strPtr->maxChars; } else { length = -1; } Tcl_SetWideIntObj(Tcl_GetObjResult(interp), length); break; case 10: { /* range */ - int first, last; + Tcl_WideInt first, last; if (objc != 5) { goto wrongNumArgs; } - if ((Tcl_GetIntFromObj(interp, objv[3], &first) != TCL_OK) - || (Tcl_GetIntFromObj(interp, objv[4], &last) != TCL_OK)) { + if ((Tcl_GetWideIntFromObj(interp, objv[3], &first) != TCL_OK) + || (Tcl_GetWideIntFromObj(interp, objv[4], &last) != TCL_OK)) { return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_GetRange(varPtr[varIndex], first, last)); @@ -1473,7 +1457,7 @@ TeststringobjCmd( if (Tcl_GetWideIntFromObj(interp, objv[3], &length) != TCL_OK) { return TCL_ERROR; } - if ((length < 0) || (length > size)) { + if ((length < 0) || ((Tcl_WideUInt)length > (Tcl_WideUInt)size)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "index value out of range", -1)); return TCL_ERROR; @@ -1504,7 +1488,7 @@ TeststringobjCmd( if (Tcl_GetWideIntFromObj(interp, objv[3], &length) != TCL_OK) { return TCL_ERROR; } - if ((length < 0) || (length > size)) { + if ((length < 0) || ((Tcl_WideUInt)length > (Tcl_WideUInt)size)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "index value out of range", -1)); return TCL_ERROR; diff --git a/generic/tclTestProcBodyObj.c b/generic/tclTestProcBodyObj.c index 9b6aa1d..6d5e6ec 100644 --- a/generic/tclTestProcBodyObj.c +++ b/generic/tclTestProcBodyObj.c @@ -35,7 +35,7 @@ static const char checkCommand[] = "check"; * procs */ -typedef struct CmdTable { +typedef struct { const char *cmdName; /* command name */ Tcl_ObjCmdProc *proc; /* command proc */ int exportIt; /* if 1, export the command */ @@ -188,7 +188,7 @@ ProcBodyTestInitInternal( } } - return Tcl_PkgProvide(interp, packageName, packageVersion); + return Tcl_PkgProvideEx(interp, packageName, packageVersion, NULL); } /* @@ -337,7 +337,7 @@ ProcBodyTestCheckObjCmd( return TCL_ERROR; } - version = Tcl_PkgPresent(interp, packageName, packageVersion, 1); + version = Tcl_PkgPresentEx(interp, packageName, packageVersion, 1, NULL); Tcl_SetObjResult(interp, Tcl_NewBooleanObj( strcmp(version, packageVersion) == 0)); return TCL_OK; diff --git a/generic/tclThread.c b/generic/tclThread.c index de9fac9..70a2b05 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 */ - int size) /* Size of storage block */ + size_t size) /* Size of storage block */ { void *result; #if TCL_THREADS @@ -72,13 +72,13 @@ Tcl_GetThreadData( result = TclThreadStorageKeyGet(keyPtr); if (result == NULL) { - result = ckalloc(size); + result = Tcl_Alloc(size); memset(result, 0, size); TclThreadStorageKeySet(keyPtr, result); } #else /* TCL_THREADS */ if (*keyPtr == NULL) { - result = ckalloc(size); + result = Tcl_Alloc(size); memset(result, 0, size); *keyPtr = (Tcl_ThreadDataKey)result; RememberSyncObject(keyPtr, &keyRecord); @@ -164,14 +164,14 @@ RememberSyncObject( if (recPtr->num >= recPtr->max) { recPtr->max += 8; - newList = (void **)ckalloc(recPtr->max * sizeof(void *)); + newList = (void **)Tcl_Alloc(recPtr->max * sizeof(void *)); for (i=0,j=0 ; i<recPtr->num ; i++) { if (recPtr->list[i] != NULL) { newList[j++] = recPtr->list[i]; } } if (recPtr->list != NULL) { - ckfree(recPtr->list); + Tcl_Free(recPtr->list); } recPtr->list = newList; recPtr->num = j; @@ -394,9 +394,9 @@ TclFinalizeSynchronization(void) for (i=0 ; i<keyRecord.num ; i++) { keyPtr = (Tcl_ThreadDataKey *) keyRecord.list[i]; blockPtr = *keyPtr; - ckfree(blockPtr); + Tcl_Free(blockPtr); } - ckfree(keyRecord.list); + Tcl_Free(keyRecord.list); keyRecord.list = NULL; } keyRecord.max = 0; @@ -416,7 +416,7 @@ TclFinalizeSynchronization(void) } } if (mutexRecord.list != NULL) { - ckfree(mutexRecord.list); + Tcl_Free(mutexRecord.list); mutexRecord.list = NULL; } mutexRecord.max = 0; @@ -429,7 +429,7 @@ TclFinalizeSynchronization(void) } } if (condRecord.list != NULL) { - ckfree(condRecord.list); + Tcl_Free(condRecord.list); condRecord.list = NULL; } condRecord.max = 0; diff --git a/generic/tclThreadAlloc.c b/generic/tclThreadAlloc.c index 727f061..1eb6315 100644 --- a/generic/tclThreadAlloc.c +++ b/generic/tclThreadAlloc.c @@ -210,7 +210,7 @@ GetCache(void) cachePtr = (Cache*)TclpGetAllocCache(); if (cachePtr == NULL) { - cachePtr = (Cache*)TclpSysAlloc(sizeof(Cache), 0); + cachePtr = (Cache*)TclpSysAlloc(sizeof(Cache)); if (cachePtr == NULL) { Tcl_Panic("alloc: could not allocate new cache"); } @@ -300,26 +300,13 @@ TclFreeAllocCache( void * TclpAlloc( - unsigned int reqSize) + size_t reqSize) { Cache *cachePtr; Block *blockPtr; int bucket; size_t size; -#ifndef __LP64__ - if (sizeof(int) >= sizeof(size_t)) { - /* An unsigned int overflow can also be a size_t overflow */ - const size_t zero = 0; - const size_t max = ~zero; - - if (((size_t) reqSize) > max - sizeof(Block) - RCHECK) { - /* Requested allocation exceeds memory */ - return NULL; - } - } -#endif - GETCACHE(cachePtr); /* @@ -336,7 +323,7 @@ TclpAlloc( #endif if (size > MAXALLOC) { bucket = NBUCKETS; - blockPtr = (Block *)TclpSysAlloc(size, 0); + blockPtr = (Block *)TclpSysAlloc(size); if (blockPtr != NULL) { cachePtr->totalAssigned += reqSize; } @@ -437,7 +424,7 @@ TclpFree( void * TclpRealloc( void *ptr, - unsigned int reqSize) + size_t reqSize) { Cache *cachePtr; Block *blockPtr; @@ -449,19 +436,6 @@ TclpRealloc( return TclpAlloc(reqSize); } -#ifndef __LP64__ - if (sizeof(int) >= sizeof(size_t)) { - /* An unsigned int overflow can also be a size_t overflow */ - const size_t zero = 0; - const size_t max = ~zero; - - if (((size_t) reqSize) > max - sizeof(Block) - RCHECK) { - /* Requested allocation exceeds memory */ - return NULL; - } - } -#endif - GETCACHE(cachePtr); /* @@ -562,7 +536,7 @@ TclThreadAllocObj(void) Tcl_Obj *newObjsPtr; cachePtr->numObjects = numMove = NOBJALLOC; - newObjsPtr = (Tcl_Obj *)TclpSysAlloc(sizeof(Tcl_Obj) * numMove, 0); + newObjsPtr = (Tcl_Obj *)TclpSysAlloc(sizeof(Tcl_Obj) * numMove); if (newObjsPtr == NULL) { Tcl_Panic("alloc: could not allocate %" TCL_Z_MODIFIER "u new objects", numMove); } @@ -1031,7 +1005,7 @@ GetBlocks( if (blockPtr == NULL) { size = MAXALLOC; - blockPtr = (Block*)TclpSysAlloc(size, 0); + blockPtr = (Block*)TclpSysAlloc(size); if (blockPtr == NULL) { return 0; } diff --git a/generic/tclThreadJoin.c b/generic/tclThreadJoin.c index 4d2aca5..1446301 100644 --- a/generic/tclThreadJoin.c +++ b/generic/tclThreadJoin.c @@ -201,7 +201,7 @@ TclJoinThread( Tcl_ConditionFinalize(&threadPtr->cond); Tcl_MutexFinalize(&threadPtr->threadMutex); - ckfree(threadPtr); + Tcl_Free(threadPtr); return TCL_OK; } @@ -230,7 +230,7 @@ TclRememberJoinableThread( { JoinableThread *threadPtr; - threadPtr = (JoinableThread *)ckalloc(sizeof(JoinableThread)); + threadPtr = (JoinableThread *)Tcl_Alloc(sizeof(JoinableThread)); threadPtr->id = id; threadPtr->done = 0; threadPtr->waitedUpon = 0; diff --git a/generic/tclThreadStorage.c b/generic/tclThreadStorage.c index b2de9b4..22dd0c3 100644 --- a/generic/tclThreadStorage.c +++ b/generic/tclThreadStorage.c @@ -48,7 +48,7 @@ static struct { */ typedef struct { - ClientData *tablePtr; /* The table of Tcl TSDs. */ + void **tablePtr; /* The table of Tcl TSDs. */ sig_atomic_t allocated; /* The size of the table in the current * thread. */ } TSDTable; @@ -85,14 +85,14 @@ TSDTableCreate(void) TSDTable *tsdTablePtr; sig_atomic_t i; - tsdTablePtr = (TSDTable *)TclpSysAlloc(sizeof(TSDTable), 0); + tsdTablePtr = (TSDTable *)TclpSysAlloc(sizeof(TSDTable)); if (tsdTablePtr == NULL) { Tcl_Panic("unable to allocate TSDTable"); } tsdTablePtr->allocated = 8; tsdTablePtr->tablePtr = - (void **)TclpSysAlloc(sizeof(void *) * tsdTablePtr->allocated, 0); + (void **)TclpSysAlloc(sizeof(void *) * tsdTablePtr->allocated); if (tsdTablePtr->tablePtr == NULL) { Tcl_Panic("unable to allocate TSDTable"); } @@ -117,7 +117,7 @@ TSDTableDelete( * and must now be deallocated or they will leak. */ - ckfree(tsdTablePtr->tablePtr[i]); + Tcl_Free(tsdTablePtr->tablePtr[i]); } } @@ -190,7 +190,7 @@ TclThreadStorageKeyGet( Tcl_ThreadDataKey *dataKeyPtr) { TSDTable *tsdTablePtr = (TSDTable *)TclpThreadGetGlobalTSD(tsdGlobal.key); - ClientData resultPtr = NULL; + void *resultPtr = NULL; TSDUnion *keyPtr = (TSDUnion *) dataKeyPtr; sig_atomic_t offset = keyPtr->offset; diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c index 03446c2..6f37124 100644 --- a/generic/tclThreadTest.c +++ b/generic/tclThreadTest.c @@ -209,7 +209,6 @@ ThreadObjCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - int option; static const char *const threadOptions[] = { "cancel", "create", "event", "exit", "id", "join", "names", "send", "wait", "errorproc", @@ -219,7 +218,7 @@ ThreadObjCmd( THREAD_CANCEL, THREAD_CREATE, THREAD_EVENT, THREAD_EXIT, THREAD_ID, THREAD_JOIN, THREAD_NAMES, THREAD_SEND, THREAD_WAIT, THREAD_ERRORPROC - }; + } option; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?"); @@ -242,7 +241,7 @@ ThreadObjCmd( Tcl_MutexUnlock(&threadMutex); } - switch ((enum options)option) { + switch (option) { case THREAD_CANCEL: { Tcl_WideInt id; const char *result; @@ -429,10 +428,10 @@ ThreadObjCmd( Tcl_MutexLock(&threadMutex); errorThreadId = Tcl_GetCurrentThread(); if (errorProcString) { - ckfree(errorProcString); + Tcl_Free(errorProcString); } proc = Tcl_GetString(objv[2]); - errorProcString = (char *)ckalloc(strlen(proc) + 1); + errorProcString = (char *)Tcl_Alloc(strlen(proc) + 1); strcpy(errorProcString, proc); Tcl_MutexUnlock(&threadMutex); return TCL_OK; @@ -591,7 +590,7 @@ NewTestThread( * eval'ing, for the case that we exit during evaluation */ - threadEvalScript = (char *)ckalloc(strlen(ctrlPtr->script) + 1); + threadEvalScript = (char *)Tcl_Alloc(strlen(ctrlPtr->script) + 1); strcpy(threadEvalScript, ctrlPtr->script); Tcl_CreateThreadExitHandler(ThreadExitProc, threadEvalScript); @@ -666,7 +665,7 @@ ThreadErrorProc( argv[2] = errorInfo; script = Tcl_Merge(3, argv); ThreadSend(interp, errorThreadId, script, 0); - ckfree(script); + Tcl_Free(script); } } @@ -836,13 +835,13 @@ ThreadSend( * Create the event for its event queue. */ - threadEventPtr = (ThreadEvent*)ckalloc(sizeof(ThreadEvent)); - threadEventPtr->script = (char *)ckalloc(strlen(script) + 1); + threadEventPtr = (ThreadEvent*)Tcl_Alloc(sizeof(ThreadEvent)); + threadEventPtr->script = (char *)Tcl_Alloc(strlen(script) + 1); strcpy(threadEventPtr->script, script); if (!wait) { resultPtr = threadEventPtr->resultPtr = NULL; } else { - resultPtr = (ThreadEventResult *)ckalloc(sizeof(ThreadEventResult)); + resultPtr = (ThreadEventResult *)Tcl_Alloc(sizeof(ThreadEventResult)); threadEventPtr->resultPtr = resultPtr; /* @@ -913,19 +912,19 @@ ThreadSend( if (resultPtr->code != TCL_OK) { if (resultPtr->errorCode) { Tcl_SetErrorCode(interp, resultPtr->errorCode, NULL); - ckfree(resultPtr->errorCode); + Tcl_Free(resultPtr->errorCode); } if (resultPtr->errorInfo) { Tcl_AddErrorInfo(interp, resultPtr->errorInfo); - ckfree(resultPtr->errorInfo); + Tcl_Free(resultPtr->errorInfo); } } Tcl_AppendResult(interp, resultPtr->result, NULL); Tcl_ConditionFinalize(&resultPtr->done); code = resultPtr->code; - ckfree(resultPtr->result); - ckfree(resultPtr); + Tcl_Free(resultPtr->result); + Tcl_Free(resultPtr); return code; } @@ -1033,18 +1032,18 @@ ThreadEventProc( } result = Tcl_GetStringResult(interp); } - ckfree(threadEventPtr->script); + Tcl_Free(threadEventPtr->script); if (resultPtr) { Tcl_MutexLock(&threadMutex); resultPtr->code = code; - resultPtr->result = (char *)ckalloc(strlen(result) + 1); + resultPtr->result = (char *)Tcl_Alloc(strlen(result) + 1); strcpy(resultPtr->result, result); if (errorCode != NULL) { - resultPtr->errorCode = (char *)ckalloc(strlen(errorCode) + 1); + resultPtr->errorCode = (char *)Tcl_Alloc(strlen(errorCode) + 1); strcpy(resultPtr->errorCode, errorCode); } if (errorInfo != NULL) { - resultPtr->errorInfo = (char *)ckalloc(strlen(errorInfo) + 1); + resultPtr->errorInfo = (char *)Tcl_Alloc(strlen(errorInfo) + 1); strcpy(resultPtr->errorInfo, errorInfo); } Tcl_ConditionNotify(&resultPtr->done); @@ -1078,7 +1077,7 @@ ThreadFreeProc( void *clientData) { if (clientData) { - ckfree(clientData); + Tcl_Free(clientData); } } @@ -1105,7 +1104,7 @@ ThreadDeleteEvent( TCL_UNUSED(void *)) { if (eventPtr->proc == ThreadEventProc) { - ckfree(((ThreadEvent *) eventPtr)->script); + Tcl_Free(((ThreadEvent *) eventPtr)->script); return 1; } @@ -1151,14 +1150,14 @@ ThreadExitProc( if (self == errorThreadId) { if (errorProcString) { /* Extra safety */ - ckfree(errorProcString); + Tcl_Free(errorProcString); errorProcString = NULL; } errorThreadId = 0; } if (threadEvalScript) { - ckfree(threadEvalScript); + Tcl_Free(threadEvalScript); threadEvalScript = NULL; } Tcl_DeleteEvents((Tcl_EventDeleteProc *) ThreadDeleteEvent, NULL); @@ -1181,7 +1180,7 @@ ThreadExitProc( } resultPtr->nextPtr = resultPtr->prevPtr = 0; resultPtr->eventPtr->resultPtr = NULL; - ckfree(resultPtr); + Tcl_Free(resultPtr); } else if (resultPtr->dstThreadId == self) { /* * Dang. The target is going away. Unblock the caller. The result @@ -1191,7 +1190,7 @@ ThreadExitProc( const char *msg = "target thread died"; - resultPtr->result = (char *)ckalloc(strlen(msg) + 1); + resultPtr->result = (char *)Tcl_Alloc(strlen(msg) + 1); strcpy(resultPtr->result, msg); resultPtr->code = TCL_ERROR; Tcl_ConditionNotify(&resultPtr->done); diff --git a/generic/tclTimer.c b/generic/tclTimer.c index e986db7..d49c5c8 100644 --- a/generic/tclTimer.c +++ b/generic/tclTimer.c @@ -211,7 +211,7 @@ InitTimer(void) static void TimerExitProc( - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); @@ -222,7 +222,7 @@ TimerExitProc( timerHandlerPtr = tsdPtr->firstTimerHandlerPtr; while (timerHandlerPtr != NULL) { tsdPtr->firstTimerHandlerPtr = timerHandlerPtr->nextPtr; - ckfree(timerHandlerPtr); + Tcl_Free(timerHandlerPtr); timerHandlerPtr = tsdPtr->firstTimerHandlerPtr; } } @@ -297,7 +297,7 @@ TclCreateAbsoluteTimerHandler( TimerHandler *timerHandlerPtr, *tPtr2, *prevPtr; ThreadSpecificData *tsdPtr = InitTimer(); - timerHandlerPtr = (TimerHandler *)ckalloc(sizeof(TimerHandler)); + timerHandlerPtr = (TimerHandler *)Tcl_Alloc(sizeof(TimerHandler)); /* * Fill in fields for the event. @@ -373,7 +373,7 @@ Tcl_DeleteTimerHandler( } else { prevPtr->nextPtr = timerHandlerPtr->nextPtr; } - ckfree(timerHandlerPtr); + Tcl_Free(timerHandlerPtr); return; } } @@ -398,7 +398,7 @@ Tcl_DeleteTimerHandler( static void TimerSetupProc( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { Tcl_Time blockTime; @@ -456,7 +456,7 @@ TimerSetupProc( static void TimerCheckProc( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { Tcl_Event *timerEvPtr; @@ -488,7 +488,7 @@ TimerCheckProc( if (blockTime.sec == 0 && blockTime.usec == 0 && !tsdPtr->timerPending) { tsdPtr->timerPending = 1; - timerEvPtr = (Tcl_Event *)ckalloc(sizeof(Tcl_Event)); + timerEvPtr = (Tcl_Event *)Tcl_Alloc(sizeof(Tcl_Event)); timerEvPtr->proc = TimerHandlerEventProc; Tcl_QueueEvent(timerEvPtr, TCL_QUEUE_TAIL); } @@ -591,7 +591,7 @@ TimerHandlerEventProc( *nextPtrPtr = timerHandlerPtr->nextPtr; timerHandlerPtr->proc(timerHandlerPtr->clientData); - ckfree(timerHandlerPtr); + Tcl_Free(timerHandlerPtr); } TimerSetupProc(NULL, TCL_TIMER_EVENTS); return 1; @@ -625,7 +625,7 @@ Tcl_DoWhenIdle( Tcl_Time blockTime; ThreadSpecificData *tsdPtr = InitTimer(); - idlePtr = (IdleHandler *)ckalloc(sizeof(IdleHandler)); + idlePtr = (IdleHandler *)Tcl_Alloc(sizeof(IdleHandler)); idlePtr->proc = proc; idlePtr->clientData = clientData; idlePtr->generation = tsdPtr->idleGeneration; @@ -674,7 +674,7 @@ Tcl_CancelIdleCall( while ((idlePtr->proc == proc) && (idlePtr->clientData == clientData)) { nextPtr = idlePtr->nextPtr; - ckfree(idlePtr); + Tcl_Free(idlePtr); idlePtr = nextPtr; if (prevPtr == NULL) { tsdPtr->idleList = idlePtr; @@ -749,7 +749,7 @@ TclServiceIdle(void) tsdPtr->lastIdlePtr = NULL; } idlePtr->proc(idlePtr->clientData); - ckfree(idlePtr); + Tcl_Free(idlePtr); } if (tsdPtr->idleList) { blockTime.sec = 0; @@ -778,7 +778,7 @@ TclServiceIdle(void) int Tcl_AfterObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -787,7 +787,7 @@ Tcl_AfterObjCmd( Tcl_Time wakeup; AfterInfo *afterPtr; AfterAssocData *assocPtr; - int length; + size_t length; int index = -1; static const char *const afterSubCmds[] = { "cancel", "idle", "info", NULL @@ -807,7 +807,7 @@ Tcl_AfterObjCmd( assocPtr = (AfterAssocData *)Tcl_GetAssocData(interp, "tclAfter", NULL); if (assocPtr == NULL) { - assocPtr = (AfterAssocData *)ckalloc(sizeof(AfterAssocData)); + assocPtr = (AfterAssocData *)Tcl_Alloc(sizeof(AfterAssocData)); assocPtr->interp = interp; assocPtr->firstAfterPtr = NULL; Tcl_SetAssocData(interp, "tclAfter", AfterCleanupProc, assocPtr); @@ -820,7 +820,7 @@ Tcl_AfterObjCmd( if (Tcl_GetWideIntFromObj(NULL, objv[1], &ms) != TCL_OK) { if (Tcl_GetIndexFromObj(NULL, objv[1], afterSubCmds, "", 0, &index) != TCL_OK) { - const char *arg = Tcl_GetString(objv[1]); + const char *arg = TclGetString(objv[1]); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad argument \"%s\": must be" @@ -844,7 +844,7 @@ Tcl_AfterObjCmd( if (objc == 2) { return AfterDelay(interp, ms); } - afterPtr = (AfterInfo *)ckalloc(sizeof(AfterInfo)); + afterPtr = (AfterInfo *)Tcl_Alloc(sizeof(AfterInfo)); afterPtr->assocPtr = assocPtr; if (objc == 3) { afterPtr->commandPtr = objv[2]; @@ -882,7 +882,7 @@ Tcl_AfterObjCmd( case AFTER_CANCEL: { Tcl_Obj *commandPtr; const char *command, *tempCommand; - int tempLength; + size_t tempLength; if (objc < 3) { Tcl_WrongNumArgs(interp, 2, objv, "id|command"); @@ -893,10 +893,10 @@ Tcl_AfterObjCmd( } else { commandPtr = Tcl_ConcatObj(objc-2, objv+2); } - command = TclGetStringFromObj(commandPtr, &length); + command = Tcl_GetStringFromObj(commandPtr, &length); for (afterPtr = assocPtr->firstAfterPtr; afterPtr != NULL; afterPtr = afterPtr->nextPtr) { - tempCommand = TclGetStringFromObj(afterPtr->commandPtr, + tempCommand = Tcl_GetStringFromObj(afterPtr->commandPtr, &tempLength); if ((length == tempLength) && !memcmp(command, tempCommand, length)) { @@ -924,7 +924,7 @@ Tcl_AfterObjCmd( Tcl_WrongNumArgs(interp, 2, objv, "script ?script ...?"); return TCL_ERROR; } - afterPtr = (AfterInfo *)ckalloc(sizeof(AfterInfo)); + afterPtr = (AfterInfo *)Tcl_Alloc(sizeof(AfterInfo)); afterPtr->assocPtr = assocPtr; if (objc == 3) { afterPtr->commandPtr = objv[2]; @@ -1191,7 +1191,7 @@ AfterProc( */ Tcl_DecrRefCount(afterPtr->commandPtr); - ckfree(afterPtr); + Tcl_Free(afterPtr); } /* @@ -1229,7 +1229,7 @@ FreeAfterPtr( prevPtr->nextPtr = afterPtr->nextPtr; } Tcl_DecrRefCount(afterPtr->commandPtr); - ckfree(afterPtr); + Tcl_Free(afterPtr); } /* @@ -1267,9 +1267,9 @@ AfterCleanupProc( Tcl_CancelIdleCall(AfterProc, afterPtr); } Tcl_DecrRefCount(afterPtr->commandPtr); - ckfree(afterPtr); + Tcl_Free(afterPtr); } - ckfree(assocPtr); + Tcl_Free(assocPtr); } /* diff --git a/generic/tclTomMath.decls b/generic/tclTomMath.decls index 27c4f98..da3f95d 100644 --- a/generic/tclTomMath.decls +++ b/generic/tclTomMath.decls @@ -32,7 +32,7 @@ declare 2 { mp_err MP_WUR TclBN_mp_add(const mp_int *a, const mp_int *b, mp_int *c) } declare 3 { - mp_err MP_WUR TclBN_mp_add_d(const mp_int *a, unsigned int b, mp_int *c) + mp_err MP_WUR TclBN_mp_add_d(const mp_int *a, mp_digit b, mp_int *c) } declare 4 { mp_err MP_WUR TclBN_mp_and(const mp_int *a, const mp_int *b, mp_int *c) @@ -50,7 +50,7 @@ declare 8 { mp_ord MP_WUR TclBN_mp_cmp(const mp_int *a, const mp_int *b) } declare 9 { - mp_ord MP_WUR TclBN_mp_cmp_d(const mp_int *a, unsigned int b) + mp_ord MP_WUR TclBN_mp_cmp_d(const mp_int *a, mp_digit b) } declare 10 { mp_ord MP_WUR TclBN_mp_cmp_mag(const mp_int *a, const mp_int *b) @@ -65,7 +65,7 @@ declare 13 { mp_err MP_WUR TclBN_mp_div(const mp_int *a, const mp_int *b, mp_int *q, mp_int *r) } declare 14 { - mp_err MP_WUR TclBN_mp_div_d(const mp_int *a, unsigned int b, mp_int *q, unsigned int *r) + mp_err MP_WUR TclBN_mp_div_d(const mp_int *a, mp_digit b, mp_int *q, mp_digit *r) } declare 15 { mp_err MP_WUR TclBN_mp_div_2(const mp_int *a, mp_int *q) @@ -73,14 +73,15 @@ declare 15 { declare 16 { mp_err MP_WUR TclBN_mp_div_2d(const mp_int *a, int b, mp_int *q, mp_int *r) } -declare 17 {deprecated {is private function in libtommath}} { - mp_err TclBN_mp_div_3(const mp_int *a, mp_int *q, unsigned int *r) -} +# Removed in 9.0 +#declare 17 { +# mp_err TclBN_mp_div_3(const mp_int *a, mp_int *q, mp_digit *r) +#} declare 18 { void TclBN_mp_exch(mp_int *a, mp_int *b) } declare 19 { - mp_err MP_WUR TclBN_mp_expt_u32(const mp_int *a, unsigned int b, mp_int *c) + mp_err MP_WUR TclBN_mp_expt_u32(const mp_int *a, uint32_t b, mp_int *c) } declare 20 { mp_err MP_WUR TclBN_mp_grow(mp_int *a, int size) @@ -95,7 +96,7 @@ declare 23 { mp_err MP_WUR TclBN_mp_init_multi(mp_int *a, ...) } declare 24 { - mp_err MP_WUR TclBN_mp_init_set(mp_int *a, unsigned int b) + mp_err MP_WUR TclBN_mp_init_set(mp_int *a, mp_digit b) } declare 25 { mp_err MP_WUR TclBN_mp_init_size(mp_int *a, int size) @@ -113,7 +114,7 @@ declare 29 { mp_err MP_WUR TclBN_mp_mul(const mp_int *a, const mp_int *b, mp_int *p) } declare 30 { - mp_err MP_WUR TclBN_mp_mul_d(const mp_int *a, unsigned int b, mp_int *p) + mp_err MP_WUR TclBN_mp_mul_d(const mp_int *a, mp_digit b, mp_int *p) } declare 31 { mp_err MP_WUR TclBN_mp_mul_2(const mp_int *a, mp_int *p) @@ -139,12 +140,14 @@ declare 37 { declare 38 { mp_err MP_WUR TclBN_mp_shrink(mp_int *a) } -declare 39 {deprecated {macro calling mp_set_u64}} { - void TclBN_mp_set(mp_int *a, unsigned int b) -} -declare 40 {nostub {is private function in libtommath}} { - mp_err TclBN_mp_sqr(const mp_int *a, mp_int *b) -} +# Removed in 9.0 +#declare 39 { +# void TclBN_mp_set(mp_int *a, unsigned int b) +#} +# Removed in 9.0 +#declare 40 {nostub {is private function in libtommath}} { +# mp_err TclBN_mp_sqr(const mp_int *a, mp_int *b) +#} declare 41 { mp_err MP_WUR TclBN_mp_sqrt(const mp_int *a, mp_int *b) } @@ -152,20 +155,23 @@ declare 42 { mp_err MP_WUR TclBN_mp_sub(const mp_int *a, const mp_int *b, mp_int *c) } declare 43 { - mp_err MP_WUR TclBN_mp_sub_d(const mp_int *a, unsigned int b, mp_int *c) -} -declare 44 {deprecated {Use mp_to_ubin}} { - mp_err TclBN_mp_to_unsigned_bin(const mp_int *a, unsigned char *b) -} -declare 45 {deprecated {Use mp_to_ubin}} { - mp_err TclBN_mp_to_unsigned_bin_n(const mp_int *a, unsigned char *b, - unsigned long *outlen) -} -declare 46 {deprecated {Use mp_to_radix}} { - mp_err TclBN_mp_toradix_n(const mp_int *a, char *str, int radix, int maxlen) -} + mp_err MP_WUR TclBN_mp_sub_d(const mp_int *a, mp_digit b, mp_int *c) +} +# Removed in 9.0 +#declare 44 { +# mp_err TclBN_mp_to_unsigned_bin(const mp_int *a, unsigned char *b) +#} +# Removed in 9.0 +#declare 45 { +# mp_err TclBN_mp_to_unsigned_bin_n(const mp_int *a, unsigned char *b, +# unsigned long *outlen) +#} +# Removed in 9.0 +#declare 46 { +# mp_err TclBN_mp_toradix_n(const mp_int *a, char *str, int radix, int maxlen) +#} declare 47 { - size_t TclBN_mp_ubin_size(const mp_int *a) + size_t MP_WUR TclBN_mp_ubin_size(const mp_int *a) } declare 48 { mp_err MP_WUR TclBN_mp_xor(const mp_int *a, const mp_int *b, mp_int *c) @@ -173,55 +179,21 @@ declare 48 { declare 49 { void TclBN_mp_zero(mp_int *a) } - -# internal routines to libtommath - should not be called but must be -# exported to accommodate the "tommath" extension - -declare 50 {deprecated {is private function in libtommath}} { - void TclBN_reverse(unsigned char *s, int len) -} -declare 51 {deprecated {is private function in libtommath}} { - mp_err TclBN_s_mp_mul_digs_fast(const mp_int *a, const mp_int *b, mp_int *c, int digs) -} -declare 52 {deprecated {is private function in libtommath}} { - mp_err TclBN_s_mp_sqr_fast(const mp_int *a, mp_int *b) -} -declare 53 {deprecated {is private function in libtommath}} { - mp_err TclBN_mp_karatsuba_mul(const mp_int *a, const mp_int *b, mp_int *c) -} -declare 54 {deprecated {is private function in libtommath}} { - mp_err TclBN_mp_karatsuba_sqr(const mp_int *a, mp_int *b) -} -declare 55 {deprecated {is private function in libtommath}} { - mp_err TclBN_mp_toom_mul(const mp_int *a, const mp_int *b, mp_int *c) -} -declare 56 {deprecated {is private function in libtommath}} { - mp_err TclBN_mp_toom_sqr(const mp_int *a, mp_int *b) -} -declare 57 {deprecated {is private function in libtommath}} { - mp_err TclBN_s_mp_add(const mp_int *a, const mp_int *b, mp_int *c) -} -declare 58 {deprecated {is private function in libtommath}} { - mp_err TclBN_s_mp_mul_digs(const mp_int *a, const mp_int *b, mp_int *c, int digs) -} -declare 59 {deprecated {is private function in libtommath}} { - mp_err TclBN_s_mp_sqr(const mp_int *a, mp_int *b) -} -declare 60 {deprecated {is private function in libtommath}} { - mp_err TclBN_s_mp_sub(const mp_int *a, const mp_int *b, mp_int *c) -} -declare 61 {deprecated {macro calling mp_init_u64}} { - mp_err TclBN_mp_init_ul(mp_int *a, unsigned long i) -} -declare 62 {deprecated {macro calling mp_set_u64}} { - void TclBN_mp_set_ul(mp_int *a, unsigned long i) -} +# Removed in 9.0 +#declare 61 { +# mp_err TclBN_mp_init_ul(mp_int *a, unsigned long i) +#} +# Removed in 9.0 +#declare 62 { +# void TclBN_mp_set_ul(mp_int *a, unsigned long i) +#} declare 63 { int MP_WUR TclBN_mp_cnt_lsb(const mp_int *a) } -declare 64 {deprecated {macro calling mp_init_i64}} { - int TclBN_mp_init_l(mp_int *bignum, long initVal) -} +# Removed in 9.0 +#declare 64 { +# int TclBN_mp_init_l(mp_int *bignum, long initVal) +#} declare 65 { int MP_WUR TclBN_mp_init_i64(mp_int *bignum, int64_t initVal) } @@ -229,10 +201,10 @@ declare 66 { int MP_WUR TclBN_mp_init_u64(mp_int *bignum, uint64_t initVal) } -# Added in libtommath 1.0 -declare 67 {deprecated {Use mp_expt_u32}} { - mp_err TclBN_mp_expt_d_ex(const mp_int *a, unsigned int b, mp_int *c, int fast) -} +# Removed in 9.0 +#declare 67 { +# mp_err TclBN_mp_expt_d_ex(const mp_int *a, mp_digit b, mp_int *c, int fast) +#} # Added in libtommath 1.0.1 declare 68 { void TclBN_mp_set_u64(mp_int *a, uint64_t i) @@ -253,15 +225,18 @@ declare 72 { } # Added in libtommath 1.1.0 -declare 73 {deprecated {merged with mp_and}} { - mp_err TclBN_mp_tc_and(const mp_int *a, const mp_int *b, mp_int *c) -} -declare 74 {deprecated {merged with mp_or}} { - mp_err TclBN_mp_tc_or(const mp_int *a, const mp_int *b, mp_int *c) -} -declare 75 {deprecated {merged with mp_xor}} { - mp_err TclBN_mp_tc_xor(const mp_int *a, const mp_int *b, mp_int *c) -} +# No longer in use: replaced by mp_and() +#declare 73 { +# int TclBN_mp_tc_and(const mp_int *a, const mp_int *b, mp_int *c) +#} +# No longer in use: replaced by mp_or() +#declare 74 { +# int TclBN_mp_tc_or(const mp_int *a, const mp_int *b, mp_int *c) +#} +# No longer in use: replaced by mp_xor() +#declare 75 { +# int TclBN_mp_tc_xor(const mp_int *a, const mp_int *b, mp_int *c) +#} declare 76 { mp_err MP_WUR TclBN_mp_signed_rsh(const mp_int *a, int b, mp_int *c) } @@ -273,9 +248,10 @@ declare 77 { declare 78 { int MP_WUR TclBN_mp_to_ubin(const mp_int *a, unsigned char *buf, size_t maxlen, size_t *written) } -declare 79 { - mp_err MP_WUR TclBN_mp_div_ld(const mp_int *a, uint64_t b, mp_int *q, uint64_t *r) -} +# Removed in 9.0 +#declare 79 { +# mp_err MP_WUR TclBN_mp_div_ld(const mp_int *a, mp_digit b, mp_int *q, mp_digit *r) +#} declare 80 { int MP_WUR TclBN_mp_to_radix(const mp_int *a, char *str, size_t maxlen, size_t *written, int radix) } diff --git a/generic/tclTomMathDecls.h b/generic/tclTomMathDecls.h index 009f914..10f1a6a 100644 --- a/generic/tclTomMathDecls.h +++ b/generic/tclTomMathDecls.h @@ -35,13 +35,13 @@ /* Define custom memory allocation for libtommath */ /* MODULE_SCOPE void* TclBNAlloc( size_t ); */ -#define TclBNAlloc(s) ((void*)ckalloc((size_t)(s))) +#define TclBNAlloc(s) ((void*)Tcl_Alloc(s)) /* MODULE_SCOPE void* TclBNCalloc( size_t, size_t ); */ -#define TclBNCalloc(m,s) memset(ckalloc((size_t)(m)*(size_t)(s)),0,(size_t)(m)*(size_t)(s)) +#define TclBNCalloc(m,s) memset(Tcl_Alloc((size_t)(m)*(size_t)(s)),0,(size_t)(m)*(size_t)(s)) /* MODULE_SCOPE void* TclBNRealloc( void*, size_t ); */ -#define TclBNRealloc(x,s) ((void*)ckrealloc((char*)(x),(size_t)(s))) +#define TclBNRealloc(x,s) ((void*)Tcl_Realloc((char*)(x),(size_t)(s))) /* MODULE_SCOPE void TclBNFree( void* ); */ -#define TclBNFree(x) (ckfree((char*)(x))) +#define TclBNFree(x) (Tcl_Free((char*)(x))) #undef MP_MALLOC #undef MP_CALLOC @@ -63,17 +63,20 @@ #ifdef __cplusplus extern "C" { #endif -MODULE_SCOPE mp_err TclBN_s_mp_add_d(const mp_int *a, mp_digit b, mp_int *c); -MODULE_SCOPE mp_ord TclBN_s_mp_cmp_d(const mp_int *a, mp_digit b); -MODULE_SCOPE mp_err TclBN_s_mp_div_d(const mp_int *a, mp_digit b, mp_int *c, mp_digit *d); -MODULE_SCOPE mp_err TclBN_s_mp_div_3(const mp_int *a, mp_int *c, mp_digit *b); -MODULE_SCOPE mp_err TclBN_s_mp_expt_u32(const mp_int *a, uint32_t b, mp_int *c); -MODULE_SCOPE mp_err TclBN_s_mp_init_set(mp_int *a, mp_digit b); -MODULE_SCOPE mp_err TclBN_s_mp_mul_d(const mp_int *a, mp_digit b, mp_int *c); -MODULE_SCOPE void TclBN_s_mp_reverse(unsigned char *s, size_t len); -MODULE_SCOPE void TclBN_s_mp_set(mp_int *a, mp_digit b); -MODULE_SCOPE mp_err TclBN_s_mp_sub_d(const mp_int *a, mp_digit b, mp_int *c); -MODULE_SCOPE mp_err TclBN_s_mp_balance_mul(const mp_int *a, const mp_int *b, mp_int *c); +MODULE_SCOPE mp_err TclBN_mp_sqr(const mp_int *a, mp_int *b); +MODULE_SCOPE mp_err TclBN_mp_div_3(const mp_int *a, mp_int *q, mp_digit *r); +MODULE_SCOPE mp_err TclBN_mp_balance_mul(const mp_int *a, const mp_int *b, mp_int *c); +MODULE_SCOPE mp_err TclBN_mp_karatsuba_mul(const mp_int *a, const mp_int *b, mp_int *c); +MODULE_SCOPE mp_err TclBN_mp_karatsuba_sqr(const mp_int *a, mp_int *b); +MODULE_SCOPE mp_err TclBN_mp_toom_mul(const mp_int *a, const mp_int *b, mp_int *c); +MODULE_SCOPE mp_err TclBN_mp_toom_sqr(const mp_int *a, mp_int *b); +MODULE_SCOPE mp_err TclBN_s_mp_add(const mp_int *a, const mp_int *b, mp_int *c); +MODULE_SCOPE mp_err TclBN_s_mp_mul_digs(const mp_int *a, const mp_int *b, mp_int *c, int digs); +MODULE_SCOPE mp_err TclBN_s_mp_mul_digs_fast(const mp_int *a, const mp_int *b, mp_int *c, int digs); +MODULE_SCOPE void TclBN_s_mp_reverse(unsigned char *s, size_t len); +MODULE_SCOPE mp_err TclBN_s_mp_sqr(const mp_int *a, mp_int *b); +MODULE_SCOPE mp_err TclBN_s_mp_sqr_fast(const mp_int *a, mp_int *b); +MODULE_SCOPE mp_err TclBN_s_mp_sub(const mp_int *a, const mp_int *b, mp_int *c); MODULE_SCOPE const char *const TclBN_mp_s_rmap; MODULE_SCOPE const uint8_t TclBN_mp_s_rmap_reverse[]; MODULE_SCOPE const size_t TclBN_mp_s_rmap_reverse_sz; @@ -87,40 +90,40 @@ MODULE_SCOPE mp_err TclBN_mp_set_int(mp_int *a, unsigned long b); #ifndef TCL_WITH_EXTERNAL_TOMMATH #define bn_reverse TclBN_reverse #define mp_add TclBN_mp_add -#define mp_add_d TclBN_s_mp_add_d +#define mp_add_d TclBN_mp_add_d #define mp_and TclBN_mp_and #define mp_clamp TclBN_mp_clamp #define mp_clear TclBN_mp_clear #define mp_clear_multi TclBN_mp_clear_multi #define mp_cmp TclBN_mp_cmp -#define mp_cmp_d TclBN_s_mp_cmp_d +#define mp_cmp_d TclBN_mp_cmp_d #define mp_cmp_mag TclBN_mp_cmp_mag #define mp_cnt_lsb TclBN_mp_cnt_lsb #define mp_copy TclBN_mp_copy #define mp_count_bits TclBN_mp_count_bits #define mp_div TclBN_mp_div -#define mp_div_d TclBN_s_mp_div_d +#define mp_div_d TclBN_mp_div_d #define mp_div_2 TclBN_mp_div_2 -#define mp_div_3 TclBN_s_mp_div_3 +#define mp_div_3 TclBN_mp_div_3 #define mp_div_2d TclBN_mp_div_2d #define mp_exch TclBN_mp_exch #define mp_expt_d TclBN_mp_expt_d #define mp_expt_d_ex TclBN_mp_expt_d_ex -#define mp_expt_u32 TclBN_s_mp_expt_u32 +#define mp_expt_u32 TclBN_mp_expt_u32 #define mp_get_mag_u64 TclBN_mp_get_mag_u64 #define mp_grow TclBN_mp_grow #define mp_init TclBN_mp_init #define mp_init_copy TclBN_mp_init_copy #define mp_init_i64 TclBN_mp_init_i64 #define mp_init_multi TclBN_mp_init_multi -#define mp_init_set TclBN_s_mp_init_set +#define mp_init_set TclBN_mp_init_set #define mp_init_size TclBN_mp_init_size #define mp_init_u64 TclBN_mp_init_u64 #define mp_lshd TclBN_mp_lshd #define mp_mod TclBN_mp_mod #define mp_mod_2d TclBN_mp_mod_2d #define mp_mul TclBN_mp_mul -#define mp_mul_d TclBN_s_mp_mul_d +#define mp_mul_d TclBN_mp_mul_d #define mp_mul_2 TclBN_mp_mul_2 #define mp_mul_2d TclBN_mp_mul_2d #define mp_neg TclBN_mp_neg @@ -140,7 +143,7 @@ MODULE_SCOPE mp_err TclBN_mp_set_int(mp_int *a, unsigned long b); #define mp_sqr TclBN_mp_sqr #define mp_sqrt TclBN_mp_sqrt #define mp_sub TclBN_mp_sub -#define mp_sub_d TclBN_s_mp_sub_d +#define mp_sub_d TclBN_mp_sub_d #define mp_signed_rsh TclBN_mp_signed_rsh #define mp_tc_and TclBN_mp_and #define mp_tc_div_2d TclBN_mp_signed_rsh @@ -156,7 +159,7 @@ MODULE_SCOPE mp_err TclBN_mp_set_int(mp_int *a, unsigned long b); #define mp_xor TclBN_mp_xor #define mp_zero TclBN_mp_zero #define s_mp_add TclBN_s_mp_add -#define s_mp_balance_mul TclBN_s_mp_balance_mul +#define s_mp_balance_mul TclBN_mp_balance_mul #define s_mp_karatsuba_mul TclBN_mp_karatsuba_mul #define s_mp_karatsuba_sqr TclBN_mp_karatsuba_sqr #define s_mp_mul_digs TclBN_s_mp_mul_digs @@ -169,12 +172,6 @@ MODULE_SCOPE mp_err TclBN_mp_set_int(mp_int *a, unsigned long b); #define s_mp_toom_sqr TclBN_mp_toom_sqr #endif /* !TCL_WITH_EXTERNAL_TOMMATH */ -#define mp_init_set_int(a,b) (MP_DEPRECATED_PRAGMA("replaced by mp_init_ul") mp_init_u64(a,(unsigned int)(b))) -#define mp_set_int(a,b) (MP_DEPRECATED_PRAGMA("replaced by mp_set_ul") (mp_set_u64((a),((unsigned int)(b))),MP_OKAY)) -#define mp_set_long(a,b) (MP_DEPRECATED_PRAGMA("replaced by mp_set_ul") (mp_set_u64((a),(long)(b)),MP_OKAY)) -#define mp_set_long_long(a,b) (MP_DEPRECATED_PRAGMA("replaced by mp_set_u64") (mp_set_u64((a),(b)),MP_OKAY)) -#define mp_unsigned_bin_size(mp) (MP_DEPRECATED_PRAGMA("replaced by mp_ubin_size") (int)mp_ubin_size(mp)) - #undef TCL_STORAGE_CLASS #ifdef BUILD_tcl # define TCL_STORAGE_CLASS DLLEXPORT @@ -210,7 +207,7 @@ EXTERN int TclBN_revision(void) MP_WUR; EXTERN mp_err TclBN_mp_add(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; /* 3 */ -EXTERN mp_err TclBN_mp_add_d(const mp_int *a, unsigned int b, +EXTERN mp_err TclBN_mp_add_d(const mp_int *a, mp_digit b, mp_int *c) MP_WUR; /* 4 */ EXTERN mp_err TclBN_mp_and(const mp_int *a, const mp_int *b, @@ -224,7 +221,7 @@ EXTERN void TclBN_mp_clear_multi(mp_int *a, ...); /* 8 */ EXTERN mp_ord TclBN_mp_cmp(const mp_int *a, const mp_int *b) MP_WUR; /* 9 */ -EXTERN mp_ord TclBN_mp_cmp_d(const mp_int *a, unsigned int b) MP_WUR; +EXTERN mp_ord TclBN_mp_cmp_d(const mp_int *a, mp_digit b) MP_WUR; /* 10 */ EXTERN mp_ord TclBN_mp_cmp_mag(const mp_int *a, const mp_int *b) MP_WUR; /* 11 */ @@ -235,21 +232,18 @@ EXTERN int TclBN_mp_count_bits(const mp_int *a) MP_WUR; EXTERN mp_err TclBN_mp_div(const mp_int *a, const mp_int *b, mp_int *q, mp_int *r) MP_WUR; /* 14 */ -EXTERN mp_err TclBN_mp_div_d(const mp_int *a, unsigned int b, - mp_int *q, unsigned int *r) MP_WUR; +EXTERN mp_err TclBN_mp_div_d(const mp_int *a, mp_digit b, + mp_int *q, mp_digit *r) MP_WUR; /* 15 */ EXTERN mp_err TclBN_mp_div_2(const mp_int *a, mp_int *q) MP_WUR; /* 16 */ EXTERN mp_err TclBN_mp_div_2d(const mp_int *a, int b, mp_int *q, mp_int *r) MP_WUR; -/* 17 */ -TCL_DEPRECATED("is private function in libtommath") -mp_err TclBN_mp_div_3(const mp_int *a, mp_int *q, - unsigned int *r); +/* Slot 17 is reserved */ /* 18 */ EXTERN void TclBN_mp_exch(mp_int *a, mp_int *b); /* 19 */ -EXTERN mp_err TclBN_mp_expt_u32(const mp_int *a, unsigned int b, +EXTERN mp_err TclBN_mp_expt_u32(const mp_int *a, uint32_t b, mp_int *c) MP_WUR; /* 20 */ EXTERN mp_err TclBN_mp_grow(mp_int *a, int size) MP_WUR; @@ -260,7 +254,7 @@ EXTERN mp_err TclBN_mp_init_copy(mp_int *a, const mp_int *b) MP_WUR; /* 23 */ EXTERN mp_err TclBN_mp_init_multi(mp_int *a, ...) MP_WUR; /* 24 */ -EXTERN mp_err TclBN_mp_init_set(mp_int *a, unsigned int b) MP_WUR; +EXTERN mp_err TclBN_mp_init_set(mp_int *a, mp_digit b) MP_WUR; /* 25 */ EXTERN mp_err TclBN_mp_init_size(mp_int *a, int size) MP_WUR; /* 26 */ @@ -274,7 +268,7 @@ EXTERN mp_err TclBN_mp_mod_2d(const mp_int *a, int b, mp_int *r) MP_WUR; EXTERN mp_err TclBN_mp_mul(const mp_int *a, const mp_int *b, mp_int *p) MP_WUR; /* 30 */ -EXTERN mp_err TclBN_mp_mul_d(const mp_int *a, unsigned int b, +EXTERN mp_err TclBN_mp_mul_d(const mp_int *a, mp_digit b, mp_int *p) MP_WUR; /* 31 */ EXTERN mp_err TclBN_mp_mul_2(const mp_int *a, mp_int *p) MP_WUR; @@ -295,96 +289,47 @@ EXTERN mp_err TclBN_mp_read_radix(mp_int *a, const char *str, EXTERN void TclBN_mp_rshd(mp_int *a, int shift); /* 38 */ EXTERN mp_err TclBN_mp_shrink(mp_int *a) MP_WUR; -/* 39 */ -TCL_DEPRECATED("macro calling mp_set_u64") -void TclBN_mp_set(mp_int *a, unsigned int b); -/* 40 */ -EXTERN mp_err TclBN_mp_sqr(const mp_int *a, mp_int *b); +/* Slot 39 is reserved */ +/* Slot 40 is reserved */ /* 41 */ EXTERN mp_err TclBN_mp_sqrt(const mp_int *a, mp_int *b) MP_WUR; /* 42 */ EXTERN mp_err TclBN_mp_sub(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; /* 43 */ -EXTERN mp_err TclBN_mp_sub_d(const mp_int *a, unsigned int b, +EXTERN mp_err TclBN_mp_sub_d(const mp_int *a, mp_digit b, mp_int *c) MP_WUR; -/* 44 */ -TCL_DEPRECATED("Use mp_to_ubin") -mp_err TclBN_mp_to_unsigned_bin(const mp_int *a, - unsigned char *b); -/* 45 */ -TCL_DEPRECATED("Use mp_to_ubin") -mp_err TclBN_mp_to_unsigned_bin_n(const mp_int *a, - unsigned char *b, unsigned long *outlen); -/* 46 */ -TCL_DEPRECATED("Use mp_to_radix") -mp_err TclBN_mp_toradix_n(const mp_int *a, char *str, - int radix, int maxlen); +/* Slot 44 is reserved */ +/* Slot 45 is reserved */ +/* Slot 46 is reserved */ /* 47 */ -EXTERN size_t TclBN_mp_ubin_size(const mp_int *a); +EXTERN size_t TclBN_mp_ubin_size(const mp_int *a) MP_WUR; /* 48 */ EXTERN mp_err TclBN_mp_xor(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; /* 49 */ EXTERN void TclBN_mp_zero(mp_int *a); -/* 50 */ -TCL_DEPRECATED("is private function in libtommath") -void TclBN_reverse(unsigned char *s, int len); -/* 51 */ -TCL_DEPRECATED("is private function in libtommath") -mp_err TclBN_s_mp_mul_digs_fast(const mp_int *a, - const mp_int *b, mp_int *c, int digs); -/* 52 */ -TCL_DEPRECATED("is private function in libtommath") -mp_err TclBN_s_mp_sqr_fast(const mp_int *a, mp_int *b); -/* 53 */ -TCL_DEPRECATED("is private function in libtommath") -mp_err TclBN_mp_karatsuba_mul(const mp_int *a, - const mp_int *b, mp_int *c); -/* 54 */ -TCL_DEPRECATED("is private function in libtommath") -mp_err TclBN_mp_karatsuba_sqr(const mp_int *a, mp_int *b); -/* 55 */ -TCL_DEPRECATED("is private function in libtommath") -mp_err TclBN_mp_toom_mul(const mp_int *a, const mp_int *b, - mp_int *c); -/* 56 */ -TCL_DEPRECATED("is private function in libtommath") -mp_err TclBN_mp_toom_sqr(const mp_int *a, mp_int *b); -/* 57 */ -TCL_DEPRECATED("is private function in libtommath") -mp_err TclBN_s_mp_add(const mp_int *a, const mp_int *b, - mp_int *c); -/* 58 */ -TCL_DEPRECATED("is private function in libtommath") -mp_err TclBN_s_mp_mul_digs(const mp_int *a, const mp_int *b, - mp_int *c, int digs); -/* 59 */ -TCL_DEPRECATED("is private function in libtommath") -mp_err TclBN_s_mp_sqr(const mp_int *a, mp_int *b); -/* 60 */ -TCL_DEPRECATED("is private function in libtommath") -mp_err TclBN_s_mp_sub(const mp_int *a, const mp_int *b, - mp_int *c); -/* 61 */ -TCL_DEPRECATED("macro calling mp_init_u64") -mp_err TclBN_mp_init_ul(mp_int *a, unsigned long i); -/* 62 */ -TCL_DEPRECATED("macro calling mp_set_u64") -void TclBN_mp_set_ul(mp_int *a, unsigned long i); +/* Slot 50 is reserved */ +/* Slot 51 is reserved */ +/* Slot 52 is reserved */ +/* Slot 53 is reserved */ +/* Slot 54 is reserved */ +/* Slot 55 is reserved */ +/* Slot 56 is reserved */ +/* Slot 57 is reserved */ +/* Slot 58 is reserved */ +/* Slot 59 is reserved */ +/* Slot 60 is reserved */ +/* Slot 61 is reserved */ +/* Slot 62 is reserved */ /* 63 */ EXTERN int TclBN_mp_cnt_lsb(const mp_int *a) MP_WUR; -/* 64 */ -TCL_DEPRECATED("macro calling mp_init_i64") -int TclBN_mp_init_l(mp_int *bignum, long initVal); +/* Slot 64 is reserved */ /* 65 */ EXTERN int TclBN_mp_init_i64(mp_int *bignum, int64_t initVal) MP_WUR; /* 66 */ EXTERN int TclBN_mp_init_u64(mp_int *bignum, uint64_t initVal) MP_WUR; -/* 67 */ -TCL_DEPRECATED("Use mp_expt_u32") -mp_err TclBN_mp_expt_d_ex(const mp_int *a, unsigned int b, - mp_int *c, int fast); +/* Slot 67 is reserved */ /* 68 */ EXTERN void TclBN_mp_set_u64(mp_int *a, uint64_t i); /* 69 */ @@ -401,18 +346,9 @@ EXTERN mp_err TclBN_mp_pack(void *rop, size_t maxcount, size_t *written, mp_order order, size_t size, mp_endian endian, size_t nails, const mp_int *op) MP_WUR; -/* 73 */ -TCL_DEPRECATED("merged with mp_and") -mp_err TclBN_mp_tc_and(const mp_int *a, const mp_int *b, - mp_int *c); -/* 74 */ -TCL_DEPRECATED("merged with mp_or") -mp_err TclBN_mp_tc_or(const mp_int *a, const mp_int *b, - mp_int *c); -/* 75 */ -TCL_DEPRECATED("merged with mp_xor") -mp_err TclBN_mp_tc_xor(const mp_int *a, const mp_int *b, - mp_int *c); +/* Slot 73 is reserved */ +/* Slot 74 is reserved */ +/* Slot 75 is reserved */ /* 76 */ EXTERN mp_err TclBN_mp_signed_rsh(const mp_int *a, int b, mp_int *c) MP_WUR; @@ -422,9 +358,7 @@ EXTERN size_t TclBN_mp_pack_count(const mp_int *a, size_t nails, /* 78 */ EXTERN int TclBN_mp_to_ubin(const mp_int *a, unsigned char *buf, size_t maxlen, size_t *written) MP_WUR; -/* 79 */ -EXTERN mp_err TclBN_mp_div_ld(const mp_int *a, uint64_t b, - mp_int *q, uint64_t *r) MP_WUR; +/* Slot 79 is reserved */ /* 80 */ EXTERN int TclBN_mp_to_radix(const mp_int *a, char *str, size_t maxlen, size_t *written, int radix) MP_WUR; @@ -436,34 +370,34 @@ typedef struct TclTomMathStubs { int (*tclBN_epoch) (void) MP_WUR; /* 0 */ int (*tclBN_revision) (void) MP_WUR; /* 1 */ mp_err (*tclBN_mp_add) (const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; /* 2 */ - mp_err (*tclBN_mp_add_d) (const mp_int *a, unsigned int b, mp_int *c) MP_WUR; /* 3 */ + mp_err (*tclBN_mp_add_d) (const mp_int *a, mp_digit b, mp_int *c) MP_WUR; /* 3 */ mp_err (*tclBN_mp_and) (const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; /* 4 */ void (*tclBN_mp_clamp) (mp_int *a); /* 5 */ void (*tclBN_mp_clear) (mp_int *a); /* 6 */ void (*tclBN_mp_clear_multi) (mp_int *a, ...); /* 7 */ mp_ord (*tclBN_mp_cmp) (const mp_int *a, const mp_int *b) MP_WUR; /* 8 */ - mp_ord (*tclBN_mp_cmp_d) (const mp_int *a, unsigned int b) MP_WUR; /* 9 */ + mp_ord (*tclBN_mp_cmp_d) (const mp_int *a, mp_digit b) MP_WUR; /* 9 */ mp_ord (*tclBN_mp_cmp_mag) (const mp_int *a, const mp_int *b) MP_WUR; /* 10 */ mp_err (*tclBN_mp_copy) (const mp_int *a, mp_int *b) MP_WUR; /* 11 */ int (*tclBN_mp_count_bits) (const mp_int *a) MP_WUR; /* 12 */ mp_err (*tclBN_mp_div) (const mp_int *a, const mp_int *b, mp_int *q, mp_int *r) MP_WUR; /* 13 */ - mp_err (*tclBN_mp_div_d) (const mp_int *a, unsigned int b, mp_int *q, unsigned int *r) MP_WUR; /* 14 */ + mp_err (*tclBN_mp_div_d) (const mp_int *a, mp_digit b, mp_int *q, mp_digit *r) MP_WUR; /* 14 */ mp_err (*tclBN_mp_div_2) (const mp_int *a, mp_int *q) MP_WUR; /* 15 */ mp_err (*tclBN_mp_div_2d) (const mp_int *a, int b, mp_int *q, mp_int *r) MP_WUR; /* 16 */ - TCL_DEPRECATED_API("is private function in libtommath") mp_err (*tclBN_mp_div_3) (const mp_int *a, mp_int *q, unsigned int *r); /* 17 */ + void (*reserved17)(void); void (*tclBN_mp_exch) (mp_int *a, mp_int *b); /* 18 */ - mp_err (*tclBN_mp_expt_u32) (const mp_int *a, unsigned int b, mp_int *c) MP_WUR; /* 19 */ + mp_err (*tclBN_mp_expt_u32) (const mp_int *a, uint32_t b, mp_int *c) MP_WUR; /* 19 */ mp_err (*tclBN_mp_grow) (mp_int *a, int size) MP_WUR; /* 20 */ mp_err (*tclBN_mp_init) (mp_int *a) MP_WUR; /* 21 */ mp_err (*tclBN_mp_init_copy) (mp_int *a, const mp_int *b) MP_WUR; /* 22 */ mp_err (*tclBN_mp_init_multi) (mp_int *a, ...) MP_WUR; /* 23 */ - mp_err (*tclBN_mp_init_set) (mp_int *a, unsigned int b) MP_WUR; /* 24 */ + mp_err (*tclBN_mp_init_set) (mp_int *a, mp_digit b) MP_WUR; /* 24 */ mp_err (*tclBN_mp_init_size) (mp_int *a, int size) MP_WUR; /* 25 */ mp_err (*tclBN_mp_lshd) (mp_int *a, int shift) MP_WUR; /* 26 */ mp_err (*tclBN_mp_mod) (const mp_int *a, const mp_int *b, mp_int *r) MP_WUR; /* 27 */ mp_err (*tclBN_mp_mod_2d) (const mp_int *a, int b, mp_int *r) MP_WUR; /* 28 */ mp_err (*tclBN_mp_mul) (const mp_int *a, const mp_int *b, mp_int *p) MP_WUR; /* 29 */ - mp_err (*tclBN_mp_mul_d) (const mp_int *a, unsigned int b, mp_int *p) MP_WUR; /* 30 */ + mp_err (*tclBN_mp_mul_d) (const mp_int *a, mp_digit b, mp_int *p) MP_WUR; /* 30 */ mp_err (*tclBN_mp_mul_2) (const mp_int *a, mp_int *p) MP_WUR; /* 31 */ mp_err (*tclBN_mp_mul_2d) (const mp_int *a, int d, mp_int *p) MP_WUR; /* 32 */ mp_err (*tclBN_mp_neg) (const mp_int *a, mp_int *b) MP_WUR; /* 33 */ @@ -472,47 +406,47 @@ typedef struct TclTomMathStubs { mp_err (*tclBN_mp_read_radix) (mp_int *a, const char *str, int radix) MP_WUR; /* 36 */ void (*tclBN_mp_rshd) (mp_int *a, int shift); /* 37 */ mp_err (*tclBN_mp_shrink) (mp_int *a) MP_WUR; /* 38 */ - TCL_DEPRECATED_API("macro calling mp_set_u64") void (*tclBN_mp_set) (mp_int *a, unsigned int b); /* 39 */ - TCL_DEPRECATED_API("is private function in libtommath") mp_err (*tclBN_mp_sqr) (const mp_int *a, mp_int *b); /* 40 */ + void (*reserved39)(void); + void (*reserved40)(void); mp_err (*tclBN_mp_sqrt) (const mp_int *a, mp_int *b) MP_WUR; /* 41 */ mp_err (*tclBN_mp_sub) (const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; /* 42 */ - mp_err (*tclBN_mp_sub_d) (const mp_int *a, unsigned int b, mp_int *c) MP_WUR; /* 43 */ - TCL_DEPRECATED_API("Use mp_to_ubin") mp_err (*tclBN_mp_to_unsigned_bin) (const mp_int *a, unsigned char *b); /* 44 */ - TCL_DEPRECATED_API("Use mp_to_ubin") mp_err (*tclBN_mp_to_unsigned_bin_n) (const mp_int *a, unsigned char *b, unsigned long *outlen); /* 45 */ - TCL_DEPRECATED_API("Use mp_to_radix") mp_err (*tclBN_mp_toradix_n) (const mp_int *a, char *str, int radix, int maxlen); /* 46 */ - size_t (*tclBN_mp_ubin_size) (const mp_int *a); /* 47 */ + mp_err (*tclBN_mp_sub_d) (const mp_int *a, mp_digit b, mp_int *c) MP_WUR; /* 43 */ + void (*reserved44)(void); + void (*reserved45)(void); + void (*reserved46)(void); + size_t (*tclBN_mp_ubin_size) (const mp_int *a) MP_WUR; /* 47 */ mp_err (*tclBN_mp_xor) (const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; /* 48 */ void (*tclBN_mp_zero) (mp_int *a); /* 49 */ - TCL_DEPRECATED_API("is private function in libtommath") void (*tclBN_reverse) (unsigned char *s, int len); /* 50 */ - TCL_DEPRECATED_API("is private function in libtommath") mp_err (*tclBN_s_mp_mul_digs_fast) (const mp_int *a, const mp_int *b, mp_int *c, int digs); /* 51 */ - TCL_DEPRECATED_API("is private function in libtommath") mp_err (*tclBN_s_mp_sqr_fast) (const mp_int *a, mp_int *b); /* 52 */ - TCL_DEPRECATED_API("is private function in libtommath") mp_err (*tclBN_mp_karatsuba_mul) (const mp_int *a, const mp_int *b, mp_int *c); /* 53 */ - TCL_DEPRECATED_API("is private function in libtommath") mp_err (*tclBN_mp_karatsuba_sqr) (const mp_int *a, mp_int *b); /* 54 */ - TCL_DEPRECATED_API("is private function in libtommath") mp_err (*tclBN_mp_toom_mul) (const mp_int *a, const mp_int *b, mp_int *c); /* 55 */ - TCL_DEPRECATED_API("is private function in libtommath") mp_err (*tclBN_mp_toom_sqr) (const mp_int *a, mp_int *b); /* 56 */ - TCL_DEPRECATED_API("is private function in libtommath") mp_err (*tclBN_s_mp_add) (const mp_int *a, const mp_int *b, mp_int *c); /* 57 */ - TCL_DEPRECATED_API("is private function in libtommath") mp_err (*tclBN_s_mp_mul_digs) (const mp_int *a, const mp_int *b, mp_int *c, int digs); /* 58 */ - TCL_DEPRECATED_API("is private function in libtommath") mp_err (*tclBN_s_mp_sqr) (const mp_int *a, mp_int *b); /* 59 */ - TCL_DEPRECATED_API("is private function in libtommath") mp_err (*tclBN_s_mp_sub) (const mp_int *a, const mp_int *b, mp_int *c); /* 60 */ - TCL_DEPRECATED_API("macro calling mp_init_u64") mp_err (*tclBN_mp_init_ul) (mp_int *a, unsigned long i); /* 61 */ - TCL_DEPRECATED_API("macro calling mp_set_u64") void (*tclBN_mp_set_ul) (mp_int *a, unsigned long i); /* 62 */ + void (*reserved50)(void); + void (*reserved51)(void); + void (*reserved52)(void); + void (*reserved53)(void); + void (*reserved54)(void); + void (*reserved55)(void); + void (*reserved56)(void); + void (*reserved57)(void); + void (*reserved58)(void); + void (*reserved59)(void); + void (*reserved60)(void); + void (*reserved61)(void); + void (*reserved62)(void); int (*tclBN_mp_cnt_lsb) (const mp_int *a) MP_WUR; /* 63 */ - TCL_DEPRECATED_API("macro calling mp_init_i64") int (*tclBN_mp_init_l) (mp_int *bignum, long initVal); /* 64 */ + void (*reserved64)(void); int (*tclBN_mp_init_i64) (mp_int *bignum, int64_t initVal) MP_WUR; /* 65 */ int (*tclBN_mp_init_u64) (mp_int *bignum, uint64_t initVal) MP_WUR; /* 66 */ - TCL_DEPRECATED_API("Use mp_expt_u32") mp_err (*tclBN_mp_expt_d_ex) (const mp_int *a, unsigned int b, mp_int *c, int fast); /* 67 */ + void (*reserved67)(void); void (*tclBN_mp_set_u64) (mp_int *a, uint64_t i); /* 68 */ uint64_t (*tclBN_mp_get_mag_u64) (const mp_int *a) MP_WUR; /* 69 */ void (*tclBN_mp_set_i64) (mp_int *a, int64_t i); /* 70 */ mp_err (*tclBN_mp_unpack) (mp_int *rop, size_t count, mp_order order, size_t size, mp_endian endian, size_t nails, const void *op) MP_WUR; /* 71 */ mp_err (*tclBN_mp_pack) (void *rop, size_t maxcount, size_t *written, mp_order order, size_t size, mp_endian endian, size_t nails, const mp_int *op) MP_WUR; /* 72 */ - TCL_DEPRECATED_API("merged with mp_and") mp_err (*tclBN_mp_tc_and) (const mp_int *a, const mp_int *b, mp_int *c); /* 73 */ - TCL_DEPRECATED_API("merged with mp_or") mp_err (*tclBN_mp_tc_or) (const mp_int *a, const mp_int *b, mp_int *c); /* 74 */ - TCL_DEPRECATED_API("merged with mp_xor") mp_err (*tclBN_mp_tc_xor) (const mp_int *a, const mp_int *b, mp_int *c); /* 75 */ + void (*reserved73)(void); + void (*reserved74)(void); + void (*reserved75)(void); mp_err (*tclBN_mp_signed_rsh) (const mp_int *a, int b, mp_int *c) MP_WUR; /* 76 */ size_t (*tclBN_mp_pack_count) (const mp_int *a, size_t nails, size_t size) MP_WUR; /* 77 */ int (*tclBN_mp_to_ubin) (const mp_int *a, unsigned char *buf, size_t maxlen, size_t *written) MP_WUR; /* 78 */ - mp_err (*tclBN_mp_div_ld) (const mp_int *a, uint64_t b, mp_int *q, uint64_t *r) MP_WUR; /* 79 */ + void (*reserved79)(void); int (*tclBN_mp_to_radix) (const mp_int *a, char *str, size_t maxlen, size_t *written, int radix) MP_WUR; /* 80 */ } TclTomMathStubs; @@ -562,8 +496,7 @@ extern const TclTomMathStubs *tclTomMathStubsPtr; (tclTomMathStubsPtr->tclBN_mp_div_2) /* 15 */ #define TclBN_mp_div_2d \ (tclTomMathStubsPtr->tclBN_mp_div_2d) /* 16 */ -#define TclBN_mp_div_3 \ - (tclTomMathStubsPtr->tclBN_mp_div_3) /* 17 */ +/* Slot 17 is reserved */ #define TclBN_mp_exch \ (tclTomMathStubsPtr->tclBN_mp_exch) /* 18 */ #define TclBN_mp_expt_u32 \ @@ -606,64 +539,44 @@ extern const TclTomMathStubs *tclTomMathStubsPtr; (tclTomMathStubsPtr->tclBN_mp_rshd) /* 37 */ #define TclBN_mp_shrink \ (tclTomMathStubsPtr->tclBN_mp_shrink) /* 38 */ -#define TclBN_mp_set \ - (tclTomMathStubsPtr->tclBN_mp_set) /* 39 */ -#define TclBN_mp_sqr \ - (tclTomMathStubsPtr->tclBN_mp_sqr) /* 40 */ +/* Slot 39 is reserved */ +/* Slot 40 is reserved */ #define TclBN_mp_sqrt \ (tclTomMathStubsPtr->tclBN_mp_sqrt) /* 41 */ #define TclBN_mp_sub \ (tclTomMathStubsPtr->tclBN_mp_sub) /* 42 */ #define TclBN_mp_sub_d \ (tclTomMathStubsPtr->tclBN_mp_sub_d) /* 43 */ -#define TclBN_mp_to_unsigned_bin \ - (tclTomMathStubsPtr->tclBN_mp_to_unsigned_bin) /* 44 */ -#define TclBN_mp_to_unsigned_bin_n \ - (tclTomMathStubsPtr->tclBN_mp_to_unsigned_bin_n) /* 45 */ -#define TclBN_mp_toradix_n \ - (tclTomMathStubsPtr->tclBN_mp_toradix_n) /* 46 */ +/* Slot 44 is reserved */ +/* Slot 45 is reserved */ +/* Slot 46 is reserved */ #define TclBN_mp_ubin_size \ (tclTomMathStubsPtr->tclBN_mp_ubin_size) /* 47 */ #define TclBN_mp_xor \ (tclTomMathStubsPtr->tclBN_mp_xor) /* 48 */ #define TclBN_mp_zero \ (tclTomMathStubsPtr->tclBN_mp_zero) /* 49 */ -#define TclBN_reverse \ - (tclTomMathStubsPtr->tclBN_reverse) /* 50 */ -#define TclBN_s_mp_mul_digs_fast \ - (tclTomMathStubsPtr->tclBN_s_mp_mul_digs_fast) /* 51 */ -#define TclBN_s_mp_sqr_fast \ - (tclTomMathStubsPtr->tclBN_s_mp_sqr_fast) /* 52 */ -#define TclBN_mp_karatsuba_mul \ - (tclTomMathStubsPtr->tclBN_mp_karatsuba_mul) /* 53 */ -#define TclBN_mp_karatsuba_sqr \ - (tclTomMathStubsPtr->tclBN_mp_karatsuba_sqr) /* 54 */ -#define TclBN_mp_toom_mul \ - (tclTomMathStubsPtr->tclBN_mp_toom_mul) /* 55 */ -#define TclBN_mp_toom_sqr \ - (tclTomMathStubsPtr->tclBN_mp_toom_sqr) /* 56 */ -#define TclBN_s_mp_add \ - (tclTomMathStubsPtr->tclBN_s_mp_add) /* 57 */ -#define TclBN_s_mp_mul_digs \ - (tclTomMathStubsPtr->tclBN_s_mp_mul_digs) /* 58 */ -#define TclBN_s_mp_sqr \ - (tclTomMathStubsPtr->tclBN_s_mp_sqr) /* 59 */ -#define TclBN_s_mp_sub \ - (tclTomMathStubsPtr->tclBN_s_mp_sub) /* 60 */ -#define TclBN_mp_init_ul \ - (tclTomMathStubsPtr->tclBN_mp_init_ul) /* 61 */ -#define TclBN_mp_set_ul \ - (tclTomMathStubsPtr->tclBN_mp_set_ul) /* 62 */ +/* Slot 50 is reserved */ +/* Slot 51 is reserved */ +/* Slot 52 is reserved */ +/* Slot 53 is reserved */ +/* Slot 54 is reserved */ +/* Slot 55 is reserved */ +/* Slot 56 is reserved */ +/* Slot 57 is reserved */ +/* Slot 58 is reserved */ +/* Slot 59 is reserved */ +/* Slot 60 is reserved */ +/* Slot 61 is reserved */ +/* Slot 62 is reserved */ #define TclBN_mp_cnt_lsb \ (tclTomMathStubsPtr->tclBN_mp_cnt_lsb) /* 63 */ -#define TclBN_mp_init_l \ - (tclTomMathStubsPtr->tclBN_mp_init_l) /* 64 */ +/* Slot 64 is reserved */ #define TclBN_mp_init_i64 \ (tclTomMathStubsPtr->tclBN_mp_init_i64) /* 65 */ #define TclBN_mp_init_u64 \ (tclTomMathStubsPtr->tclBN_mp_init_u64) /* 66 */ -#define TclBN_mp_expt_d_ex \ - (tclTomMathStubsPtr->tclBN_mp_expt_d_ex) /* 67 */ +/* Slot 67 is reserved */ #define TclBN_mp_set_u64 \ (tclTomMathStubsPtr->tclBN_mp_set_u64) /* 68 */ #define TclBN_mp_get_mag_u64 \ @@ -674,20 +587,16 @@ extern const TclTomMathStubs *tclTomMathStubsPtr; (tclTomMathStubsPtr->tclBN_mp_unpack) /* 71 */ #define TclBN_mp_pack \ (tclTomMathStubsPtr->tclBN_mp_pack) /* 72 */ -#define TclBN_mp_tc_and \ - (tclTomMathStubsPtr->tclBN_mp_tc_and) /* 73 */ -#define TclBN_mp_tc_or \ - (tclTomMathStubsPtr->tclBN_mp_tc_or) /* 74 */ -#define TclBN_mp_tc_xor \ - (tclTomMathStubsPtr->tclBN_mp_tc_xor) /* 75 */ +/* Slot 73 is reserved */ +/* Slot 74 is reserved */ +/* Slot 75 is reserved */ #define TclBN_mp_signed_rsh \ (tclTomMathStubsPtr->tclBN_mp_signed_rsh) /* 76 */ #define TclBN_mp_pack_count \ (tclTomMathStubsPtr->tclBN_mp_pack_count) /* 77 */ #define TclBN_mp_to_ubin \ (tclTomMathStubsPtr->tclBN_mp_to_ubin) /* 78 */ -#define TclBN_mp_div_ld \ - (tclTomMathStubsPtr->tclBN_mp_div_ld) /* 79 */ +/* Slot 79 is reserved */ #define TclBN_mp_to_radix \ (tclTomMathStubsPtr->tclBN_mp_to_radix) /* 80 */ @@ -695,55 +604,6 @@ extern const TclTomMathStubs *tclTomMathStubsPtr; /* !END!: Do not edit above this line. */ -#if defined(USE_TCL_STUBS) -#undef mp_add_d -#define mp_add_d TclBN_mp_add_d -#undef mp_cmp_d -#define mp_cmp_d TclBN_mp_cmp_d -#undef mp_div_d -#ifdef MP_64BIT -#define mp_div_d TclBN_mp_div_ld -#else -#define mp_div_d TclBN_mp_div_d -#endif -#undef mp_sub_d -#define mp_sub_d TclBN_mp_sub_d -#undef mp_init_set -#define mp_init_set TclBN_mp_init_set -#undef mp_mul_d -#define mp_mul_d TclBN_mp_mul_d -#undef mp_set -#define mp_set TclBN_mp_set -#undef mp_expt_u32 -#define mp_expt_u32 TclBN_mp_expt_u32 -#endif /* USE_TCL_STUBS */ - -#define TclBNInitBignumFromLong(a,b) \ - do { \ - (a)->dp = NULL; \ - (void)mp_init_i64((a),(b)); \ - if ((a)->dp == NULL) { \ - Tcl_Panic("initialization failure in TclBNInitBignumFromLong"); \ - } \ - } while (0) -#undef TclBNInitBignumFromWideInt -#define TclBNInitBignumFromWideInt(a,b) \ - do { \ - (a)->dp = NULL; \ - (void)mp_init_i64((a),(b)); \ - if ((a)->dp == NULL) { \ - Tcl_Panic("initialization failure in TclBNInitBignumFromWideInt"); \ - } \ - } while (0) -#undef TclBNInitBignumFromWideUInt -#define TclBNInitBignumFromWideUInt(a,b) \ - do { \ - (a)->dp = NULL; \ - (void)mp_init_u64((a),(b)); \ - if ((a)->dp == NULL) { \ - Tcl_Panic("initialization failure in TclBNInitBignumFromWideUInt"); \ - } \ - } while (0) #undef mp_get_ll #define mp_get_ll(a) ((long long)mp_get_i64(a)) #undef mp_set_ll diff --git a/generic/tclTrace.c b/generic/tclTrace.c index e2be167..ac92a73 100644 --- a/generic/tclTrace.c +++ b/generic/tclTrace.c @@ -134,7 +134,7 @@ static char * TraceVarProc(void *clientData, Tcl_Interp *interp, static void TraceCommandProc(void *clientData, Tcl_Interp *interp, const char *oldName, const char *newName, int flags); -static Tcl_CmdObjTraceProc TraceExecutionProc; +static Tcl_CmdObjTraceProc2 TraceExecutionProc; static int StringTraceProc(void *clientData, Tcl_Interp *interp, Tcl_Size level, const char *command, Tcl_Command commandInfo, @@ -192,7 +192,7 @@ int Tcl_TraceObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ - Tcl_Size objc, /* Number of arguments. */ + int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { #ifndef TCL_REMOVE_OBSOLETE_TRACES @@ -207,7 +207,7 @@ Tcl_TraceObjCmd( #endif NULL }; - int optionIndex; + enum traceOptionsEnum optionIndex; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?"); @@ -218,7 +218,7 @@ Tcl_TraceObjCmd( &optionIndex) != TCL_OK) { return TCL_ERROR; } - switch ((enum traceOptionsEnum) optionIndex) { + switch (optionIndex) { case TRACE_ADD: case TRACE_REMOVE: { /* @@ -237,7 +237,7 @@ Tcl_TraceObjCmd( 0, &typeIndex) != TCL_OK) { return TCL_ERROR; } - return traceSubCmds[typeIndex](interp, (enum traceOptionsEnum)optionIndex, objc, objv); + return traceSubCmds[typeIndex](interp, optionIndex, objc, objv); } case TRACE_INFO: { /* @@ -260,7 +260,7 @@ Tcl_TraceObjCmd( 0, &typeIndex) != TCL_OK) { return TCL_ERROR; } - return traceSubCmds[typeIndex](interp, (enum traceOptionsEnum)optionIndex, objc, objv); + return traceSubCmds[typeIndex](interp, optionIndex, objc, objv); break; } @@ -278,7 +278,7 @@ Tcl_TraceObjCmd( TclNewObj(opsList); Tcl_IncrRefCount(opsList); - flagOps = TclGetStringFromObj(objv[3], &numFlags); + flagOps = Tcl_GetStringFromObj(objv[3], &numFlags); if (numFlags == 0) { Tcl_DecrRefCount(opsList); goto badVarOps; @@ -321,7 +321,7 @@ Tcl_TraceObjCmd( return TCL_ERROR; } TclNewObj(resultListPtr); - name = Tcl_GetString(objv[2]); + name = TclGetString(objv[2]); FOREACH_VAR_TRACE(interp, name, clientData) { TraceVarInfo *tvarPtr = (TraceVarInfo *)clientData; char *q = ops; @@ -397,7 +397,7 @@ Tcl_TraceObjCmd( static int TraceExecutionObjCmd( Tcl_Interp *interp, /* Current interpreter. */ - enum traceOptionsEnum optionIndex, /* Add, info or remove */ + enum traceOptionsEnum optionIndex, /* Add, info or remove */ Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { @@ -409,8 +409,7 @@ TraceExecutionObjCmd( enum operations { TRACE_EXEC_ENTER, TRACE_EXEC_LEAVE, TRACE_EXEC_ENTER_STEP, TRACE_EXEC_LEAVE_STEP - }; - int index; + } index; switch (optionIndex) { case TRACE_ADD: @@ -446,7 +445,7 @@ TraceExecutionObjCmd( "operation", TCL_EXACT, &index) != TCL_OK) { return TCL_ERROR; } - switch ((enum operations) index) { + switch (index) { case TRACE_EXEC_ENTER: flags |= TCL_TRACE_ENTER_EXEC; break; @@ -461,9 +460,9 @@ TraceExecutionObjCmd( break; } } - command = TclGetStringFromObj(objv[5], &length); - if ((enum traceOptionsEnum) optionIndex == TRACE_ADD) { - TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)ckalloc( + command = Tcl_GetStringFromObj(objv[5], &length); + if (optionIndex == TRACE_ADD) { + TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)Tcl_Alloc( offsetof(TraceCommandInfo, command) + 1 + length); tcmdPtr->flags = flags; @@ -478,10 +477,10 @@ TraceExecutionObjCmd( flags |= (TCL_TRACE_ENTER_EXEC | TCL_TRACE_LEAVE_EXEC); } memcpy(tcmdPtr->command, command, length+1); - name = Tcl_GetString(objv[3]); + name = TclGetString(objv[3]); if (Tcl_TraceCommand(interp, name, flags, TraceCommandProc, tcmdPtr) != TCL_OK) { - ckfree(tcmdPtr); + Tcl_Free(tcmdPtr); return TCL_ERROR; } } else { @@ -497,7 +496,7 @@ TraceExecutionObjCmd( * First ensure the name given is valid. */ - name = Tcl_GetString(objv[3]); + name = TclGetString(objv[3]); if (Tcl_FindCommand(interp,name,NULL,TCL_LEAVE_ERR_MSG) == NULL) { return TCL_ERROR; } @@ -531,7 +530,7 @@ TraceExecutionObjCmd( Tcl_DeleteTrace(interp, tcmdPtr->stepTrace); tcmdPtr->stepTrace = NULL; - ckfree(tcmdPtr->startCmd); + Tcl_Free(tcmdPtr->startCmd); } if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) { /* @@ -541,7 +540,7 @@ TraceExecutionObjCmd( tcmdPtr->flags = 0; } if (tcmdPtr->refCount-- <= 1) { - ckfree(tcmdPtr); + Tcl_Free(tcmdPtr); } break; } @@ -558,7 +557,7 @@ TraceExecutionObjCmd( return TCL_ERROR; } - name = Tcl_GetString(objv[3]); + name = TclGetString(objv[3]); /* * First ensure the name given is valid. @@ -652,8 +651,7 @@ TraceCommandObjCmd( const char *name, *command; Tcl_Size length; static const char *const opStrings[] = { "delete", "rename", NULL }; - enum operations { TRACE_CMD_DELETE, TRACE_CMD_RENAME }; - int index; + enum operations { TRACE_CMD_DELETE, TRACE_CMD_RENAME } index; switch (optionIndex) { case TRACE_ADD: @@ -690,7 +688,7 @@ TraceCommandObjCmd( "operation", TCL_EXACT, &index) != TCL_OK) { return TCL_ERROR; } - switch ((enum operations) index) { + switch (index) { case TRACE_CMD_RENAME: flags |= TCL_TRACE_RENAME; break; @@ -700,9 +698,9 @@ TraceCommandObjCmd( } } - command = TclGetStringFromObj(objv[5], &length); - if ((enum traceOptionsEnum) optionIndex == TRACE_ADD) { - TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)ckalloc( + command = Tcl_GetStringFromObj(objv[5], &length); + if (optionIndex == TRACE_ADD) { + TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)Tcl_Alloc( offsetof(TraceCommandInfo, command) + 1 + length); tcmdPtr->flags = flags; @@ -713,10 +711,10 @@ TraceCommandObjCmd( tcmdPtr->refCount = 1; flags |= TCL_TRACE_DELETE; memcpy(tcmdPtr->command, command, length+1); - name = Tcl_GetString(objv[3]); + name = TclGetString(objv[3]); if (Tcl_TraceCommand(interp, name, flags, TraceCommandProc, tcmdPtr) != TCL_OK) { - ckfree(tcmdPtr); + Tcl_Free(tcmdPtr); return TCL_ERROR; } } else { @@ -732,7 +730,7 @@ TraceCommandObjCmd( * First ensure the name given is valid. */ - name = Tcl_GetString(objv[3]); + name = TclGetString(objv[3]); if (Tcl_FindCommand(interp,name,NULL,TCL_LEAVE_ERR_MSG) == NULL) { return TCL_ERROR; } @@ -747,7 +745,7 @@ TraceCommandObjCmd( TraceCommandProc, clientData); tcmdPtr->flags |= TCL_TRACE_DESTROYED; if (tcmdPtr->refCount-- <= 1) { - ckfree(tcmdPtr); + Tcl_Free(tcmdPtr); } break; } @@ -768,7 +766,7 @@ TraceCommandObjCmd( * First ensure the name given is valid. */ - name = Tcl_GetString(objv[3]); + name = TclGetString(objv[3]); if (Tcl_FindCommand(interp, name, NULL, TCL_LEAVE_ERR_MSG) == NULL) { return TCL_ERROR; } @@ -841,7 +839,7 @@ TraceCommandObjCmd( static int TraceVariableObjCmd( Tcl_Interp *interp, /* Current interpreter. */ - enum traceOptionsEnum optionIndex, /* Add, info or remove */ + enum traceOptionsEnum optionIndex, /* Add, info or remove */ Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { @@ -853,10 +851,9 @@ TraceVariableObjCmd( }; enum operations { TRACE_VAR_ARRAY, TRACE_VAR_READ, TRACE_VAR_UNSET, TRACE_VAR_WRITE - }; - int index; + } index; - switch ((enum traceOptionsEnum) optionIndex) { + switch (optionIndex) { case TRACE_ADD: case TRACE_REMOVE: { int flags = 0, result; @@ -890,7 +887,7 @@ TraceVariableObjCmd( "operation", TCL_EXACT, &index) != TCL_OK) { return TCL_ERROR; } - switch ((enum operations) index) { + switch (index) { case TRACE_VAR_ARRAY: flags |= TCL_TRACE_ARRAY; break; @@ -905,9 +902,9 @@ TraceVariableObjCmd( break; } } - command = TclGetStringFromObj(objv[5], &length); - if ((enum traceOptionsEnum) optionIndex == TRACE_ADD) { - CombinedTraceVarInfo *ctvarPtr = (CombinedTraceVarInfo *)ckalloc( + command = Tcl_GetStringFromObj(objv[5], &length); + if (optionIndex == TRACE_ADD) { + CombinedTraceVarInfo *ctvarPtr = (CombinedTraceVarInfo *)Tcl_Alloc( offsetof(CombinedTraceVarInfo, traceCmdInfo.command) + 1 + length); @@ -923,10 +920,10 @@ TraceVariableObjCmd( ctvarPtr->traceInfo.traceProc = TraceVarProc; ctvarPtr->traceInfo.clientData = &ctvarPtr->traceCmdInfo; ctvarPtr->traceInfo.flags = flags; - name = Tcl_GetString(objv[3]); + name = TclGetString(objv[3]); if (TraceVarEx(interp, name, NULL, (VarTrace *) ctvarPtr) != TCL_OK) { - ckfree(ctvarPtr); + Tcl_Free(ctvarPtr); return TCL_ERROR; } } else { @@ -936,7 +933,7 @@ TraceVariableObjCmd( * first one that matches. */ - name = Tcl_GetString(objv[3]); + name = TclGetString(objv[3]); FOREACH_VAR_TRACE(interp, name, clientData) { TraceVarInfo *tvarPtr = (TraceVarInfo *)clientData; @@ -966,7 +963,7 @@ TraceVariableObjCmd( } TclNewObj(resultListPtr); - name = Tcl_GetString(objv[3]); + name = TclGetString(objv[3]); FOREACH_VAR_TRACE(interp, name, clientData) { Tcl_Obj *opObjPtr, *eachTraceObjPtr, *elemObjPtr; TraceVarInfo *tvarPtr = (TraceVarInfo *)clientData; @@ -1127,7 +1124,7 @@ Tcl_TraceCommand( * Set up trace information. */ - tracePtr = (CommandTrace *)ckalloc(sizeof(CommandTrace)); + tracePtr = (CommandTrace *)Tcl_Alloc(sizeof(CommandTrace)); tracePtr->traceProc = proc; tracePtr->clientData = clientData; tracePtr->flags = flags & @@ -1233,7 +1230,7 @@ Tcl_UntraceCommand( tracePtr->flags = 0; if (tracePtr->refCount-- <= 1) { - ckfree(tracePtr); + Tcl_Free(tracePtr); } if (hasExecTraces) { @@ -1346,7 +1343,7 @@ TraceCommandProc( if (tcmdPtr->stepTrace != NULL) { Tcl_DeleteTrace(interp, tcmdPtr->stepTrace); tcmdPtr->stepTrace = NULL; - ckfree(tcmdPtr->startCmd); + Tcl_Free(tcmdPtr->startCmd); } if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) { /* @@ -1388,7 +1385,7 @@ TraceCommandProc( tcmdPtr->refCount--; } if (tcmdPtr->refCount-- <= 1) { - ckfree(tcmdPtr); + Tcl_Free(tcmdPtr); } } @@ -1479,7 +1476,7 @@ TclCheckExecutionTraces( traceCode = TraceExecutionProc(tcmdPtr, interp, curLevel, command, (Tcl_Command) cmdPtr, objc, objv); if (tcmdPtr->refCount-- <= 1) { - ckfree(tcmdPtr); + Tcl_Free(tcmdPtr); } } } @@ -1726,7 +1723,7 @@ CommandObjTraceDeleted( TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)clientData; if (tcmdPtr->refCount-- <= 1) { - ckfree(tcmdPtr); + Tcl_Free(tcmdPtr); } } @@ -1808,7 +1805,7 @@ TraceExecutionProc( && (strcmp(command, tcmdPtr->startCmd) == 0)) { Tcl_DeleteTrace(interp, tcmdPtr->stepTrace); tcmdPtr->stepTrace = NULL; - ckfree(tcmdPtr->startCmd); + Tcl_Free(tcmdPtr->startCmd); } /* @@ -1829,7 +1826,7 @@ TraceExecutionProc( Tcl_DStringInit(&sub); for (i = 0; i < objc; i++) { - Tcl_DStringAppendElement(&sub, Tcl_GetString(objv[i])); + Tcl_DStringAppendElement(&sub, TclGetString(objv[i])); } Tcl_DStringAppendElement(&cmd, Tcl_DStringValue(&sub)); Tcl_DStringFree(&sub); @@ -1853,7 +1850,7 @@ TraceExecutionProc( */ TclNewIntObj(resultCode, code); - resultCodeStr = Tcl_GetString(resultCode); + resultCodeStr = TclGetString(resultCode); Tcl_DStringAppendElement(&cmd, resultCodeStr); Tcl_DecrRefCount(resultCode); @@ -1922,10 +1919,10 @@ TraceExecutionProc( unsigned len = strlen(command) + 1; tcmdPtr->startLevel = level; - tcmdPtr->startCmd = (char *)ckalloc(len); + tcmdPtr->startCmd = (char *)Tcl_Alloc(len); memcpy(tcmdPtr->startCmd, command, len); tcmdPtr->refCount++; - tcmdPtr->stepTrace = Tcl_CreateObjTrace(interp, 0, + tcmdPtr->stepTrace = Tcl_CreateObjTrace2(interp, 0, (tcmdPtr->flags & TCL_TRACE_ANY_EXEC) >> 2, TraceExecutionProc, tcmdPtr, CommandObjTraceDeleted); } @@ -1934,12 +1931,12 @@ TraceExecutionProc( if (tcmdPtr->stepTrace != NULL) { Tcl_DeleteTrace(interp, tcmdPtr->stepTrace); tcmdPtr->stepTrace = NULL; - ckfree(tcmdPtr->startCmd); + Tcl_Free(tcmdPtr->startCmd); } } if (call) { if (tcmdPtr->refCount-- <= 1) { - ckfree(tcmdPtr); + Tcl_Free(tcmdPtr); } } return traceCode; @@ -2127,7 +2124,7 @@ TraceVarProc( */ typedef struct { - Tcl_CmdObjTraceProc2 *proc; + Tcl_CmdObjTraceProc *proc; Tcl_CmdObjTraceDeleteProc *delProc; void *clientData; } TraceWrapperInfo; @@ -2142,10 +2139,10 @@ static int traceWrapperProc( Tcl_Obj *const objv[]) { TraceWrapperInfo *info = (TraceWrapperInfo *)clientData; - if (objc < 0) { + if (objc > INT_MAX) { objc = -1; /* Signal Tcl_CmdObjTraceProc that objc is out of range */ } - return info->proc(info->clientData, interp, level, command, commandInfo, objc, objv); + return info->proc(info->clientData, interp, (int)level, command, commandInfo, objc, objv); } static void traceWrapperDelProc(void *clientData) @@ -2155,34 +2152,34 @@ static void traceWrapperDelProc(void *clientData) if (info->delProc) { info->delProc(clientData); } - ckfree(info); + Tcl_Free(info); } Tcl_Trace -Tcl_CreateObjTrace2( +Tcl_CreateObjTrace( Tcl_Interp *interp, /* Tcl interpreter */ Tcl_Size level, /* Maximum nesting level */ int flags, /* Flags, see above */ - Tcl_CmdObjTraceProc2 *proc, /* Trace callback */ + Tcl_CmdObjTraceProc *proc, /* Trace callback */ void *clientData, /* Client data for the callback */ Tcl_CmdObjTraceDeleteProc *delProc) /* Function to call when trace is deleted */ { - TraceWrapperInfo *info = (TraceWrapperInfo *)ckalloc(sizeof(TraceWrapperInfo)); + TraceWrapperInfo *info = (TraceWrapperInfo *)Tcl_Alloc(sizeof(TraceWrapperInfo)); info->proc = proc; info->delProc = delProc; info->clientData = clientData; - return Tcl_CreateObjTrace(interp, level, flags, + return Tcl_CreateObjTrace2(interp, level, flags, (proc ? traceWrapperProc : NULL), info, traceWrapperDelProc); } Tcl_Trace -Tcl_CreateObjTrace( +Tcl_CreateObjTrace2( Tcl_Interp *interp, /* Tcl interpreter */ Tcl_Size level, /* Maximum nesting level */ int flags, /* Flags, see above */ - Tcl_CmdObjTraceProc *proc, /* Trace callback */ + Tcl_CmdObjTraceProc2 *proc, /* Trace callback */ void *clientData, /* Client data for the callback */ Tcl_CmdObjTraceDeleteProc *delProc) /* Function to call when trace is deleted */ @@ -2212,7 +2209,7 @@ Tcl_CreateObjTrace( iPtr->tracesForbiddingInline++; } - tracePtr = (Trace *)ckalloc(sizeof(Trace)); + tracePtr = (Trace *)Tcl_Alloc(sizeof(Trace)); tracePtr->level = level; tracePtr->proc = proc; tracePtr->clientData = clientData; @@ -2275,11 +2272,11 @@ Tcl_CreateTrace( * command. */ void *clientData) /* Arbitrary value word to pass to proc. */ { - StringTraceData *data = (StringTraceData *)ckalloc(sizeof(StringTraceData)); + StringTraceData *data = (StringTraceData *)Tcl_Alloc(sizeof(StringTraceData)); data->clientData = clientData; data->proc = proc; - return Tcl_CreateObjTrace(interp, level, 0, StringTraceProc, + return Tcl_CreateObjTrace2(interp, level, 0, StringTraceProc, data, StringTraceDeleteProc); } @@ -2322,7 +2319,7 @@ StringTraceProc( argv = (const char **) TclStackAlloc(interp, (objc + 1) * sizeof(const char *)); for (i = 0; i < objc; i++) { - argv[i] = Tcl_GetString(objv[i]); + argv[i] = TclGetString(objv[i]); } argv[objc] = 0; @@ -2359,7 +2356,7 @@ static void StringTraceDeleteProc( void *clientData) { - ckfree(clientData); + Tcl_Free(clientData); } /* @@ -2610,9 +2607,6 @@ TclObjCallVarTraces( leaveErrMsg); } -#undef TCL_INTERP_DESTROYED -#define TCL_INTERP_DESTROYED 0x100 - int TclCallVarTraces( Interp *iPtr, /* Interpreter containing variable. */ @@ -2640,6 +2634,7 @@ TclCallVarTraces( Tcl_InterpState state = NULL; Tcl_HashEntry *hPtr; int traceflags = flags & VAR_ALL_TRACES; + const char *element; /* * If there are already similar trace functions active for the variable, @@ -2691,12 +2686,19 @@ TclCallVarTraces( } } - /* - * Ignore any caller-provided TCL_INTERP_DESTROYED flag. Only we can - * set it correctly. - */ - - flags &= ~TCL_INTERP_DESTROYED; + /* Keep the original pointer for possible use in an error message */ + element = part2; + if (part2 == NULL) { + if (TclIsVarArrayElement(varPtr)) { + Tcl_Obj *keyObj = VarHashGetKey(varPtr); + part2 = Tcl_GetString(keyObj); + } + } else if ((flags & VAR_TRACED_UNSET) && !(flags & VAR_ARRAY_ELEMENT)) { + /* On unset traces, part2 has already been set by the caller, and + * the VAR_ARRAY_ELEMENT flag indicates whether the accessed + * variable actually has a second part, or is a scalar */ + element = NULL; + } /* * Invoke traces on the array containing the variable, if relevant. @@ -2720,9 +2722,6 @@ TclCallVarTraces( if (state == NULL) { state = Tcl_SaveInterpState((Tcl_Interp *) iPtr, code); } - if (Tcl_InterpDeleted((Tcl_Interp *) iPtr)) { - flags |= TCL_INTERP_DESTROYED; - } result = tracePtr->traceProc(tracePtr->clientData, (Tcl_Interp *) iPtr, part1, part2, flags); if (result != NULL) { @@ -2764,9 +2763,6 @@ TclCallVarTraces( if (state == NULL) { state = Tcl_SaveInterpState((Tcl_Interp *) iPtr, code); } - if (Tcl_InterpDeleted((Tcl_Interp *) iPtr)) { - flags |= TCL_INTERP_DESTROYED; - } result = tracePtr->traceProc(tracePtr->clientData, (Tcl_Interp *) iPtr, part1, part2, flags); if (result != NULL) { @@ -2824,13 +2820,13 @@ TclCallVarTraces( Tcl_AppendObjToErrorInfo((Tcl_Interp *)iPtr, Tcl_ObjPrintf( "\n (%s trace on \"%s%s%s%s\")", type, part1, - (part2 ? "(" : ""), (part2 ? part2 : ""), - (part2 ? ")" : "") )); + (element ? "(" : ""), (element ? element : ""), + (element ? ")" : "") )); if (disposeFlags & TCL_TRACE_RESULT_OBJECT) { - TclVarErrMsg((Tcl_Interp *) iPtr, part1, part2, verb, - Tcl_GetString((Tcl_Obj *) result)); + TclVarErrMsg((Tcl_Interp *) iPtr, part1, element, verb, + TclGetString((Tcl_Obj *) result)); } else { - TclVarErrMsg((Tcl_Interp *) iPtr, part1, part2, verb, result); + TclVarErrMsg((Tcl_Interp *) iPtr, part1, element, verb, result); } iPtr->flags &= ~(ERR_ALREADY_LOGGED); Tcl_DiscardInterpState(state); @@ -2887,7 +2883,7 @@ DisposeTraceResult( * to be disposed. */ { if (flags & TCL_TRACE_RESULT_DYNAMIC) { - ckfree(result); + Tcl_Free(result); } else if (flags & TCL_TRACE_RESULT_OBJECT) { Tcl_DecrRefCount((Tcl_Obj *) result); } @@ -2896,41 +2892,6 @@ DisposeTraceResult( /* *---------------------------------------------------------------------- * - * Tcl_UntraceVar -- - * - * Remove a previously-created trace for a variable. - * - * Results: - * None. - * - * Side effects: - * If there exists a trace for the variable given by varName with the - * given flags, proc, and clientData, then that trace is removed. - * - *---------------------------------------------------------------------- - */ - -#ifndef TCL_NO_DEPRECATED -#undef Tcl_UntraceVar -void -Tcl_UntraceVar( - Tcl_Interp *interp, /* Interpreter containing variable. */ - const char *varName, /* Name of variable; may end with "(index)" to - * signify an array reference. */ - int flags, /* OR-ed collection of bits describing current - * trace, including any of TCL_TRACE_READS, - * TCL_TRACE_WRITES, TCL_TRACE_UNSETS, - * TCL_GLOBAL_ONLY and TCL_NAMESPACE_ONLY. */ - Tcl_VarTraceProc *proc, /* Function assocated with trace. */ - ClientData clientData) /* Arbitrary argument to pass to proc. */ -{ - Tcl_UntraceVar2(interp, varName, NULL, flags, proc, clientData); -} -#endif /* TCL_NO_DEPRECATED */ - -/* - *---------------------------------------------------------------------- - * * Tcl_UntraceVar2 -- * * Remove a previously-created trace for a variable. @@ -2957,7 +2918,7 @@ Tcl_UntraceVar2( * TCL_TRACE_WRITES, TCL_TRACE_UNSETS, * TCL_GLOBAL_ONLY, and TCL_NAMESPACE_ONLY. */ Tcl_VarTraceProc *proc, /* Function assocated with trace. */ - ClientData clientData) /* Arbitrary argument to pass to proc. */ + void *clientData) /* Arbitrary argument to pass to proc. */ { VarTrace *tracePtr; VarTrace *prevPtr, *nextPtr; @@ -3061,49 +3022,6 @@ Tcl_UntraceVar2( /* *---------------------------------------------------------------------- * - * Tcl_VarTraceInfo -- - * - * Return the clientData value associated with a trace on a variable. - * This function can also be used to step through all of the traces on a - * particular variable that have the same trace function. - * - * Results: - * The return value is the clientData value associated with a trace on - * the given variable. Information will only be returned for a trace with - * proc as trace function. If the clientData argument is NULL then the - * first such trace is returned; otherwise, the next relevant one after - * the one given by clientData will be returned. If the variable doesn't - * exist, or if there are no (more) traces for it, then NULL is returned. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -#ifndef TCL_NO_DEPRECATED -#undef Tcl_VarTraceInfo -ClientData -Tcl_VarTraceInfo( - Tcl_Interp *interp, /* Interpreter containing variable. */ - const char *varName, /* Name of variable; may end with "(index)" to - * signify an array reference. */ - int flags, /* OR-ed combo or TCL_GLOBAL_ONLY, - * TCL_NAMESPACE_ONLY (can be 0). */ - Tcl_VarTraceProc *proc, /* Function assocated with trace. */ - ClientData prevClientData) /* If non-NULL, gives last value returned by - * this function, so this call will return the - * next trace after that one. If NULL, this - * call will return the first trace. */ -{ - return Tcl_VarTraceInfo2(interp, varName, NULL, flags, proc, - prevClientData); -} -#endif /* TCL_NO_DEPRECATED */ - -/* - *---------------------------------------------------------------------- - * * Tcl_VarTraceInfo2 -- * * Same as Tcl_VarTraceInfo, except takes name in two pieces instead of @@ -3118,7 +3036,7 @@ Tcl_VarTraceInfo( *---------------------------------------------------------------------- */ -ClientData +void * Tcl_VarTraceInfo2( Tcl_Interp *interp, /* Interpreter containing variable. */ const char *part1, /* Name of variable or array. */ @@ -3128,7 +3046,7 @@ Tcl_VarTraceInfo2( int flags, /* OR-ed combination of TCL_GLOBAL_ONLY, * TCL_NAMESPACE_ONLY. */ Tcl_VarTraceProc *proc, /* Function assocated with trace. */ - ClientData prevClientData) /* If non-NULL, gives last value returned by + 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 * call will return the first trace. */ @@ -3174,47 +3092,6 @@ Tcl_VarTraceInfo2( /* *---------------------------------------------------------------------- * - * Tcl_TraceVar -- - * - * Arrange for reads and/or writes to a variable to cause a function to - * be invoked, which can monitor the operations and/or change their - * actions. - * - * Results: - * A standard Tcl return value. - * - * Side effects: - * A trace is set up on the variable given by varName, such that future - * references to the variable will be intermediated by proc. See the - * manual entry for complete details on the calling sequence for proc. - * The variable's flags are updated. - * - *---------------------------------------------------------------------- - */ - -#ifndef TCL_NO_DEPRECATED -#undef Tcl_TraceVar -int -Tcl_TraceVar( - Tcl_Interp *interp, /* Interpreter in which variable is to be - * traced. */ - const char *varName, /* Name of variable; may end with "(index)" to - * signify an array reference. */ - int flags, /* OR-ed collection of bits, including any of - * TCL_TRACE_READS, TCL_TRACE_WRITES, - * TCL_TRACE_UNSETS, TCL_GLOBAL_ONLY, and - * TCL_NAMESPACE_ONLY. */ - Tcl_VarTraceProc *proc, /* Function to call when specified ops are - * invoked upon varName. */ - ClientData clientData) /* Arbitrary argument to pass to proc. */ -{ - return Tcl_TraceVar2(interp, varName, NULL, flags, proc, clientData); -} -#endif /* TCL_NO_DEPRECATED */ - -/* - *---------------------------------------------------------------------- - * * Tcl_TraceVar2 -- * * Arrange for reads and/or writes to a variable to cause a function to @@ -3252,7 +3129,7 @@ Tcl_TraceVar2( VarTrace *tracePtr; int result; - tracePtr = (VarTrace *)ckalloc(sizeof(VarTrace)); + tracePtr = (VarTrace *)Tcl_Alloc(sizeof(VarTrace)); tracePtr->traceProc = proc; tracePtr->clientData = clientData; tracePtr->flags = flags; @@ -3260,7 +3137,7 @@ Tcl_TraceVar2( result = TraceVarEx(interp, part1, part2, tracePtr); if (result != TCL_OK) { - ckfree(tracePtr); + Tcl_Free(tracePtr); } return result; } @@ -3296,7 +3173,7 @@ TraceVarEx( * as-a-whole. */ VarTrace *tracePtr)/* Structure containing flags, traceProc and * clientData fields. Others should be left - * blank. Will be ckfree()d (eventually) if + * blank. Will be Tcl_Free()d (eventually) if * this function returns TCL_OK, and up to * caller to free if this function returns * TCL_ERROR. */ diff --git a/generic/tclUtf.c b/generic/tclUtf.c index 87216c2..92bcf4f 100644 --- a/generic/tclUtf.c +++ b/generic/tclUtf.c @@ -105,7 +105,7 @@ static int Invalid(const char *src); *--------------------------------------------------------------------------- */ -int +size_t TclUtfCount( int ch) /* The Unicode character whose size is returned. */ { @@ -208,15 +208,23 @@ Invalid( *--------------------------------------------------------------------------- */ -int +#undef Tcl_UniCharToUtf +size_t Tcl_UniCharToUtf( int ch, /* The Tcl_UniChar to be stored in the - * buffer. */ + * buffer. Can be or'ed with flag TCL_COMBINE */ char *buf) /* Buffer in which the UTF-8 representation of * the Tcl_UniChar is stored. Buffer must be * large enough to hold the UTF-8 character * (at most 4 bytes). */ { +#if TCL_UTF_MAX > 3 + int flags = ch; +#endif + + if (ch >= TCL_COMBINE) { + ch &= (TCL_COMBINE - 1); + } if ((unsigned)(ch - 1) < (UNICODE_SELF - 1)) { buf[0] = (char) ch; return 1; @@ -228,7 +236,11 @@ Tcl_UniCharToUtf( return 2; } if (ch <= 0xFFFF) { - if ((ch & 0xF800) == 0xD800) { + if ( +#if TCL_UTF_MAX > 3 + (flags & TCL_COMBINE) && +#endif + ((ch & 0xF800) == 0xD800)) { if (ch & 0x0400) { /* Low surrogate */ if (((buf[0] & 0xC0) == 0x80) && ((buf[1] & 0xCF) == 0)) { @@ -300,13 +312,13 @@ three: char * Tcl_UniCharToUtfDString( const int *uniStr, /* Unicode string to convert to UTF-8. */ - int uniLength, /* Length of Unicode string. */ + size_t uniLength, /* Length of Unicode string. */ Tcl_DString *dsPtr) /* UTF-8 representation of string is appended * to this previously initialized DString. */ { const int *w, *wEnd; char *p, *string; - int oldLength; + size_t oldLength; /* * UTF-8 string length in bytes will be <= Unicode string length * 4. @@ -315,7 +327,7 @@ Tcl_UniCharToUtfDString( if (uniStr == NULL) { return NULL; } - if (uniLength < 0) { + if (uniLength == TCL_INDEX_NONE) { uniLength = 0; w = uniStr; while (*w != '\0') { @@ -341,13 +353,14 @@ Tcl_UniCharToUtfDString( char * Tcl_Char16ToUtfDString( const unsigned short *uniStr,/* Utf-16 string to convert to UTF-8. */ - int uniLength, /* Length of Utf-16 string. */ + size_t uniLength, /* Length of Utf-16 string. */ Tcl_DString *dsPtr) /* UTF-8 representation of string is appended * to this previously initialized DString. */ { const unsigned short *w, *wEnd; char *p, *string; - int oldLength, len = 1; + size_t oldLength; + int len = 1; /* * UTF-8 string length in bytes will be <= Utf16 string length * 3. @@ -356,7 +369,7 @@ Tcl_Char16ToUtfDString( if (uniStr == NULL) { return NULL; } - if (uniLength < 0) { + if (uniLength == TCL_INDEX_NONE) { uniLength = 0; w = uniStr; @@ -376,7 +389,7 @@ Tcl_Char16ToUtfDString( /* Special case for handling high surrogates. */ p += Tcl_UniCharToUtf(-1, p); } - len = Tcl_UniCharToUtf(*w, p); + len = Tcl_UniCharToUtf(*w | TCL_COMBINE, p); p += len; if ((*w >= 0xD800) && (len < 3)) { len = 0; /* Indication that high surrogate was found */ @@ -407,7 +420,7 @@ Tcl_Char16ToUtfDString( * Tcl_UtfCharComplete() before calling this routine to ensure that * enough bytes remain in the string. * - * If TCL_UTF_MAX <= 4, special handling of Surrogate pairs is done: + * If TCL_UTF_MAX < 4, special handling of Surrogate pairs is done: * For any UTF-8 string containing a character outside of the BMP, the * first call to this function will fill *chPtr with the high surrogate * and generate a return value of 1. Calling Tcl_UtfToUniChar again @@ -434,7 +447,7 @@ static const unsigned short cp1252[32] = { }; #undef Tcl_UtfToUniChar -int +size_t Tcl_UtfToUniChar( const char *src, /* The UTF-8 string. */ int *chPtr)/* Filled with the Unicode character represented by @@ -517,7 +530,7 @@ Tcl_UtfToUniChar( return 1; } -int +size_t Tcl_UtfToChar16( const char *src, /* The UTF-8 string. */ unsigned short *chPtr)/* Filled with the Tcl_UniChar represented by @@ -638,7 +651,7 @@ Tcl_UtfToChar16( int * Tcl_UtfToUniCharDString( const char *src, /* UTF-8 string to convert to Unicode. */ - int length, /* Length of UTF-8 string in bytes, or -1 for + size_t 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 @@ -646,7 +659,7 @@ Tcl_UtfToUniCharDString( { int ch = 0, *w, *wString; const char *p; - int oldLength; + size_t 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 */ @@ -655,7 +668,7 @@ Tcl_UtfToUniCharDString( if (src == NULL) { return NULL; } - if (length < 0) { + if (length == TCL_INDEX_NONE) { length = strlen(src); } @@ -695,7 +708,7 @@ Tcl_UtfToUniCharDString( unsigned short * Tcl_UtfToChar16DString( const char *src, /* UTF-8 string to convert to Unicode. */ - int length, /* Length of UTF-8 string in bytes, or -1 for + size_t 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 @@ -703,7 +716,7 @@ Tcl_UtfToChar16DString( { unsigned short ch = 0, *w, *wString; const char *p; - int oldLength; + size_t 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 */ @@ -712,12 +725,12 @@ Tcl_UtfToChar16DString( if (src == NULL) { return NULL; } - if (length < 0) { + if (length == TCL_INDEX_NONE) { length = strlen(src); } /* - * Unicode string length in Tcl_UniChars will be <= UTF-8 string length in + * Unicode string length in WCHARs will be <= UTF-8 string length in * bytes. */ @@ -773,7 +786,7 @@ int Tcl_UtfCharComplete( const char *src, /* String to check if first few bytes contain * a complete UTF-8 character. */ - int length) /* Length of above string in bytes. */ + size_t length) /* Length of above string in bytes. */ { return length >= complete[UCHAR(*src)]; } @@ -796,18 +809,18 @@ Tcl_UtfCharComplete( *--------------------------------------------------------------------------- */ -int -TclNumUtfChars( +size_t +Tcl_NumUtfChars( const char *src, /* The UTF-8 string to measure. */ - int length) /* The length of the string in bytes, or -1 - * for strlen(string). */ + size_t length) /* The length of the string in bytes, or + * TCL_INDEX_NONE for strlen(src). */ { Tcl_UniChar ch = 0; - int i = 0; + size_t i = 0; - if (length < 0) { + if (length == TCL_INDEX_NONE) { /* string is NUL-terminated, so TclUtfToUniChar calls are safe. */ - while ((*src != '\0') && (i < INT_MAX)) { + while (*src != '\0') { src += TclUtfToUniChar(src, &ch); i++; } @@ -848,20 +861,18 @@ TclNumUtfChars( return i; } -#if (TCL_UTF_MAX > 3) && !defined(TCL_NO_DEPRECATED) -#undef Tcl_NumUtfChars -int -Tcl_NumUtfChars( +size_t +TclNumUtfChars( const char *src, /* The UTF-8 string to measure. */ - int length) /* The length of the string in bytes, or -1 - * for strlen(string). */ + size_t length) /* The length of the string in bytes, or + * TCL_INDEX_NONE for strlen(src). */ { unsigned short ch = 0; - int i = 0; + size_t i = 0; - if (length < 0) { + if (length == TCL_INDEX_NONE) { /* string is NUL-terminated, so TclUtfToUniChar calls are safe. */ - while ((*src != '\0') && (i < INT_MAX)) { + while (*src != '\0') { src += Tcl_UtfToChar16(src, &ch); i++; } @@ -901,7 +912,6 @@ Tcl_NumUtfChars( } return i; } -#endif /* *--------------------------------------------------------------------------- @@ -1005,7 +1015,7 @@ const char * Tcl_UtfNext( const char *src) /* The current location in the string. */ { - int left; + size_t left; const char *next; if (((*src) & 0xC0) == 0x80) { @@ -1178,22 +1188,24 @@ Tcl_UtfPrev( int Tcl_UniCharAtIndex( const char *src, /* The UTF-8 string to dereference. */ - int index) /* The position of the desired character. */ + size_t index) /* The position of the desired character. */ { - unsigned short ch = 0; + Tcl_UniChar ch = 0; int i = 0; - if (index < 0) { + if (index == TCL_INDEX_NONE) { return -1; } - while (index-- > 0) { - i = Tcl_UtfToChar16(src, &ch); + while (index--) { + i = TclUtfToUniChar(src, &ch); src += i; } +#if TCL_UTF_MAX < 4 if ((ch >= 0xD800) && (i < 3)) { /* Index points at character following high Surrogate */ return -1; } +#endif TclUtfToUCS4(src, &i); return i; } @@ -1217,56 +1229,42 @@ Tcl_UniCharAtIndex( *--------------------------------------------------------------------------- */ -#if TCL_UTF_MAX < 4 -# undef Tcl_UtfToUniChar -# define Tcl_UtfToUniChar Tcl_UtfToChar16 -#endif - const char * -TclUtfAtIndex( +Tcl_UtfAtIndex( const char *src, /* The UTF-8 string. */ - int index) /* The position of the desired character. */ + size_t index) /* The position of the desired character. */ { - Tcl_UniChar ch = 0; - int len = 0; + int ch = 0; - while (index-- > 0) { - len = (Tcl_UtfToUniChar)(src, &ch); - src += len; - } -#if TCL_UTF_MAX < 4 - if ((ch >= 0xD800) && (len < 3)) { - /* Index points at character following high Surrogate */ - src += (Tcl_UtfToUniChar)(src, &ch); + if (index != TCL_INDEX_NONE) { + while (index--) { + /* Make use of the #undef Tcl_UtfToUniChar above, which already handles UCS4. */ + src += Tcl_UtfToUniChar(src, &ch); + } } -#endif return src; } -#if (TCL_UTF_MAX > 3) && !defined(TCL_NO_DEPRECATED) -#undef Tcl_UtfAtIndex const char * -Tcl_UtfAtIndex( +TclUtfAtIndex( const char *src, /* The UTF-8 string. */ - int index) /* The position of the desired character. */ + size_t index) /* The position of the desired character. */ { unsigned short ch = 0; - int len = 0; + size_t len = 0; - while (index-- > 0) { - len = Tcl_UtfToChar16(src, &ch); - src += len; - } - if ((ch >= 0xD800) && (len < 3)) { - /* Index points at character following high Surrogate */ - src += Tcl_UtfToChar16(src, &ch); + if (index != TCL_INDEX_NONE) { + while (index--) { + src += (len = Tcl_UtfToChar16(src, &ch)); + } + if ((ch >= 0xD800) && (len < 3)) { + /* Index points at character following high Surrogate */ + src += Tcl_UtfToChar16(src, &ch); + } } return src; } - -#endif - /* *--------------------------------------------------------------------------- * @@ -1293,7 +1291,7 @@ Tcl_UtfAtIndex( *--------------------------------------------------------------------------- */ -int +size_t Tcl_UtfBackslash( const char *src, /* Points to the backslash character of a * backslash sequence. */ @@ -1303,8 +1301,7 @@ Tcl_UtfBackslash( * backslash sequence. */ { #define LINE_LENGTH 128 - int numRead; - int result; + size_t numRead, result; result = TclParseBackslash(src, LINE_LENGTH, &numRead, dst); if (numRead == LINE_LENGTH) { @@ -1338,13 +1335,13 @@ Tcl_UtfBackslash( *---------------------------------------------------------------------- */ -int +size_t Tcl_UtfToUpper( char *str) /* String to convert in place. */ { int ch, upChar; char *src, *dst; - int len; + size_t len; /* * Iterate over the string until we hit the terminating null. @@ -1361,7 +1358,7 @@ Tcl_UtfToUpper( * char to dst if its size is <= the original char. */ - if ((len < TclUtfCount(upChar)) || ((upChar & ~0x7FF) == 0xD800)) { + if (len < TclUtfCount(upChar)) { memmove(dst, src, len); dst += len; } else { @@ -1391,13 +1388,13 @@ Tcl_UtfToUpper( *---------------------------------------------------------------------- */ -int +size_t Tcl_UtfToLower( char *str) /* String to convert in place. */ { int ch, lowChar; char *src, *dst; - int len; + size_t len; /* * Iterate over the string until we hit the terminating null. @@ -1414,7 +1411,7 @@ Tcl_UtfToLower( * char to dst if its size is <= the original char. */ - if ((len < TclUtfCount(lowChar)) || ((lowChar & ~0x7FF) == 0xD800)) { + if (len < TclUtfCount(lowChar)) { memmove(dst, src, len); dst += len; } else { @@ -1445,13 +1442,13 @@ Tcl_UtfToLower( *---------------------------------------------------------------------- */ -int +size_t Tcl_UtfToTitle( char *str) /* String to convert in place. */ { int ch, titleChar, lowChar; char *src, *dst; - int len; + size_t len; /* * Capitalize the first character and then lowercase the rest of the @@ -1464,7 +1461,7 @@ Tcl_UtfToTitle( len = TclUtfToUCS4(src, &ch); titleChar = Tcl_UniCharToTitle(ch); - if ((len < TclUtfCount(titleChar)) || ((titleChar & ~0x7FF) == 0xD800)) { + if (len < TclUtfCount(titleChar)) { memmove(dst, src, len); dst += len; } else { @@ -1480,7 +1477,7 @@ Tcl_UtfToTitle( lowChar = Tcl_UniCharToLower(lowChar); } - if ((len < TclUtfCount(lowChar)) || ((lowChar & ~0x7FF) == 0xD800)) { + if (len < TclUtfCount(lowChar)) { memmove(dst, src, len); dst += len; } else { @@ -1513,7 +1510,7 @@ int TclpUtfNcmp2( const char *cs, /* UTF string to compare to ct. */ const char *ct, /* UTF string cs is compared to. */ - unsigned long numBytes) /* Number of *bytes* to compare. */ + size_t numBytes) /* Number of *bytes* to compare. */ { /* * We can't simply call 'memcmp(cs, ct, numBytes);' because we need to @@ -1560,7 +1557,7 @@ int Tcl_UtfNcmp( const char *cs, /* UTF string to compare to ct. */ const char *ct, /* UTF string cs is compared to. */ - unsigned long numChars) /* Number of UTF chars to compare. */ + size_t numChars) /* Number of UTF chars to compare. */ { Tcl_UniChar ch1 = 0, ch2 = 0; @@ -1618,7 +1615,7 @@ int Tcl_UtfNcasecmp( const char *cs, /* UTF string to compare to ct. */ const char *ct, /* UTF string cs is compared to. */ - unsigned long numChars) /* Number of UTF chars to compare. */ + size_t numChars) /* Number of UTF chars to compare. */ { Tcl_UniChar ch1 = 0, ch2 = 0; @@ -1867,11 +1864,11 @@ Tcl_UniCharToTitle( *---------------------------------------------------------------------- */ -int +size_t Tcl_Char16Len( const unsigned short *uniStr) /* Unicode string to find length of. */ { - int len = 0; + size_t len = 0; while (*uniStr != '\0') { len++; @@ -1898,11 +1895,11 @@ Tcl_Char16Len( */ #undef Tcl_UniCharLen -int +size_t Tcl_UniCharLen( const int *uniStr) /* Unicode string to find length of. */ { - int len = 0; + size_t len = 0; while (*uniStr != '\0') { len++; @@ -1914,7 +1911,7 @@ Tcl_UniCharLen( /* *---------------------------------------------------------------------- * - * Tcl_UniCharNcmp -- + * TclUniCharNcmp -- * * Compare at most numChars unichars of string ucs to string uct. * Both ucs and uct are assumed to be at least numChars unichars long. @@ -1932,35 +1929,7 @@ int TclUniCharNcmp( const Tcl_UniChar *ucs, /* Unicode string to compare to uct. */ const Tcl_UniChar *uct, /* Unicode string ucs is compared to. */ - unsigned long numChars) /* Number of unichars to compare. */ -{ -#if defined(WORDS_BIGENDIAN) && (TCL_UTF_MAX > 3) - /* - * We are definitely on a big-endian machine; memcmp() is safe - */ - - return memcmp(ucs, uct, numChars*sizeof(Tcl_UniChar)); - -#else /* !WORDS_BIGENDIAN */ - /* - * We can't simply call memcmp() because that is not lexically correct. - */ - - for ( ; numChars != 0; ucs++, uct++, numChars--) { - if (*ucs != *uct) { - return (*ucs - *uct); - } - } - return 0; -#endif /* WORDS_BIGENDIAN */ -} - -#if (TCL_UTF_MAX > 3) && !defined(TCL_NO_DEPRECATED) -int -Tcl_UniCharNcmp( - const unsigned short *ucs, /* Unicode string to compare to uct. */ - const unsigned short *uct, /* Unicode string ucs is compared to. */ - unsigned long numChars) /* Number of unichars to compare. */ + size_t numChars) /* Number of unichars to compare. */ { #if defined(WORDS_BIGENDIAN) && (TCL_UTF_MAX > 3) /* @@ -1976,23 +1945,25 @@ Tcl_UniCharNcmp( for ( ; numChars != 0; ucs++, uct++, numChars--) { if (*ucs != *uct) { +#if TCL_UTF_MAX < 4 /* special case for handling upper surrogates */ if (((*ucs & 0xFC00) == 0xD800) && ((*uct & 0xFC00) != 0xD800)) { return 1; } else if (((*uct & 0xFC00) == 0xD800)) { return -1; } +#endif return (*ucs - *uct); } } return 0; #endif /* WORDS_BIGENDIAN */ } -#endif + /* *---------------------------------------------------------------------- * - * Tcl_UniCharNcasecmp -- + * TclUniCharNcasecmp -- * * Compare at most numChars unichars of string ucs to string uct case * insensitive. Both ucs and uct are assumed to be at least numChars @@ -2011,48 +1982,28 @@ int TclUniCharNcasecmp( const Tcl_UniChar *ucs, /* Unicode string to compare to uct. */ const Tcl_UniChar *uct, /* Unicode string ucs is compared to. */ - unsigned long numChars) /* Number of unichars to compare. */ -{ - for ( ; numChars != 0; numChars--, ucs++, uct++) { - if (*ucs != *uct) { - int lcs = Tcl_UniCharToLower(*ucs); - int lct = Tcl_UniCharToLower(*uct); - - if (lcs != lct) { - return (lcs - lct); - } - } - } - return 0; -} - -#if (TCL_UTF_MAX > 3) && !defined(TCL_NO_DEPRECATED) -int -Tcl_UniCharNcasecmp( - const unsigned short *ucs, /* Unicode string to compare to uct. */ - const unsigned short *uct, /* Unicode string ucs is compared to. */ - unsigned long numChars) /* Number of unichars to compare. */ + size_t numChars) /* Number of unichars to compare. */ { for ( ; numChars != 0; numChars--, ucs++, uct++) { if (*ucs != *uct) { - unsigned short lcs = Tcl_UniCharToLower(*ucs); - unsigned short lct = Tcl_UniCharToLower(*uct); + Tcl_UniChar lcs = Tcl_UniCharToLower(*ucs); + Tcl_UniChar lct = Tcl_UniCharToLower(*uct); if (lcs != lct) { +#if TCL_UTF_MAX < 4 /* special case for handling upper surrogates */ if (((lcs & 0xFC00) == 0xD800) && ((lct & 0xFC00) != 0xD800)) { return 1; } else if (((lct & 0xFC00) == 0xD800)) { return -1; } +#endif return (lcs - lct); } } } return 0; } -#endif - /* *---------------------------------------------------------------------- @@ -2395,7 +2346,7 @@ Tcl_UniCharIsWordChar( /* *---------------------------------------------------------------------- * - * Tcl_UniCharCaseMatch -- + * TclUniCharCaseMatch -- * * See if a particular Unicode string matches a particular pattern. * Allows case insensitivity. This is the Unicode equivalent of the char* @@ -2423,7 +2374,7 @@ TclUniCharCaseMatch( * characters. */ int nocase) /* 0 for case sensitive, 1 for insensitive */ { - int ch1 = 0, p; + Tcl_UniChar ch1 = 0, p; while (1) { p = *uniPattern; @@ -2511,7 +2462,7 @@ TclUniCharCaseMatch( */ if (p == '[') { - int startChar, endChar; + Tcl_UniChar startChar, endChar; uniPattern++; ch1 = (nocase ? Tcl_UniCharToLower(*uniStr) : *uniStr); @@ -2581,177 +2532,7 @@ TclUniCharCaseMatch( uniPattern++; } } - -#if (TCL_UTF_MAX > 3) && !defined(TCL_NO_DEPRECATED) -int -Tcl_UniCharCaseMatch( - const unsigned short *uniStr, /* Unicode String. */ - const unsigned short *uniPattern, - /* Pattern, which may contain special - * characters. */ - int nocase) /* 0 for case sensitive, 1 for insensitive */ -{ - unsigned short ch1 = 0, p; - - while (1) { - p = *uniPattern; - - /* - * See if we're at the end of both the pattern and the string. If so, - * we succeeded. If we're at the end of the pattern but not at the end - * of the string, we failed. - */ - - if (p == 0) { - return (*uniStr == 0); - } - if ((*uniStr == 0) && (p != '*')) { - return 0; - } - - /* - * Check for a "*" as the next pattern character. It matches any - * substring. We handle this by skipping all the characters up to the - * next matching one in the pattern, and then calling ourselves - * recursively for each postfix of string, until either we match or we - * reach the end of the string. - */ - - if (p == '*') { - /* - * Skip all successive *'s in the pattern - */ - - while (*(++uniPattern) == '*') { - /* empty body */ - } - p = *uniPattern; - if (p == 0) { - return 1; - } - if (nocase) { - p = Tcl_UniCharToLower(p); - } - while (1) { - /* - * Optimization for matching - cruise through the string - * quickly if the next char in the pattern isn't a special - * character - */ - - if ((p != '[') && (p != '?') && (p != '\\')) { - if (nocase) { - while (*uniStr && (p != *uniStr) - && (p != Tcl_UniCharToLower(*uniStr))) { - uniStr++; - } - } else { - while (*uniStr && (p != *uniStr)) { - uniStr++; - } - } - } - if (Tcl_UniCharCaseMatch(uniStr, uniPattern, nocase)) { - return 1; - } - if (*uniStr == 0) { - return 0; - } - uniStr++; - } - } - - /* - * Check for a "?" as the next pattern character. It matches any - * single character. - */ - - if (p == '?') { - uniPattern++; - uniStr++; - continue; - } - - /* - * Check for a "[" as the next pattern character. It is followed by a - * list of characters that are acceptable, or by a range (two - * characters separated by "-"). - */ - - if (p == '[') { - unsigned short startChar, endChar; - - uniPattern++; - ch1 = (nocase ? Tcl_UniCharToLower(*uniStr) : *uniStr); - uniStr++; - while (1) { - if ((*uniPattern == ']') || (*uniPattern == 0)) { - return 0; - } - startChar = (nocase ? Tcl_UniCharToLower(*uniPattern) - : *uniPattern); - uniPattern++; - if (*uniPattern == '-') { - uniPattern++; - if (*uniPattern == 0) { - return 0; - } - endChar = (nocase ? Tcl_UniCharToLower(*uniPattern) - : *uniPattern); - uniPattern++; - if (((startChar <= ch1) && (ch1 <= endChar)) - || ((endChar <= ch1) && (ch1 <= startChar))) { - /* - * Matches ranges of form [a-z] or [z-a]. - */ - break; - } - } else if (startChar == ch1) { - break; - } - } - while (*uniPattern != ']') { - if (*uniPattern == 0) { - uniPattern--; - break; - } - uniPattern++; - } - uniPattern++; - continue; - } - - /* - * If the next pattern character is '\', just strip off the '\' so we - * do exact matching on the character that follows. - */ - - if (p == '\\') { - if (*(++uniPattern) == '\0') { - return 0; - } - } - - /* - * There's no special character. Just make sure that the next bytes of - * each string match. - */ - - if (nocase) { - if (Tcl_UniCharToLower(*uniStr) != - Tcl_UniCharToLower(*uniPattern)) { - return 0; - } - } else if (*uniStr != *uniPattern) { - return 0; - } - uniStr++; - uniPattern++; - } -} -#endif - /* *---------------------------------------------------------------------- * @@ -2759,7 +2540,7 @@ Tcl_UniCharCaseMatch( * * See if a particular Unicode string matches a particular pattern. * Allows case insensitivity. This is the Unicode equivalent of the char* - * Tcl_StringCaseMatch. This variant of Tcl_UniCharCaseMatch uses counted + * Tcl_StringCaseMatch. This variant of TclUniCharCaseMatch uses counted * Strings, so embedded NULLs are allowed. * * Results: @@ -2776,10 +2557,10 @@ Tcl_UniCharCaseMatch( int TclUniCharMatch( const Tcl_UniChar *string, /* Unicode String. */ - int strLen, /* Length of String */ + size_t strLen, /* Length of String */ const Tcl_UniChar *pattern, /* Pattern, which may contain special * characters. */ - int ptnLen, /* Length of Pattern */ + size_t ptnLen, /* Length of Pattern */ int nocase) /* 0 for case sensitive, 1 for insensitive */ { const Tcl_UniChar *stringEnd, *patternEnd; @@ -2976,7 +2757,7 @@ TclUtfToUCS4( int *ucs4Ptr) /* Filled with the UCS4 codepoint represented * by the UTF-8 string. */ { -# undef Tcl_UtfToUniChar + /* Make use of the #undef Tcl_UtfToUniChar above, which already handles UCS4. */ return Tcl_UtfToUniChar(src, ucs4Ptr); } diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 73f5cf2..0b898f1 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -95,13 +95,6 @@ static ProcessGlobalValue executableName = { #define CONVERT_ANY 16 /* - * The following key is used by Tcl_PrintDouble and TclPrecTraceProc to - * access the precision to be used for double formatting. - */ - -static Tcl_ThreadDataKey precisionKey; - -/* * Prototypes for functions defined later in this file. */ @@ -114,9 +107,9 @@ static Tcl_HashTable * GetThreadHash(Tcl_ThreadDataKey *keyPtr); static int GetWideForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr, size_t endValue, Tcl_WideInt *widePtr); static int FindElement(Tcl_Interp *interp, const char *string, - int stringLength, const char *typeStr, + size_t stringLength, const char *typeStr, const char *typeCode, const char **elementPtr, - const char **nextPtr, int *sizePtr, + const char **nextPtr, size_t *sizePtr, int *literalPtr); /* * The following is the Tcl object type definition for an object that @@ -134,7 +127,8 @@ static const Tcl_ObjType endOffsetType = { NULL, /* freeIntRepProc */ NULL, /* dupIntRepProc */ NULL, /* updateStringProc */ - NULL /* setFromAnyProc */ + NULL, /* setFromAnyProc */ + TCL_OBJTYPE_V0 }; /* @@ -394,10 +388,10 @@ static const Tcl_ObjType endOffsetType = { int TclMaxListLength( const char *bytes, - int numBytes, + size_t numBytes, const char **endPtr) { - int count = 0; + size_t count = 0; if ((numBytes == 0) || ((numBytes == TCL_INDEX_NONE) && (*bytes == '\0'))) { /* Empty string case - quick exit */ @@ -500,13 +494,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). */ - int listLength, /* Number of bytes in the list's string. */ + size_t 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). */ - int *sizePtr, /* If non-zero, fill in with size of + size_t *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 @@ -528,14 +522,14 @@ TclFindDictElement( * containing a Tcl dictionary with zero or * more keys and values (possibly in * braces). */ - int dictLength, /* Number of bytes in the dict's string. */ + size_t 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). */ - int *sizePtr, /* If non-zero, fill in with size of + size_t *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 @@ -557,7 +551,7 @@ FindElement( * containing a Tcl list or dictionary with * zero or more elements (possibly in * braces). */ - int stringLength, /* Number of bytes in the string. */ + size_t 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 @@ -567,7 +561,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). */ - int *sizePtr, /* If non-zero, fill in with size of + size_t *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 @@ -579,10 +573,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. */ - int openBraces = 0; /* Brace nesting level during parse. */ + size_t openBraces = 0; /* Brace nesting level during parse. */ int inQuotes = 0; - int size = 0; - int numChars; + size_t size = 0; + size_t numChars; int literal = 1; const char *p2; @@ -790,21 +784,21 @@ FindElement( *---------------------------------------------------------------------- */ -int +size_t TclCopyAndCollapse( - int count, /* Number of byte to copy from src. */ + size_t count, /* Number of byte to copy from src. */ const char *src, /* Copy from here... */ char *dst) /* ... to here. */ { - int newCount = 0; + size_t newCount = 0; while (count > 0) { char c = *src; if (c == '\\') { char buf[4] = ""; - int numRead; - int backslashCount = TclParseBackslash(src, count, &numRead, buf); + size_t numRead; + size_t backslashCount = TclParseBackslash(src, count, &numRead, buf); memcpy(dst, buf, backslashCount); dst += backslashCount; @@ -857,14 +851,15 @@ 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. */ - int *argcPtr, /* Pointer to location to fill in with the + size_t *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. */ { const char **argv, *end, *element; char *p; - int length, size, i, result, elSize; + int result; + size_t length, size, i, elSize; /* * Allocate enough space to work in. A (const char *) for each (possible) @@ -876,7 +871,7 @@ Tcl_SplitList( size = TclMaxListLength(list, TCL_INDEX_NONE, &end) + 1; length = end - list; - argv = (const char **)ckalloc((size * sizeof(char *)) + length + 1); + argv = (const char **)Tcl_Alloc((size * sizeof(char *)) + length + 1); for (i = 0, p = ((char *) argv) + size*sizeof(char *); *list != 0; i++) { @@ -887,14 +882,14 @@ Tcl_SplitList( &elSize, &literal); length -= (list - prevList); if (result != TCL_OK) { - ckfree(argv); + Tcl_Free((void *)argv); return result; } if (*element == 0) { break; } if (i >= size) { - ckfree(argv); + Tcl_Free((void *)argv); if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "internal error in Tcl_SplitList", TCL_INDEX_NONE)); @@ -941,7 +936,7 @@ Tcl_SplitList( *---------------------------------------------------------------------- */ -int +size_t Tcl_ScanElement( const char *src, /* String to convert to list element. */ int *flagPtr) /* Where to store information to guide @@ -973,15 +968,15 @@ Tcl_ScanElement( *---------------------------------------------------------------------- */ -int +size_t Tcl_ScanCountedElement( const char *src, /* String to convert to Tcl list element. */ - int length, /* Number of bytes in src, or TCL_INDEX_NONE. */ + size_t length, /* Number of bytes in src, or TCL_INDEX_NONE. */ int *flagPtr) /* Where to store information to guide * Tcl_ConvertElement. */ { char flags = CONVERT_ANY; - int numBytes = TclScanElement(src, length, &flags); + size_t numBytes = TclScanElement(src, length, &flags); *flagPtr = flags; return numBytes; @@ -1020,12 +1015,12 @@ Tcl_ScanCountedElement( TCL_HASH_TYPE TclScanElement( const char *src, /* String to convert to Tcl list element. */ - int length, /* Number of bytes in src, or TCL_INDEX_NONE. */ + size_t length, /* Number of bytes in src, or TCL_INDEX_NONE. */ char *flagPtr) /* Where to store information to guide * Tcl_ConvertElement. */ { const char *p = src; - int nestingLevel = 0; /* Brace nesting count */ + size_t 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 @@ -1094,8 +1089,7 @@ TclScanElement( braceCount++; #endif /* COMPAT */ extra++; /* Escape '}' => '\}' */ - nestingLevel--; - if (nestingLevel < 0) { + if (nestingLevel-- < 1) { /* * Unbalanced braces! Cannot format with brace quoting. */ @@ -1171,12 +1165,12 @@ TclScanElement( break; } } - length -= (length > 0); + length -= (length+1 > 1); p++; } endOfString: - if (nestingLevel != 0) { + if (nestingLevel > 0) { /* * Unbalanced braces! Cannot format with brace quoting. */ @@ -1206,7 +1200,7 @@ TclScanElement( bytesNeeded++; } *flagPtr = CONVERT_ESCAPE; - goto overflowCheck; + return bytesNeeded; } if (*flagPtr & CONVERT_ANY) { /* @@ -1254,7 +1248,7 @@ TclScanElement( bytesNeeded += braceCount; } *flagPtr = CONVERT_MASK; - goto overflowCheck; + return bytesNeeded; } #endif /* COMPAT */ if (*flagPtr & TCL_DONT_USE_BRACES) { @@ -1280,7 +1274,7 @@ TclScanElement( bytesNeeded += 2; } *flagPtr = CONVERT_BRACE; - goto overflowCheck; + return bytesNeeded; } /* @@ -1295,11 +1289,6 @@ TclScanElement( bytesNeeded += 2; } *flagPtr = CONVERT_NONE; - - overflowCheck: - if (bytesNeeded > INT_MAX) { - Tcl_Panic("TclScanElement: string length overflow"); - } return bytesNeeded; } @@ -1324,7 +1313,7 @@ TclScanElement( *---------------------------------------------------------------------- */ -int +size_t Tcl_ConvertElement( const char *src, /* Source information for list element. */ char *dst, /* Place to put list-ified element. */ @@ -1354,14 +1343,14 @@ Tcl_ConvertElement( *---------------------------------------------------------------------- */ -int +size_t Tcl_ConvertCountedElement( const char *src, /* Source information for list element. */ - int length, /* Number of bytes in src, or TCL_INDEX_NONE. */ + size_t 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. */ { - int numBytes = TclConvertElement(src, length, dst, flags); + size_t numBytes = TclConvertElement(src, length, dst, flags); dst[numBytes] = '\0'; return numBytes; } @@ -1387,10 +1376,10 @@ Tcl_ConvertCountedElement( *---------------------------------------------------------------------- */ -int +size_t TclConvertElement( const char *src, /* Source information for list element. */ - int length, /* Number of bytes in src, or TCL_INDEX_NONE. */ + size_t 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. */ { @@ -1425,7 +1414,7 @@ TclConvertElement( p[1] = '#'; p += 2; src++; - length -= (length > 0); + length -= (length+1 > 1); } else { conversion = CONVERT_BRACE; } @@ -1466,7 +1455,7 @@ TclConvertElement( } *p = '}'; p++; - return p - dst; + return (size_t)(p - dst); } /* conversion == CONVERT_ESCAPE or CONVERT_MASK */ @@ -1475,7 +1464,7 @@ TclConvertElement( * Formatted string is original string converted to escape sequences. */ - for ( ; length; src++, length -= (length > 0)) { + for ( ; length; src++, length -= (length+1 > 1)) { switch (*src) { case ']': case '[': @@ -1529,7 +1518,7 @@ TclConvertElement( continue; case '\0': if (length == TCL_INDEX_NONE) { - return p - dst; + return (size_t)(p - dst); } /* @@ -1545,7 +1534,7 @@ TclConvertElement( *p = *src; p++; } - return p - dst; + return (size_t)(p - dst); } /* @@ -1570,13 +1559,12 @@ TclConvertElement( char * Tcl_Merge( - int argc, /* How many strings to merge. */ + size_t argc, /* How many strings to merge. */ const char *const *argv) /* Array of string values. */ { #define LOCAL_SIZE 64 char localFlags[LOCAL_SIZE], *flagPtr = NULL; - int i; - unsigned int bytesNeeded = 0; + size_t i, bytesNeeded = 0; char *result, *dst; /* @@ -1584,11 +1572,8 @@ Tcl_Merge( * simpler. */ - if (argc <= 0) { - if (argc < 0) { - Tcl_Panic("Tcl_Merge called with negative argc (%d)", argc); - } - result = (char *)ckalloc(1); + if (argc == 0) { + result = (char *)Tcl_Alloc(1); result[0] = '\0'; return result; } @@ -1600,17 +1585,11 @@ Tcl_Merge( if (argc <= LOCAL_SIZE) { flagPtr = localFlags; } else { - flagPtr = (char *)ckalloc(argc); + flagPtr = (char *)Tcl_Alloc(argc); } for (i = 0; i < argc; i++) { flagPtr[i] = ( i ? TCL_DONT_QUOTE_HASH : 0 ); bytesNeeded += TclScanElement(argv[i], TCL_INDEX_NONE, &flagPtr[i]); - if (bytesNeeded > INT_MAX) { - Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); - } - } - if (bytesNeeded + argc > INT_MAX + 1U) { - Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); } bytesNeeded += argc; @@ -1618,7 +1597,7 @@ Tcl_Merge( * Pass two: copy into the result area. */ - result = (char *)ckalloc(bytesNeeded); + result = (char *)Tcl_Alloc(bytesNeeded); dst = result; for (i = 0; i < argc; i++) { flagPtr[i] |= ( i ? TCL_DONT_QUOTE_HASH : 0 ); @@ -1629,47 +1608,11 @@ Tcl_Merge( dst[-1] = 0; if (flagPtr != localFlags) { - ckfree(flagPtr); + Tcl_Free(flagPtr); } return result; } -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 -/* - *---------------------------------------------------------------------- - * - * Tcl_Backslash -- - * - * Figure out how to handle a backslash sequence. - * - * Results: - * The return value is the character that should be substituted in place - * of the backslash sequence that starts at src. If readPtr isn't NULL - * then it is filled in with a count of the number of characters in the - * backslash sequence. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -char -Tcl_Backslash( - const char *src, /* Points to the backslash character of a - * backslash sequence. */ - int *readPtr) /* Fill in with number of characters read from - * src, unless NULL. */ -{ - char buf[4] = ""; - Tcl_UniChar ch = 0; - - Tcl_UtfBackslash(src, readPtr, buf); - TclUtfToUniChar(buf, &ch); - return (char) ch; -} -#endif /* !TCL_NO_DEPRECATED */ - /* *---------------------------------------------------------------------- * @@ -1687,14 +1630,14 @@ Tcl_Backslash( *---------------------------------------------------------------------- */ -int +size_t TclTrimRight( const char *bytes, /* String to be trimmed... */ - int numBytes, /* ...and its length in bytes */ + size_t numBytes, /* ...and its length in bytes */ /* Calls to TclUtfToUniChar() in this routine * rely on (bytes[numBytes] == '\0'). */ const char *trim, /* String of trim characters... */ - int numTrim) /* ...and its length in bytes */ + size_t numTrim) /* ...and its length in bytes */ /* Calls to TclUtfToUniChar() in this routine * rely on (trim[numTrim] == '\0'). */ { @@ -1712,7 +1655,7 @@ TclTrimRight( do { const char *q = trim; - int pInc = 0, bytesLeft = numTrim; + size_t pInc = 0, bytesLeft = numTrim; pp = Tcl_UtfPrev(p, bytes); do { @@ -1766,14 +1709,14 @@ TclTrimRight( *---------------------------------------------------------------------- */ -int +size_t TclTrimLeft( const char *bytes, /* String to be trimmed... */ - int numBytes, /* ...and its length in bytes */ + size_t numBytes, /* ...and its length in bytes */ /* Calls to TclUtfToUniChar() in this routine * rely on (bytes[numBytes] == '\0'). */ const char *trim, /* String of trim characters... */ - int numTrim) /* ...and its length in bytes */ + size_t numTrim) /* ...and its length in bytes */ /* Calls to TclUtfToUniChar() in this routine * rely on (trim[numTrim] == '\0'). */ { @@ -1790,16 +1733,16 @@ TclTrimLeft( */ do { - int pInc = TclUtfToUCS4(p, &ch1); + size_t pInc = TclUtfToUCS4(p, &ch1); const char *q = trim; - int bytesLeft = numTrim; + size_t bytesLeft = numTrim; /* * Inner loop: scan trim string for match to current character. */ do { - int qInc = TclUtfToUCS4(q, &ch2); + size_t qInc = TclUtfToUCS4(q, &ch2); if (ch1 == ch2) { break; @@ -1840,19 +1783,19 @@ TclTrimLeft( *---------------------------------------------------------------------- */ -int +size_t TclTrim( const char *bytes, /* String to be trimmed... */ - int numBytes, /* ...and its length in bytes */ + size_t numBytes, /* ...and its length in bytes */ /* Calls in this routine * rely on (bytes[numBytes] == '\0'). */ const char *trim, /* String of trim characters... */ - int numTrim, /* ...and its length in bytes */ + size_t numTrim, /* ...and its length in bytes */ /* Calls in this routine * rely on (trim[numTrim] == '\0'). */ - int *trimRightPtr) /* Offset from the end of the string. */ + size_t *trimRightPtr) /* Offset from the end of the string. */ { - int trimLeft = 0, trimRight = 0; + size_t trimLeft = 0, trimRight = 0; /* Empty strings -> nothing to do */ if ((numBytes > 0) && (numTrim > 0)) { @@ -1900,14 +1843,14 @@ TclTrim( */ /* The whitespace characters trimmed during [concat] operations */ -#define CONCAT_WS_SIZE (int) (sizeof(CONCAT_TRIM_SET "") - 1) +#define CONCAT_WS_SIZE (sizeof(CONCAT_TRIM_SET "") - 1) char * Tcl_Concat( - int argc, /* Number of strings to concatenate. */ + size_t argc, /* Number of strings to concatenate. */ const char *const *argv) /* Array of strings to concatenate. */ { - int i, needSpace = 0, bytesNeeded = 0; + size_t i, needSpace = 0, bytesNeeded = 0; char *result, *p; /* @@ -1915,7 +1858,7 @@ Tcl_Concat( */ if (argc == 0) { - result = (char *) ckalloc(1); + result = (char *) Tcl_Alloc(1); result[0] = '\0'; return result; } @@ -1926,27 +1869,16 @@ 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"); - } - } - 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"); } /* * All element bytes + (argc - 1) spaces + 1 terminating NULL. */ - result = (char *)ckalloc(bytesNeeded + argc); + result = (char *)Tcl_Alloc(bytesNeeded + argc); for (p = result, i = 0; i < argc; i++) { - int triml, trimr, elemLength; + size_t triml, trimr, elemLength; const char *element; element = argv[i]; @@ -2004,10 +1936,11 @@ Tcl_Concat( Tcl_Obj * Tcl_ConcatObj( - int objc, /* Number of objects to concatenate. */ + size_t objc, /* Number of objects to concatenate. */ Tcl_Obj *const objv[]) /* Array of objects to concatenate. */ { - int i, elemLength, needSpace = 0, bytesNeeded = 0; + int needSpace = 0; + size_t i, bytesNeeded = 0, elemLength; const char *element; Tcl_Obj *objPtr, *resPtr; @@ -2018,13 +1951,13 @@ Tcl_ConcatObj( */ for (i = 0; i < objc; i++) { - int length; + size_t length; objPtr = objv[i]; if (TclListObjIsCanonical(objPtr)) { continue; } - TclGetStringFromObj(objPtr, &length); + (void)Tcl_GetStringFromObj(objPtr, &length); if (length > 0) { break; } @@ -2068,11 +2001,8 @@ Tcl_ConcatObj( */ for (i = 0; i < objc; i++) { - element = TclGetStringFromObj(objv[i], &elemLength); + element = Tcl_GetStringFromObj(objv[i], &elemLength); bytesNeeded += elemLength; - if (bytesNeeded < 0) { - break; - } } /* @@ -2086,9 +2016,9 @@ Tcl_ConcatObj( Tcl_SetObjLength(resPtr, 0); for (i = 0; i < objc; i++) { - int triml, trimr; + size_t triml, trimr; - element = TclGetStringFromObj(objv[i], &elemLength); + element = Tcl_GetStringFromObj(objv[i], &elemLength); /* Trim away the leading/trailing whitespace. */ triml = TclTrim(element, elemLength, CONCAT_TRIM_SET, @@ -2120,35 +2050,6 @@ Tcl_ConcatObj( return resPtr; } -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 -/* - *---------------------------------------------------------------------- - * - * Tcl_StringMatch -- - * - * See if a particular string matches a particular pattern. - * - * Results: - * The return value is 1 if string matches pattern, and 0 otherwise. The - * matching operation permits the following special characters in the - * pattern: *?\[] (see the manual entry for details on what these mean). - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -#undef Tcl_StringMatch -int -Tcl_StringMatch( - const char *str, /* String. */ - const char *pattern) /* Pattern, which may contain special - * characters. */ -{ - return Tcl_StringCaseMatch(str, pattern, 0); -} -#endif /* TCL_NO_DEPRECATED */ /* *---------------------------------------------------------------------- * @@ -2406,11 +2307,11 @@ Tcl_StringCaseMatch( int TclByteArrayMatch( const unsigned char *string,/* String. */ - int strLen, /* Length of String */ + size_t strLen, /* Length of String */ const unsigned char *pattern, /* Pattern, which may contain special * characters. */ - int ptnLen, /* Length of Pattern */ + size_t ptnLen, /* Length of Pattern */ TCL_UNUSED(int) /*flags*/) { const unsigned char *stringEnd, *patternEnd; @@ -2587,7 +2488,8 @@ TclStringMatchObj( int flags) /* Only TCL_MATCH_NOCASE should be passed, or * 0. */ { - int match, length, plen; + int match; + size_t length = 0, plen = 0; /* * Promote based on the type of incoming object. @@ -2596,11 +2498,11 @@ TclStringMatchObj( trivial = nocase ? 0 : TclMatchIsTrivial(TclGetString(ptnObj)); */ - if (TclHasInternalRep(strObj, &tclUniCharStringType) || (strObj->typePtr == NULL)) { + if (TclHasInternalRep(strObj, &tclStringType) || (strObj->typePtr == NULL)) { Tcl_UniChar *udata, *uptn; - udata = TclGetUnicodeFromObj_(strObj, &length); - uptn = TclGetUnicodeFromObj_(ptnObj, &plen); + udata = Tcl_GetUnicodeFromObj(strObj, &length); + uptn = Tcl_GetUnicodeFromObj(ptnObj, &plen); match = TclUniCharMatch(udata, length, uptn, plen, flags); } else if (TclIsPureByteArray(strObj) && TclIsPureByteArray(ptnObj) && !flags) { @@ -2666,14 +2568,14 @@ char * Tcl_DStringAppend( Tcl_DString *dsPtr, /* Structure describing dynamic string. */ const char *bytes, /* String to append. If length is - * < 0 then this must be null-terminated. */ - int length) /* Number of bytes from "bytes" to append. If - * < 0, then append all of bytes, up to null + * TCL_INDEX_NONE then this must be null-terminated. */ + size_t length) /* Number of bytes from "bytes" to append. If + * TCL_INDEX_NONE, then append all of bytes, up to null * at end. */ { - int newSize; + size_t newSize; - if (length < 0) { + if (length == TCL_INDEX_NONE) { length = strlen(bytes); } newSize = length + dsPtr->length; @@ -2687,12 +2589,12 @@ Tcl_DStringAppend( if (newSize >= dsPtr->spaceAvl) { dsPtr->spaceAvl = newSize * 2; if (dsPtr->string == dsPtr->staticSpace) { - char *newString = (char *)ckalloc(dsPtr->spaceAvl); + char *newString = (char *)Tcl_Alloc(dsPtr->spaceAvl); memcpy(newString, dsPtr->string, dsPtr->length); dsPtr->string = newString; } else { - int index = TCL_INDEX_NONE; + size_t index = TCL_INDEX_NONE; /* See [16896d49fd] */ if (bytes >= dsPtr->string @@ -2700,9 +2602,9 @@ Tcl_DStringAppend( index = bytes - dsPtr->string; } - dsPtr->string = (char *)ckrealloc(dsPtr->string, dsPtr->spaceAvl); + dsPtr->string = (char *)Tcl_Realloc(dsPtr->string, dsPtr->spaceAvl); - if (index >= 0) { + if (index != TCL_INDEX_NONE) { bytes = dsPtr->string + index; } } @@ -2734,8 +2636,8 @@ TclDStringAppendObj( Tcl_DString *dsPtr, Tcl_Obj *objPtr) { - int length; - char *bytes = TclGetStringFromObj(objPtr, &length); + size_t length; + const char *bytes = Tcl_GetStringFromObj(objPtr, &length); return Tcl_DStringAppend(dsPtr, bytes, length); } @@ -2776,7 +2678,8 @@ Tcl_DStringAppendElement( char *dst = dsPtr->string + dsPtr->length; int needSpace = TclNeedSpace(dsPtr->string, dst); char flags = 0; - int quoteHash = 1, newSize; + int quoteHash = 1; + size_t newSize; if (needSpace) { /* @@ -2818,7 +2721,7 @@ Tcl_DStringAppendElement( if (newSize >= dsPtr->spaceAvl) { dsPtr->spaceAvl = newSize * 2; if (dsPtr->string == dsPtr->staticSpace) { - char *newString = (char *)ckalloc(dsPtr->spaceAvl); + char *newString = (char *)Tcl_Alloc(dsPtr->spaceAvl); memcpy(newString, dsPtr->string, dsPtr->length); dsPtr->string = newString; @@ -2831,7 +2734,7 @@ Tcl_DStringAppendElement( offset = element - dsPtr->string; } - dsPtr->string = (char *)ckrealloc(dsPtr->string, dsPtr->spaceAvl); + dsPtr->string = (char *)Tcl_Realloc(dsPtr->string, dsPtr->spaceAvl); if (offset >= 0) { element = dsPtr->string + offset; @@ -2869,8 +2772,7 @@ Tcl_DStringAppendElement( * * Side effects: * The length of dsPtr is changed to length and a null byte is stored at - * that position in the string. If length is larger than the space - * allocated for dsPtr, then a panic occurs. + * that position in the string. * *---------------------------------------------------------------------- */ @@ -2878,13 +2780,10 @@ Tcl_DStringAppendElement( void Tcl_DStringSetLength( Tcl_DString *dsPtr, /* Structure describing dynamic string. */ - int length) /* New length for dynamic string. */ + size_t length) /* New length for dynamic string. */ { - int newsize; + size_t newsize; - if (length < 0) { - length = 0; - } if (length >= dsPtr->spaceAvl) { /* * There are two interesting cases here. In the first case, the user @@ -2905,12 +2804,12 @@ Tcl_DStringSetLength( dsPtr->spaceAvl = length + 1; } if (dsPtr->string == dsPtr->staticSpace) { - char *newString = (char *)ckalloc(dsPtr->spaceAvl); + char *newString = (char *)Tcl_Alloc(dsPtr->spaceAvl); memcpy(newString, dsPtr->string, dsPtr->length); dsPtr->string = newString; } else { - dsPtr->string = (char *)ckrealloc(dsPtr->string, dsPtr->spaceAvl); + dsPtr->string = (char *)Tcl_Realloc(dsPtr->string, dsPtr->spaceAvl); } } dsPtr->length = length; @@ -2940,7 +2839,7 @@ Tcl_DStringFree( Tcl_DString *dsPtr) /* Structure describing dynamic string. */ { if (dsPtr->string != dsPtr->staticSpace) { - ckfree(dsPtr->string); + Tcl_Free(dsPtr->string); } dsPtr->string = dsPtr->staticSpace; dsPtr->length = 0; @@ -3002,86 +2901,12 @@ Tcl_DStringGetResult( Tcl_DString *dsPtr) /* Dynamic string that is to become the result * of interp. */ { -#if defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8 Tcl_Obj *obj = Tcl_GetObjResult(interp); - const char *bytes = TclGetString(obj); + char *bytes = TclGetString(obj); Tcl_DStringFree(dsPtr); Tcl_DStringAppend(dsPtr, bytes, obj->length); Tcl_ResetResult(interp); -#else - Interp *iPtr = (Interp *) interp; - - if (dsPtr->string != dsPtr->staticSpace) { - ckfree(dsPtr->string); - } - - /* - * Do more efficient transfer when we know the result is a Tcl_Obj. When - * there's no string result, we only have to deal with two cases: - * - * 1. When the string rep is the empty string, when we don't copy but - * instead use the staticSpace in the DString to hold an empty string. - - * 2. When the string rep is not there or there's a real string rep, when - * we use Tcl_GetString to fetch (or generate) the string rep - which - * we know to have been allocated with ckalloc() - and use it to - * populate the DString space. Then, we free the internal rep. and set - * the object's string representation back to the canonical empty - * string. - */ - - if (!iPtr->result[0] && iPtr->objResultPtr - && !Tcl_IsShared(iPtr->objResultPtr)) { - if (iPtr->objResultPtr->bytes == &tclEmptyString) { - dsPtr->string = dsPtr->staticSpace; - dsPtr->string[0] = 0; - dsPtr->length = 0; - dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE; - } else { - dsPtr->string = TclGetString(iPtr->objResultPtr); - dsPtr->length = iPtr->objResultPtr->length; - dsPtr->spaceAvl = dsPtr->length + 1; - TclFreeInternalRep(iPtr->objResultPtr); - iPtr->objResultPtr->bytes = &tclEmptyString; - iPtr->objResultPtr->length = 0; - } - return; - } - - /* - * If the string result is empty, move the object result to the string - * result, then reset the object result. - */ - - (void) Tcl_GetStringResult(interp); - - dsPtr->length = strlen(iPtr->result); - if (iPtr->freeProc != NULL) { - if (iPtr->freeProc == TCL_DYNAMIC) { - dsPtr->string = iPtr->result; - dsPtr->spaceAvl = dsPtr->length+1; - } else { - dsPtr->string = (char *)ckalloc(dsPtr->length+1); - memcpy(dsPtr->string, iPtr->result, dsPtr->length+1); - iPtr->freeProc(iPtr->result); - } - dsPtr->spaceAvl = dsPtr->length+1; - iPtr->freeProc = NULL; - } else { - if (dsPtr->length < TCL_DSTRING_STATIC_SIZE) { - dsPtr->string = dsPtr->staticSpace; - dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE; - } else { - dsPtr->string = (char *)ckalloc(dsPtr->length+1); - dsPtr->spaceAvl = dsPtr->length + 1; - } - memcpy(dsPtr->string, iPtr->result, dsPtr->length+1); - } - - iPtr->result = iPtr->resultSpace; - iPtr->resultSpace[0] = 0; -#endif /* !TCL_NO_DEPRECATED */ } /* @@ -3207,10 +3032,9 @@ Tcl_DStringEndSublist( * string using. * * Results: - * The ASCII equivalent of "value" is written at "dst". It is written - * using the current precision, and it is guaranteed to contain a decimal - * point or exponent, so that it looks like a floating-point value and - * not an integer. + * The ASCII equivalent of "value" is written at "dst". It is guaranteed + * to contain a decimal point or exponent, so that it looks like a + * floating-point value and not an integer. * * Side effects: * None. @@ -3230,7 +3054,6 @@ Tcl_PrintDouble( int signum; char *digits; char *end; - int *precisionPtr = (int *)Tcl_GetThreadData(&precisionKey, sizeof(int)); /* * Handle NaN. @@ -3262,53 +3085,8 @@ Tcl_PrintDouble( * Ordinary (normal and denormal) values. */ - if (*precisionPtr == 0) { - digits = TclDoubleDigits(value, TCL_INDEX_NONE, TCL_DD_SHORTEST, - &exponent, &signum, &end); - } else { - /* - * There are at least two possible interpretations for tcl_precision. - * - * The first is, "choose the decimal representation having - * $tcl_precision digits of significance that is nearest to the given - * number, breaking ties by rounding to even, and then trimming - * trailing zeros." This gives the greatest possible precision in the - * decimal string, but offers the anomaly that [expr 0.1] will be - * "0.10000000000000001". - * - * The second is "choose the decimal representation having at most - * $tcl_precision digits of significance that is nearest to the given - * number. If no such representation converts exactly to the given - * number, choose the one that is closest, breaking ties by rounding - * to even. If more than one such representation converts exactly to - * the given number, choose the shortest, breaking ties in favour of - * the nearest, breaking remaining ties in favour of the one ending in - * an even digit." - * - * Tcl 8.4 implements the first of these, which gives rise to - * anomalies in formatting: - * - * % expr 0.1 - * 0.10000000000000001 - * % expr 0.01 - * 0.01 - * % expr 1e-7 - * 9.9999999999999995e-08 - * - * For human readability, it appears better to choose the second rule, - * and let [expr 0.1] return 0.1. But for 8.4 compatibility, we prefer - * the first (the recommended zero value for tcl_precision avoids the - * problem entirely). - * - * Uncomment TCL_DD_SHORTEST in the next call to prefer the method - * that allows floating point values to be shortened if it can be done - * without loss of precision. - */ - - digits = TclDoubleDigits(value, *precisionPtr, - TCL_DD_E_FORMAT /* | TCL_DD_SHORTEST */, - &exponent, &signum, &end); - } + digits = TclDoubleDigits(value, -1, TCL_DD_SHORTEST, + &exponent, &signum, &end); if (signum) { *dst++ = '-'; } @@ -3328,16 +3106,7 @@ Tcl_PrintDouble( } } - /* - * Tcl 8.4 appears to format with at least a two-digit exponent; - * preserve that behaviour when tcl_precision != 0 - */ - - if (*precisionPtr == 0) { - sprintf(dst, "e%+d", exponent); - } else { - sprintf(dst, "e%+03d", exponent); - } + sprintf(dst, "e%+d", exponent); } else { /* * F format for others. @@ -3369,87 +3138,8 @@ Tcl_PrintDouble( } *dst++ = '\0'; } - ckfree(digits); -} - -/* - *---------------------------------------------------------------------- - * - * TclPrecTraceProc -- - * - * This function is invoked whenever the variable "tcl_precision" is - * written. - * - * Results: - * Returns NULL if all went well, or an error message if the new value - * for the variable doesn't make sense. - * - * Side effects: - * If the new value doesn't make sense then this function undoes the - * effect of the variable modification. Otherwise it modifies the format - * string that's used by Tcl_PrintDouble. - * - *---------------------------------------------------------------------- - */ - -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 -char * -TclPrecTraceProc( - void *clientData, - Tcl_Interp *interp, /* Interpreter containing variable. */ - const char *name1, /* Name of variable. */ - const char *name2, /* Second part of variable name. */ - int flags) /* Information about what happened. */ -{ - Tcl_Obj *value; - Tcl_WideInt prec; - int *precisionPtr = (int *)Tcl_GetThreadData(&precisionKey, sizeof(int)); - - /* - * If the variable is unset, then recreate the trace. - */ - - if (flags & TCL_TRACE_UNSETS) { - if ((flags & TCL_TRACE_DESTROYED) && !Tcl_InterpDeleted(interp)) { - Tcl_TraceVar2(interp, name1, name2, - TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES - |TCL_TRACE_UNSETS, TclPrecTraceProc, clientData); - } - return NULL; - } - - /* - * When the variable is read, reset its value from our shared value. This - * is needed in case the variable was modified in some other interpreter - * so that this interpreter's value is out of date. - */ - - - if (flags & TCL_TRACE_READS) { - Tcl_SetVar2Ex(interp, name1, name2, Tcl_NewWideIntObj(*precisionPtr), - flags & TCL_GLOBAL_ONLY); - return NULL; - } - - /* - * The variable is being written. Check the new value and disallow it if - * it isn't reasonable or if this is a safe interpreter (we don't want - * safe interpreters messing up the precision of other interpreters). - */ - - if (Tcl_IsSafe(interp)) { - return (char *) "can't modify precision from a safe interpreter"; - } - value = Tcl_GetVar2Ex(interp, name1, name2, flags & TCL_GLOBAL_ONLY); - if (value == NULL - || Tcl_GetWideIntFromObj(NULL, value, &prec) != TCL_OK - || prec < 0 || prec > TCL_MAX_PREC) { - return (char *) "improper value for precision"; - } - *precisionPtr = (int)prec; - return NULL; + Tcl_Free(digits); } -#endif /* !TCL_NO_DEPRECATED)*/ /* *---------------------------------------------------------------------- @@ -3569,15 +3259,14 @@ TclNeedSpace( *---------------------------------------------------------------------- */ -int +size_t TclFormatInt( char *buffer, /* Points to the storage into which the * formatted characters are written. */ Tcl_WideInt n) /* The integer to format. */ { - Tcl_WideUInt intVal; - int i = 0; - int numFormatted, j; + Tcl_WideUInt intVal; + size_t i = 0, numFormatted, j; static const char digits[] = "0123456789"; /* @@ -3704,9 +3393,9 @@ Tcl_GetIntForIndex( * errors. */ Tcl_Obj *objPtr, /* Points to an object containing either "end" * or an integer. */ - int endValue, /* The value to be stored at "indexPtr" if + size_t endValue, /* The value to be stored at "indexPtr" if * "objPtr" holds "end". */ - int *indexPtr) /* Location filled in with an integer + size_t *indexPtr) /* Location filled in with an integer * representing an index. May be NULL.*/ { Tcl_WideInt wide; @@ -3715,14 +3404,12 @@ Tcl_GetIntForIndex( return TCL_ERROR; } if (indexPtr != NULL) { - if ((wide < 0) && (endValue >= 0)) { + if ((wide < 0) && (endValue < TCL_INDEX_END)) { *indexPtr = TCL_INDEX_NONE; - } else if (wide > INT_MAX) { - *indexPtr = INT_MAX; - } else if (wide < INT_MIN) { - *indexPtr = INT_MIN; + } else if ((Tcl_WideUInt)wide > TCL_INDEX_END && (endValue < TCL_INDEX_END)) { + *indexPtr = TCL_INDEX_END; } else { - *indexPtr = (int) wide; + *indexPtr = (size_t) wide; } } return TCL_OK; @@ -3770,8 +3457,8 @@ GetEndOffsetFromObj( while ((irPtr = TclFetchInternalRep(objPtr, &endOffsetType)) == NULL) { Tcl_ObjInternalRep ir; - int length; - const char *bytes = TclGetStringFromObj(objPtr, &length); + size_t length; + const char *bytes = Tcl_GetStringFromObj(objPtr, &length); if (*bytes != 'e') { int numType; @@ -3963,8 +3650,6 @@ GetEndOffsetFromObj( *widePtr = endValue + 1; } else if (offset == WIDE_MIN) { *widePtr = -1; - } else if (endValue == (size_t)-1) { - *widePtr = offset; } else if (offset < 0) { /* Different signs, sum cannot overflow */ *widePtr = endValue + offset + 1; @@ -3985,7 +3670,6 @@ GetEndOffsetFromObj( if (!strncmp(bytes, "end-", 4)) { bytes += 4; } - TclCheckBadOctal(interp, bytes); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL); } @@ -4051,8 +3735,8 @@ int TclIndexEncode( Tcl_Interp *interp, /* For error reporting, may be NULL */ Tcl_Obj *objPtr, /* Index value to parse */ - int before, /* Value to return for index before beginning */ - int after, /* Value to return for index after end */ + size_t before, /* Value to return for index before beginning */ + size_t after, /* Value to return for index after end */ int *indexPtr) /* Where to write the encoded answer, not NULL */ { Tcl_WideInt wide; @@ -4068,13 +3752,23 @@ TclIndexEncode( * We parsed an end+offset index value. * wide holds the offset value in the range WIDE_MIN...WIDE_MAX. */ - if (wide > (unsigned)(irPtr ? TCL_INDEX_END : INT_MAX)) { + 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)) { /* * All end+postive or end-negative expressions * always indicate "after the end". */ idx = after; - } else if (wide <= (irPtr ? INT_MAX : TCL_INDEX_NONE)) { + } else if (wide <= (irPtr ? INT_MAX : -1)) { /* These indices always indicate "before the beginning */ idx = before; } else { @@ -4103,17 +3797,16 @@ TclIndexEncode( *---------------------------------------------------------------------- */ -int +size_t TclIndexDecode( int encoded, /* Value to decode */ - int endValue) /* Meaning of "end" to use, > TCL_INDEX_END */ + size_t endValue) /* Meaning of "end" to use, > TCL_INDEX_END */ { - if (encoded > TCL_INDEX_END) { + if (encoded > (int)TCL_INDEX_END) { return encoded; } - endValue += encoded - TCL_INDEX_END; - if (endValue >= 0) { - return endValue; + if (endValue >= TCL_INDEX_END - encoded) { + return endValue + encoded - TCL_INDEX_END; } return TCL_INDEX_NONE; } @@ -4121,73 +3814,6 @@ TclIndexDecode( /* *---------------------------------------------------------------------- * - * TclCheckBadOctal -- - * - * This function checks for a bad octal value and appends a meaningful - * error to the interp's result. - * - * Results: - * 1 if the argument was a bad octal, else 0. - * - * Side effects: - * The interpreter's result is modified. - * - *---------------------------------------------------------------------- - */ - -int -TclCheckBadOctal( - Tcl_Interp *interp, /* Interpreter to use for error reporting. If - * NULL, then no error message is left after - * errors. */ - const char *value) /* String to check. */ -{ - const char *p = value; - - /* - * A frequent mistake is invalid octal values due to an unwanted leading - * zero. Try to generate a meaningful error message. - */ - - while (TclIsSpaceProcM(*p)) { - p++; - } - if (*p == '+' || *p == '-') { - p++; - } - if (*p == '0') { - if ((p[1] == 'o') || p[1] == 'O') { - p += 2; - } - while (isdigit(UCHAR(*p))) { /* INTL: digit. */ - p++; - } - while (TclIsSpaceProcM(*p)) { - p++; - } - if (*p == '\0') { - /* - * Reached end of string. - */ - - if (interp != NULL) { - /* - * Don't reset the result here because we want this result to - * be added to an existing error message as extra info. - */ - - Tcl_AppendToObj(Tcl_GetObjResult(interp), - " (looks like invalid octal number)", TCL_INDEX_NONE); - } - return 1; - } - } - return 0; -} - -/* - *---------------------------------------------------------------------- - * * ClearHash -- * * Remove all the entries in the hash table *tablePtr. @@ -4237,7 +3863,7 @@ GetThreadHash( (Tcl_HashTable **)Tcl_GetThreadData(keyPtr, sizeof(Tcl_HashTable *)); if (NULL == *tablePtrPtr) { - *tablePtrPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable)); + *tablePtrPtr = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_CreateThreadExitHandler(FreeThreadHash, *tablePtrPtr); Tcl_InitHashTable(*tablePtrPtr, TCL_ONE_WORD_KEYS); } @@ -4266,7 +3892,7 @@ FreeThreadHash( ClearHash(tablePtr); Tcl_DeleteHashTable(tablePtr); - ckfree(tablePtr); + Tcl_Free(tablePtr); } /* @@ -4288,7 +3914,7 @@ FreeProcessGlobalValue( pgvPtr->epoch++; pgvPtr->numBytes = 0; - ckfree(pgvPtr->value); + Tcl_Free(pgvPtr->value); pgvPtr->value = NULL; if (pgvPtr->encoding) { Tcl_FreeEncoding(pgvPtr->encoding); @@ -4327,13 +3953,13 @@ TclSetProcessGlobalValue( pgvPtr->epoch++; if (NULL != pgvPtr->value) { - ckfree(pgvPtr->value); + Tcl_Free(pgvPtr->value); } else { Tcl_CreateExitHandler(FreeProcessGlobalValue, pgvPtr); } bytes = TclGetString(newValue); pgvPtr->numBytes = newValue->length; - pgvPtr->value = (char *)ckalloc(pgvPtr->numBytes + 1); + pgvPtr->value = (char *)Tcl_Alloc(pgvPtr->numBytes + 1); memcpy(pgvPtr->value, bytes, pgvPtr->numBytes + 1); if (pgvPtr->encoding) { Tcl_FreeEncoding(pgvPtr->encoding); @@ -4375,7 +4001,7 @@ TclGetProcessGlobalValue( Tcl_Obj *value = NULL; Tcl_HashTable *cacheMap; Tcl_HashEntry *hPtr; - int epoch = pgvPtr->epoch; + size_t epoch = pgvPtr->epoch; if (pgvPtr->encoding) { Tcl_Encoding current = Tcl_GetEncoding(NULL, NULL); @@ -4391,13 +4017,13 @@ TclGetProcessGlobalValue( Tcl_MutexLock(&pgvPtr->mutex); epoch = ++pgvPtr->epoch; - Tcl_UtfToExternalDString(pgvPtr->encoding, pgvPtr->value, - pgvPtr->numBytes, &native); - Tcl_ExternalToUtfDString(current, Tcl_DStringValue(&native), - Tcl_DStringLength(&native), &newValue); + Tcl_UtfToExternalDStringEx(pgvPtr->encoding, pgvPtr->value, + pgvPtr->numBytes, TCL_ENCODING_NOCOMPLAIN, &native); + Tcl_ExternalToUtfDStringEx(current, Tcl_DStringValue(&native), + Tcl_DStringLength(&native), TCL_ENCODING_NOCOMPLAIN, &newValue); Tcl_DStringFree(&native); - ckfree(pgvPtr->value); - pgvPtr->value = (char *)ckalloc(Tcl_DStringLength(&newValue) + 1); + Tcl_Free(pgvPtr->value); + pgvPtr->value = (char *)Tcl_Alloc(Tcl_DStringLength(&newValue) + 1); memcpy(pgvPtr->value, Tcl_DStringValue(&newValue), Tcl_DStringLength(&newValue) + 1); Tcl_DStringFree(&newValue); @@ -4537,31 +4163,6 @@ Tcl_GetNameOfExecutable(void) /* *---------------------------------------------------------------------- * - * TclpGetTime -- - * - * Deprecated synonym for Tcl_GetTime. This function is provided for the - * benefit of extensions written before Tcl_GetTime was exported from the - * library. - * - * Results: - * None. - * - * Side effects: - * Stores current time in the buffer designated by "timePtr" - * - *---------------------------------------------------------------------- - */ - -void -TclpGetTime( - Tcl_Time *timePtr) -{ - Tcl_GetTime(timePtr); -} - -/* - *---------------------------------------------------------------------- - * * TclGetPlatform -- * * This is a kludge that allows the test library to get access the @@ -4606,7 +4207,7 @@ int TclReToGlob( Tcl_Interp *interp, const char *reStr, - int reStrLen, + size_t reStrLen, Tcl_DString *dsPtr, int *exactPtr, int *quantifiersFoundPtr) diff --git a/generic/tclVar.c b/generic/tclVar.c index 2a96fb6..6226e1e 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -108,9 +108,6 @@ VarHashNextVar( return VarHashGetValue(hPtr); } -#define VarHashGetKey(varPtr) \ - (((VarInHash *)(varPtr))->entry.key.objPtr) - #define VarHashDeleteTable(tablePtr) \ Tcl_DeleteHashTable(&(tablePtr)->table) @@ -248,7 +245,7 @@ static Tcl_DupInternalRepProc DupParsedVarName; static const Tcl_ObjType localVarNameType = { "localVarName", - FreeLocalVarName, DupLocalVarName, NULL, NULL + FreeLocalVarName, DupLocalVarName, NULL, NULL, TCL_OBJTYPE_V0 }; #define LocalSetInternalRep(objPtr, index, namePtr) \ @@ -266,12 +263,12 @@ static const Tcl_ObjType localVarNameType = { const Tcl_ObjInternalRep *irPtr; \ irPtr = TclFetchInternalRep((objPtr), &localVarNameType); \ (name) = irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr1 : NULL; \ - (index) = irPtr ? PTR2INT(irPtr->twoPtrValue.ptr2) : -1; \ + (index) = irPtr ? PTR2UINT(irPtr->twoPtrValue.ptr2) : TCL_INDEX_NONE; \ } while (0) static const Tcl_ObjType parsedVarNameType = { "parsedVarName", - FreeParsedVarName, DupParsedVarName, NULL, NULL + FreeParsedVarName, DupParsedVarName, NULL, NULL, TCL_OBJTYPE_V0 }; #define ParsedSetInternalRep(objPtr, arrayPtr, elem) \ @@ -340,7 +337,7 @@ NotArrayError( Tcl_Interp *interp, Tcl_Obj *name) { - const char *nameStr = Tcl_GetString(name); + const char *nameStr = TclGetString(name); Tcl_SetObjResult(interp, Tcl_ObjPrintf("\"%s\" isn't an array", nameStr)); @@ -379,18 +376,20 @@ CleanupVar( { if (TclIsVarUndefined(varPtr) && TclIsVarInHash(varPtr) && !TclIsVarTraced(varPtr) - && (VarHashRefCount(varPtr) == !TclIsVarDeadHash(varPtr))) { + && (VarHashRefCount(varPtr) == (unsigned) + !TclIsVarDeadHash(varPtr))) { if (VarHashRefCount(varPtr) == 0) { - ckfree(varPtr); + Tcl_Free(varPtr); } else { VarHashDeleteEntry(varPtr); } } if (arrayPtr != NULL && TclIsVarUndefined(arrayPtr) && TclIsVarInHash(arrayPtr) && !TclIsVarTraced(arrayPtr) && - (VarHashRefCount(arrayPtr) == !TclIsVarDeadHash(arrayPtr))) { + (VarHashRefCount(arrayPtr) == (unsigned) + !TclIsVarDeadHash(arrayPtr))) { if (VarHashRefCount(arrayPtr) == 0) { - ckfree(arrayPtr); + Tcl_Free(arrayPtr); } else { VarHashDeleteEntry(arrayPtr); } @@ -605,14 +604,14 @@ TclObjLookupVarEx( const char *errMsg = NULL; int index, parsed = 0; - int localIndex; + size_t localIndex; Tcl_Obj *namePtr, *arrayPtr, *elem; *arrayPtrPtr = NULL; restart: LocalGetInternalRep(part1Ptr, localIndex, namePtr); - if (localIndex >= 0) { + if (localIndex != TCL_INDEX_NONE) { if (HasLocalVars(varFramePtr) && !(flags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY)) && (localIndex < varFramePtr->numCompiledLocals)) { @@ -660,8 +659,8 @@ TclObjLookupVarEx( * part1Ptr is possibly an unparsed array element. */ - int len; - const char *part1 = TclGetStringFromObj(part1Ptr, &len); + size_t len; + const char *part1 = Tcl_GetStringFromObj(part1Ptr, &len); if ((len > 1) && (part1[len - 1] == ')')) { const char *part2 = strchr(part1, '('); @@ -842,8 +841,9 @@ TclLookupSimpleVar( * the variable. */ Namespace *varNsPtr, *cxtNsPtr, *dummy1Ptr, *dummy2Ptr; ResolverScheme *resPtr; - int isNew, i, result, varLen; - const char *varName = TclGetStringFromObj(varNamePtr, &varLen); + int isNew, i, result; + size_t varLen; + const char *varName = Tcl_GetStringFromObj(varNamePtr, &varLen); varPtr = NULL; varNsPtr = NULL; /* Set non-NULL if a nonlocal variable. */ @@ -915,12 +915,8 @@ TclLookupSimpleVar( *indexPtr = -1; flags = (flags | TCL_GLOBAL_ONLY) & ~TCL_NAMESPACE_ONLY; } else { - if (flags & TCL_AVOID_RESOLVERS) { - flags = (flags | TCL_NAMESPACE_ONLY); - } - if (flags & TCL_NAMESPACE_ONLY) { - *indexPtr = -2; - } + flags = (flags | TCL_NAMESPACE_ONLY); + *indexPtr = -2; } /* @@ -976,13 +972,13 @@ TclLookupSimpleVar( if (localCt > 0) { Tcl_Obj **objPtrPtr = &varFramePtr->localCachePtr->varName0; const char *localNameStr; - int localLen; + size_t localLen; for (i=0 ; i<localCt ; i++, objPtrPtr++) { Tcl_Obj *objPtr = *objPtrPtr; if (objPtr) { - localNameStr = TclGetStringFromObj(objPtr, &localLen); + localNameStr = Tcl_GetStringFromObj(objPtr, &localLen); if ((varLen == localLen) && (varName[0] == localNameStr[0]) && !memcmp(varName, localNameStr, varLen)) { @@ -995,8 +991,9 @@ TclLookupSimpleVar( tablePtr = varFramePtr->varTablePtr; if (create) { if (tablePtr == NULL) { - tablePtr = (TclVarHashTable *)ckalloc(sizeof(TclVarHashTable)); + tablePtr = (TclVarHashTable *)Tcl_Alloc(sizeof(TclVarHashTable)); TclInitVarHashTable(tablePtr, NULL); + tablePtr->arrayPtr = varPtr; varFramePtr->varTablePtr = tablePtr; } varPtr = VarHashCreateVar(tablePtr, varNamePtr, &isNew); @@ -1143,51 +1140,6 @@ TclLookupArrayElement( /* *---------------------------------------------------------------------- * - * Tcl_GetVar -- - * - * Return the value of a Tcl variable as a string. - * - * Results: - * The return value points to the current value of varName as a string. - * If the variable is not defined or can't be read because of a clash in - * array usage then a NULL pointer is returned and an error message is - * left in the interp's result if the TCL_LEAVE_ERR_MSG flag is set. - * Note: the return value is only valid up until the next change to the - * variable; if you depend on the value lasting longer than that, then - * make yourself a private copy. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -#ifndef TCL_NO_DEPRECATED -#undef Tcl_GetVar -const char * -Tcl_GetVar( - Tcl_Interp *interp, /* Command interpreter in which varName is to - * be looked up. */ - const char *varName, /* Name of a variable in interp. */ - int flags) /* OR-ed combination of TCL_GLOBAL_ONLY, - * TCL_NAMESPACE_ONLY or TCL_LEAVE_ERR_MSG - * bits. */ -{ - Tcl_Obj *varNamePtr = Tcl_NewStringObj(varName, -1); - Tcl_Obj *resultPtr = Tcl_ObjGetVar2(interp, varNamePtr, NULL, flags); - - TclDecrRefCount(varNamePtr); - - if (resultPtr == NULL) { - return NULL; - } - return TclGetString(resultPtr); -} -#endif /* TCL_NO_DEPRECATED */ - -/* - *---------------------------------------------------------------------- - * * Tcl_GetVar2 -- * * Return the value of a Tcl variable as a string, given a two-part name @@ -1433,6 +1385,9 @@ TclPtrGetVarIdx( { Interp *iPtr = (Interp *) interp; const char *msg; + Var *initialArrayPtr = arrayPtr; + + TclVarFindHiddenArray(varPtr, arrayPtr); /* * Invoke any read traces that have been set for the variable. @@ -1479,8 +1434,8 @@ TclPtrGetVarIdx( } if (flags & TCL_LEAVE_ERR_MSG) { - if (TclIsVarUndefined(varPtr) && arrayPtr - && !TclIsVarUndefined(arrayPtr)) { + if (TclIsVarUndefined(varPtr) && initialArrayPtr + && !TclIsVarUndefined(initialArrayPtr)) { msg = NOSUCHELEMENT; } else if (TclIsVarArray(varPtr)) { msg = ISARRAY; @@ -1553,53 +1508,6 @@ Tcl_SetObjCmd( /* *---------------------------------------------------------------------- * - * Tcl_SetVar -- - * - * Change the value of a variable. - * - * Results: - * Returns a pointer to the malloc'ed string which is the character - * representation of the variable's new value. The caller must not modify - * this string. If the write operation was disallowed then NULL is - * returned; if the TCL_LEAVE_ERR_MSG flag is set, then an explanatory - * message will be left in the interp's result. Note that the returned - * string may not be the same as newValue; this is because variable - * traces may modify the variable's value. - * - * Side effects: - * If varName is defined as a local or global variable in interp, its - * value is changed to newValue. If varName isn't currently defined, then - * a new global variable by that name is created. - * - *---------------------------------------------------------------------- - */ - -#ifndef TCL_NO_DEPRECATED -#undef Tcl_SetVar -const char * -Tcl_SetVar( - Tcl_Interp *interp, /* Command interpreter in which varName is to - * be looked up. */ - const char *varName, /* Name of a variable in interp. */ - const char *newValue, /* New value for varName. */ - int flags) /* Various flags that tell how to set value: - * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, - * TCL_APPEND_VALUE, TCL_LIST_ELEMENT, - * TCL_LEAVE_ERR_MSG. */ -{ - Tcl_Obj *varValuePtr = Tcl_SetVar2Ex(interp, varName, NULL, - Tcl_NewStringObj(newValue, -1), flags); - - if (varValuePtr == NULL) { - return NULL; - } - return TclGetString(varValuePtr); -} -#endif /* TCL_NO_DEPRECATED */ - -/* - *---------------------------------------------------------------------- - * * Tcl_SetVar2 -- * * Given a two-part variable name, which may refer either to a scalar @@ -2043,6 +1951,8 @@ TclPtrSetVarIdx( goto earlyError; } + TclVarFindHiddenArray(varPtr, arrayPtr); + /* * Invoke any read traces that have been set for the variable if it is * requested. This was done for INST_LAPPEND_* but that was inconsistent @@ -2352,57 +2262,6 @@ TclPtrIncrObjVarIdx( /* *---------------------------------------------------------------------- * - * Tcl_UnsetVar -- - * - * Delete a variable, so that it may not be accessed anymore. - * - * Results: - * Returns TCL_OK if the variable was successfully deleted, TCL_ERROR if - * the variable can't be unset. In the event of an error, if the - * TCL_LEAVE_ERR_MSG flag is set then an error message is left in the - * interp's result. - * - * Side effects: - * If varName is defined as a local or global variable in interp, it is - * deleted. - * - *---------------------------------------------------------------------- - */ - -#ifndef TCL_NO_DEPRECATED -#undef Tcl_UnsetVar -int -Tcl_UnsetVar( - Tcl_Interp *interp, /* Command interpreter in which varName is to - * be looked up. */ - const char *varName, /* Name of a variable in interp. May be either - * a scalar name or an array name or an - * element in an array. */ - int flags) /* OR-ed combination of any of - * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY or - * TCL_LEAVE_ERR_MSG. */ -{ - int result; - Tcl_Obj *varNamePtr; - - varNamePtr = Tcl_NewStringObj(varName, -1); - Tcl_IncrRefCount(varNamePtr); - - /* - * Filter to pass through only the flags this interface supports. - */ - - flags &= (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG); - result = TclObjUnsetVar2(interp, varNamePtr, NULL, flags); - - Tcl_DecrRefCount(varNamePtr); - return result; -} -#endif /* TCL_NO_DEPRECATED */ - -/* - *---------------------------------------------------------------------- - * * Tcl_UnsetVar2 -- * * Delete a variable, given a 2-part name. @@ -2584,6 +2443,7 @@ TclPtrUnsetVarIdx( { Interp *iPtr = (Interp *) interp; int result = (TclIsVarUndefined(varPtr)? TCL_ERROR : TCL_OK); + Var *initialArrayPtr = arrayPtr; /* * Keep the variable alive until we're done with it. We used to @@ -2596,6 +2456,8 @@ TclPtrUnsetVarIdx( VarHashRefCount(varPtr)++; } + TclVarFindHiddenArray(varPtr, arrayPtr); + UnsetVarStruct(varPtr, arrayPtr, iPtr, part1Ptr, part2Ptr, flags, index); /* @@ -2605,7 +2467,7 @@ TclPtrUnsetVarIdx( if (result != TCL_OK) { if (flags & TCL_LEAVE_ERR_MSG) { TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "unset", - ((arrayPtr == NULL) ? NOSUCHVAR : NOSUCHELEMENT), index); + ((initialArrayPtr == NULL) ? NOSUCHVAR : NOSUCHELEMENT), index); Tcl_SetErrorCode(interp, "TCL", "UNSET", "VARNAME", NULL); } } @@ -2713,9 +2575,23 @@ UnsetVarStruct( if ((dummyVar.flags & VAR_TRACED_UNSET) || (arrayPtr && (arrayPtr->flags & VAR_TRACED_UNSET))) { + + /* + * Pass the array element name to TclObjCallVarTraces(), because + * it cannot be determined from dummyVar. Alternatively, indicate + * via flags whether the variable involved in the code that caused + * the trace to be triggered was an array element, for the correct + * formatting of error messages. + */ + if (part2Ptr) { + flags |= VAR_ARRAY_ELEMENT; + } else if (TclIsVarArrayElement(varPtr)) { + part2Ptr = VarHashGetKey(varPtr); + } + dummyVar.flags &= ~VAR_TRACE_ACTIVE; TclObjCallVarTraces(iPtr, arrayPtr, &dummyVar, part1Ptr, part2Ptr, - (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY)) + (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|VAR_ARRAY_ELEMENT)) | TCL_TRACE_UNSETS, /* leaveErrMsg */ 0, index); @@ -2954,9 +2830,9 @@ Tcl_LappendObjCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *varValuePtr, *newValuePtr; - int numElems, createdNewObj; + size_t numElems; Var *varPtr, *arrayPtr; - int result; + int result, createdNewObj; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "varName ?value ...?"); @@ -3172,7 +3048,8 @@ ArrayForNRCmd( Tcl_Obj *varListObj, *arrayNameObj, *scriptObj; ArraySearch *searchPtr = NULL; Var *varPtr; - int isArray, numVars; + int isArray; + size_t numVars; /* * array for {k v} a body @@ -3212,7 +3089,7 @@ ArrayForNRCmd( * Make a new array search, put it on the stack. */ - searchPtr = (ArraySearch *)ckalloc(sizeof(ArraySearch)); + searchPtr = (ArraySearch *)Tcl_Alloc(sizeof(ArraySearch)); ArrayPopulateSearch(interp, arrayNameObj, varPtr, searchPtr); /* @@ -3248,7 +3125,8 @@ ArrayForLoopCallback( Tcl_Obj *keyObj, *valueObj; Var *varPtr; Var *arrayPtr; - int done, varc; + int done; + size_t varc; /* * Process the result from the previous execution of the script body. @@ -3333,7 +3211,7 @@ ArrayForLoopCallback( ArrayDoneSearch(iPtr, varPtr, searchPtr); Tcl_DecrRefCount(searchPtr->name); - ckfree(searchPtr); + Tcl_Free(searchPtr); } TclDecrRefCount(varListObj); @@ -3419,7 +3297,7 @@ ArrayStartSearchCmd( * Make a new array search with a free name. */ - searchPtr = (ArraySearch *)ckalloc(sizeof(ArraySearch)); + searchPtr = (ArraySearch *)Tcl_Alloc(sizeof(ArraySearch)); ArrayPopulateSearch(interp, objv[1], varPtr, searchPtr); Tcl_SetObjResult(interp, searchPtr->name); return TCL_OK; @@ -3683,7 +3561,7 @@ ArrayDoneSearchCmd( ArrayDoneSearch(iPtr, varPtr, searchPtr); Tcl_DecrRefCount(searchPtr->name); - ckfree(searchPtr); + Tcl_Free(searchPtr); return TCL_OK; } @@ -3756,7 +3634,8 @@ ArrayGetCmd( Tcl_Obj **nameObjPtr, *patternObj; Tcl_HashSearch search; const char *pattern; - int i, count, result, isArray; + size_t i, count; + int result, isArray; switch (objc) { case 2: @@ -3913,12 +3792,12 @@ ArrayNamesCmd( static const char *const options[] = { "-exact", "-glob", "-regexp", NULL }; - enum arrayNamesOptionsEnum { OPT_EXACT, OPT_GLOB, OPT_REGEXP }; + enum arrayNamesOptionsEnum {OPT_EXACT, OPT_GLOB, OPT_REGEXP} mode = OPT_GLOB; Var *varPtr, *varPtr2; Tcl_Obj *nameObj, *resultObj, *patternObj; Tcl_HashSearch search; const char *pattern = NULL; - int isArray, mode = OPT_GLOB; + int isArray; if ((objc < 2) || (objc > 4)) { Tcl_WrongNumArgs(interp, 1, objv, "arrayName ?mode? ?pattern?"); @@ -3981,7 +3860,7 @@ ArrayNamesCmd( const char *name = TclGetString(nameObj); int matched = 0; - switch ((enum arrayNamesOptionsEnum) mode) { + switch (mode) { case OPT_EXACT: Tcl_Panic("exact matching shouldn't get here"); case OPT_GLOB: @@ -4048,7 +3927,7 @@ TclFindArrayPtrElements( continue; } nameObj = VarHashGetKey(varPtr); - hPtr = Tcl_CreateHashEntry(tablePtr, (char *) nameObj, &dummy); + hPtr = Tcl_CreateHashEntry(tablePtr, nameObj, &dummy); Tcl_SetHashValue(hPtr, nameObj); } } @@ -4080,7 +3959,8 @@ ArraySetCmd( Tcl_Obj *arrayNameObj; Tcl_Obj *arrayElemObj; Var *varPtr, *arrayPtr; - int result, i; + int result; + size_t i; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "arrayName list"); @@ -4115,11 +3995,12 @@ ArraySetCmd( Tcl_Obj *keyPtr, *valuePtr; Tcl_DictSearch search; int done; + size_t size; - if (Tcl_DictObjSize(interp, arrayElemObj, &done) != TCL_OK) { + if (Tcl_DictObjSize(interp, arrayElemObj, &size) != TCL_OK) { return TCL_ERROR; } - if (done == 0) { + if (size == 0) { /* * Empty, so we'll just force the array to be properly existing * instead. @@ -4158,7 +4039,7 @@ ArraySetCmd( * -compatibility reasons) a list. */ - int elemLen; + size_t elemLen; Tcl_Obj **elemPtrs, *copyListObj; result = TclListObjGetElementsM(interp, arrayElemObj, @@ -4337,7 +4218,7 @@ ArrayStatsCmd( return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewStringObj(stats, -1)); - ckfree(stats); + Tcl_Free(stats); return TCL_OK; } @@ -4795,63 +4676,6 @@ TclPtrObjMakeUpvarIdx( /* *---------------------------------------------------------------------- * - * Tcl_UpVar -- - * - * This function links one variable to another, just like the "upvar" - * command. - * - * Results: - * A standard Tcl completion code. If an error occurs then an error - * message is left in the interp's result. - * - * Side effects: - * The variable in frameName whose name is given by varName becomes - * accessible under the name localNameStr, so that references to - * localNameStr are redirected to the other variable like a symbolic - * link. - * - *---------------------------------------------------------------------- - */ - -#ifndef TCL_NO_DEPRECATED -#undef Tcl_UpVar -int -Tcl_UpVar( - Tcl_Interp *interp, /* Command interpreter in which varName is to - * be looked up. */ - const char *frameName, /* Name of the frame containing the source - * variable, such as "1" or "#0". */ - const char *varName, /* Name of a variable in interp to link to. - * May be either a scalar name or an element - * in an array. */ - const char *localNameStr, /* Name of link variable. */ - int flags) /* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY: - * indicates scope of localNameStr. */ -{ - int result; - CallFrame *framePtr; - Tcl_Obj *varNamePtr, *localNamePtr; - - if (TclGetFrame(interp, frameName, &framePtr) == -1) { - return TCL_ERROR; - } - - varNamePtr = Tcl_NewStringObj(varName, -1); - Tcl_IncrRefCount(varNamePtr); - localNamePtr = Tcl_NewStringObj(localNameStr, -1); - Tcl_IncrRefCount(localNamePtr); - - result = ObjMakeUpvar(interp, framePtr, varNamePtr, NULL, 0, - localNamePtr, flags, -1); - Tcl_DecrRefCount(varNamePtr); - Tcl_DecrRefCount(localNamePtr); - return result; -} -#endif /* TCL_NO_DEPRECATED */ - -/* - *---------------------------------------------------------------------- - * * Tcl_UpVar2 -- * * This function links one variable to another, just like the "upvar" @@ -4957,9 +4781,9 @@ Tcl_GetVariableFullName( Tcl_AppendObjToObj(objPtr, namePtr); } } else if (iPtr->varFramePtr->procPtr) { - int index = varPtr - iPtr->varFramePtr->compiledLocals; + size_t index = varPtr - iPtr->varFramePtr->compiledLocals; - if (index >= 0 && index < iPtr->varFramePtr->numCompiledLocals) { + if (index < iPtr->varFramePtr->numCompiledLocals) { namePtr = localName(iPtr->varFramePtr, index); Tcl_AppendObjToObj(objPtr, namePtr); } @@ -5399,7 +5223,7 @@ DeleteSearches( searchPtr = nextPtr) { nextPtr = searchPtr->nextPtr; Tcl_DecrRefCount(searchPtr->name); - ckfree(searchPtr); + Tcl_Free(searchPtr); } arrayVarPtr->flags &= ~VAR_SEARCH_ACTIVE; Tcl_DeleteHashEntry(sPtr); @@ -5583,7 +5407,7 @@ TclDeleteCompiledLocalVars( * assigned local variables to delete. */ { Var *varPtr; - int numLocals, i; + size_t numLocals, i; Tcl_Obj **namePtrPtr; numLocals = framePtr->numCompiledLocals; @@ -5781,7 +5605,7 @@ static void FreeLocalVarName( Tcl_Obj *objPtr) { - int index; + size_t index; Tcl_Obj *namePtr; LocalGetInternalRep(objPtr, index, namePtr); @@ -5797,7 +5621,7 @@ DupLocalVarName( Tcl_Obj *srcPtr, Tcl_Obj *dupPtr) { - int index; + size_t index; Tcl_Obj *namePtr; LocalGetInternalRep(srcPtr, index, namePtr); @@ -5976,6 +5800,10 @@ ObjFindNamespaceVar( * Find the namespace(s) that contain the variable. */ + if (!(flags & TCL_GLOBAL_ONLY)) { + flags |= TCL_NAMESPACE_ONLY; + } + TclGetNamespaceForQualName(interp, name, (Namespace *) contextNsPtr, flags, &nsPtr[0], &nsPtr[1], &cxtNsPtr, &simpleName); @@ -6377,7 +6205,8 @@ AppendLocals( { Interp *iPtr = (Interp *) interp; Var *varPtr; - int i, localVarCt, added; + size_t i, localVarCt; + int added; Tcl_Obj *objNamePtr; const char *varName; TclVarHashTable *localVarTablePtr; @@ -6529,6 +6358,7 @@ TclInitVarHashTable( Tcl_InitCustomHashTable(&tablePtr->table, TCL_CUSTOM_TYPE_KEYS, &tclVarHashKeyType); tablePtr->nsPtr = nsPtr; + tablePtr->arrayPtr = NULL; } static Tcl_HashEntry * @@ -6540,7 +6370,7 @@ AllocVarEntry( Tcl_HashEntry *hPtr; Var *varPtr; - varPtr = (Var *)ckalloc(sizeof(VarInHash)); + varPtr = (Var *)Tcl_Alloc(sizeof(VarInHash)); varPtr->flags = VAR_IN_HASHTABLE; varPtr->value.objPtr = NULL; VarHashRefCount(varPtr) = 1; @@ -6562,7 +6392,7 @@ FreeVarEntry( if (TclIsVarUndefined(varPtr) && !TclIsVarTraced(varPtr) && (VarHashRefCount(varPtr) == 1)) { - ckfree(varPtr); + Tcl_Free(varPtr); } else { VarHashInvalidateEntry(varPtr); TclSetVarUndefined(varPtr); @@ -6573,13 +6403,13 @@ FreeVarEntry( static int CompareVarKeys( - void *keyPtr, /* New key to compare. */ + void *keyPtr, /* New key to compare. */ Tcl_HashEntry *hPtr) /* Existing key to compare. */ { Tcl_Obj *objPtr1 = (Tcl_Obj *)keyPtr; Tcl_Obj *objPtr2 = hPtr->key.objPtr; const char *p1, *p2; - int l1, l2; + size_t l1, l2; /* * If the object pointers are the same then they match. @@ -6631,10 +6461,10 @@ ArrayDefaultCmd( static const char *const options[] = { "get", "set", "exists", "unset", NULL }; - enum arrayDefaultOptionsEnum { OPT_GET, OPT_SET, OPT_EXISTS, OPT_UNSET }; + enum arrayDefaultOptionsEnum { OPT_GET, OPT_SET, OPT_EXISTS, OPT_UNSET } option; Tcl_Obj *arrayNameObj, *defaultValueObj; Var *varPtr, *arrayPtr; - int isArray, option; + int isArray; /* * Parse arguments. @@ -6655,7 +6485,7 @@ ArrayDefaultCmd( return TCL_ERROR; } - switch ((enum arrayDefaultOptionsEnum)option) { + switch (option) { case OPT_GET: if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "arrayName"); @@ -6769,7 +6599,7 @@ void TclInitArrayVar( Var *arrayPtr) { - ArrayVarHashTable *tablePtr = (ArrayVarHashTable *)ckalloc(sizeof(ArrayVarHashTable)); + ArrayVarHashTable *tablePtr = (ArrayVarHashTable *)Tcl_Alloc(sizeof(ArrayVarHashTable)); /* * Mark the variable as an array. @@ -6783,6 +6613,7 @@ TclInitArrayVar( arrayPtr->value.tablePtr = (TclVarHashTable *) tablePtr; TclInitVarHashTable(arrayPtr->value.tablePtr, TclGetVarNsPtr(arrayPtr)); + arrayPtr->value.tablePtr->arrayPtr = arrayPtr; /* * Default value initialization. @@ -6813,7 +6644,7 @@ DeleteArrayVar( */ VarHashDeleteTable(arrayPtr->value.tablePtr); - ckfree(tablePtr); + Tcl_Free(tablePtr); } /* diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index 3b1d787..48bcd48 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -349,8 +349,8 @@ static int ZipFSLoadFile(Tcl_Interp *interp, Tcl_Obj *path, Tcl_FSUnloadFileProc **unloadProcPtr, int flags); static int ZipMapArchive(Tcl_Interp *interp, ZipFile *zf, void *handle); -static void ZipfsExitHandler(ClientData clientData); -static void ZipfsMountExitHandler(ClientData clientData); +static void ZipfsExitHandler(void *clientData); +static void ZipfsMountExitHandler(void *clientData); static void ZipfsSetup(void); static void ZipfsFinalize(void); static int ZipChannelClose(void *instanceData, @@ -358,10 +358,6 @@ static int ZipChannelClose(void *instanceData, static Tcl_DriverGetHandleProc ZipChannelGetFile; static int ZipChannelRead(void *instanceData, char *buf, int toRead, int *errloc); -#if !defined(TCL_NO_DEPRECATED) && (TCL_MAJOR_VERSION < 9) -static int ZipChannelSeek(void *instanceData, long offset, - int mode, int *errloc); -#endif static long long ZipChannelWideSeek(void *instanceData, long long offset, int mode, int *errloc); static void ZipChannelWatchChannel(void *instanceData, @@ -414,14 +410,10 @@ static const Tcl_Filesystem zipfsFilesystem = { static Tcl_ChannelType ZipChannelType = { "zip", /* Type name. */ TCL_CHANNEL_VERSION_5, - TCL_CLOSE2PROC, /* Close channel, clean instance data */ + NULL, /* Close channel, clean instance data */ ZipChannelRead, /* Handle read request */ ZipChannelWrite, /* Handle write request */ -#if !defined(TCL_NO_DEPRECATED) && (TCL_MAJOR_VERSION < 9) - ZipChannelSeek, /* Move location of access point, NULL'able */ -#else NULL, /* Move location of access point, NULL'able */ -#endif NULL, /* Set options, NULL'able */ NULL, /* Get options, NULL'able */ ZipChannelWatchChannel, /* Initialize notifier */ @@ -437,12 +429,6 @@ static Tcl_ChannelType ZipChannelType = { }; /* - * Miscellaneous constants. - */ - -#define ERROR_LENGTH ((size_t) -1) - -/* *------------------------------------------------------------------------- * * ZipReadInt, ZipReadShort, ZipWriteInt, ZipWriteShort -- @@ -683,11 +669,11 @@ ToDosDate( *------------------------------------------------------------------------- */ -static inline int +static inline size_t CountSlashes( const char *string) { - int count = 0; + size_t count = 0; const char *p = string; while (*p != '\0') { @@ -753,8 +739,7 @@ DecodeZipEntryText( src = (const char *) inputBytes; dst = Tcl_DStringValue(dstPtr); dstLen = dstPtr->spaceAvl - 1; - flags = TCL_ENCODING_START | TCL_ENCODING_END | - TCL_ENCODING_STOPONERROR; /* Special flag! */ + flags = TCL_ENCODING_START | TCL_ENCODING_END; /* Special flag! */ while (1) { int srcRead, dstWrote; @@ -1066,7 +1051,7 @@ AllocateZipFile( size_t mountPointNameLength) { size_t size = sizeof(ZipFile) + mountPointNameLength + 1; - ZipFile *zf = (ZipFile *) attemptckalloc(size); + ZipFile *zf = (ZipFile *) Tcl_AttemptAlloc(size); if (!zf) { ZIPFS_MEM_ERROR(interp); @@ -1079,7 +1064,7 @@ AllocateZipFile( static inline ZipEntry * AllocateZipEntry(void) { - ZipEntry *z = (ZipEntry *) ckalloc(sizeof(ZipEntry)); + ZipEntry *z = (ZipEntry *) Tcl_Alloc(sizeof(ZipEntry)); memset(z, 0, sizeof(ZipEntry)); return z; } @@ -1088,7 +1073,7 @@ static inline ZipChannel * AllocateZipChannel( Tcl_Interp *interp) { - ZipChannel *zc = (ZipChannel *) attemptckalloc(sizeof(ZipChannel)); + ZipChannel *zc = (ZipChannel *) Tcl_AttemptAlloc(sizeof(ZipChannel)); if (!zc) { ZIPFS_MEM_ERROR(interp); @@ -1121,12 +1106,12 @@ ZipFSCloseArchive( ZipFile *zf) { if (zf->nameLength) { - ckfree(zf->name); + Tcl_Free(zf->name); } if (zf->isMemBuffer) { /* Pointer to memory */ if (zf->ptrToFree) { - ckfree(zf->ptrToFree); + Tcl_Free(zf->ptrToFree); zf->ptrToFree = NULL; } zf->data = NULL; @@ -1153,7 +1138,7 @@ ZipFSCloseArchive( #endif /* _WIN32 */ if (zf->ptrToFree) { - ckfree(zf->ptrToFree); + Tcl_Free(zf->ptrToFree); zf->ptrToFree = NULL; } if (zf->chan) { @@ -1397,7 +1382,7 @@ ZipFSOpenArchive( */ zf->length = Tcl_Seek(zf->chan, 0, SEEK_END); - if (zf->length == ERROR_LENGTH) { + if (zf->length == TCL_INDEX_NONE) { ZIPFS_POSIX_ERROR(interp, "seek error"); goto error; } @@ -1411,7 +1396,7 @@ ZipFSOpenArchive( ZIPFS_POSIX_ERROR(interp, "seek error"); goto error; } - zf->ptrToFree = zf->data = (unsigned char *) attemptckalloc(zf->length); + zf->ptrToFree = zf->data = (unsigned char *) Tcl_AttemptAlloc(zf->length); if (!zf->ptrToFree) { ZIPFS_MEM_ERROR(interp); goto error; @@ -1496,7 +1481,7 @@ ZipMapArchive( */ zf->length = lseek(fd, 0, SEEK_END); - if (zf->length == ERROR_LENGTH || zf->length < ZIP_CENTRAL_END_LEN) { + if (zf->length == TCL_INDEX_NONE || zf->length < ZIP_CENTRAL_END_LEN) { ZIPFS_POSIX_ERROR(interp, "invalid file size"); return TCL_ERROR; } @@ -1530,7 +1515,7 @@ static inline int IsPasswordValid( Tcl_Interp *interp, const char *passwd, - int pwlen) + size_t pwlen) { if ((pwlen > 255) || strchr(passwd, 0xff)) { ZIPFS_ERROR(interp, "illegal password"); @@ -1567,8 +1552,8 @@ ZipFSCatalogFilesystem( * the ZIP is unprotected. */ const char *zipname) /* Path to ZIP file to build a catalog of. */ { - int pwlen, isNew; - size_t i; + int isNew; + size_t i, pwlen; ZipFile *zf0; ZipEntry *z; Tcl_HashEntry *hPtr; @@ -1596,7 +1581,7 @@ ZipFSCatalogFilesystem( ZIPFS_ERROR(interp, "bad zip data"); ZIPFS_ERROR_CODE(interp, "BAD_ZIP"); ZipFSCloseArchive(interp, zf); - ckfree(zf); + Tcl_Free(zf); return TCL_ERROR; } @@ -1624,7 +1609,7 @@ ZipFSCatalogFilesystem( } Unlock(); ZipFSCloseArchive(interp, zf); - ckfree(zf); + Tcl_Free(zf); return TCL_ERROR; } Unlock(); @@ -1638,7 +1623,7 @@ ZipFSCatalogFilesystem( zf->mountPointLen = strlen(zf->mountPoint); zf->nameLength = strlen(zipname); - zf->name = (char *) ckalloc(zf->nameLength + 1); + zf->name = (char *) Tcl_Alloc(zf->nameLength + 1); memcpy(zf->name, zipname, zf->nameLength + 1); Tcl_SetHashValue(hPtr, zf); @@ -1776,7 +1761,7 @@ ZipFSCatalogFilesystem( hPtr = Tcl_CreateHashEntry(&ZipFS.fileHash, fullpath, &isNew); if (!isNew) { /* should not happen but skip it anyway */ - ckfree(z); + Tcl_Free(z); goto nextent; } @@ -1873,7 +1858,7 @@ ZipfsSetup(void) ZipFS.idCount = 1; ZipFS.wrmax = DEFAULT_WRITE_MAX_SIZE; ZipFS.fallbackEntryEncoding = (char *) - ckalloc(strlen(ZIPFS_FALLBACK_ENCODING) + 1); + Tcl_Alloc(strlen(ZIPFS_FALLBACK_ENCODING) + 1); strcpy(ZipFS.fallbackEntryEncoding, ZIPFS_FALLBACK_ENCODING); ZipFS.utf8 = Tcl_GetEncoding(NULL, "utf-8"); ZipFS.initialized = 1; @@ -2033,7 +2018,7 @@ TclZipfs_Mount( return TCL_ERROR; } if (ZipFSOpenArchive(interp, zipname, 1, zf) != TCL_OK) { - ckfree(zf); + Tcl_Free(zf); return TCL_ERROR; } if (ZipFSCatalogFilesystem(interp, zf, mountPoint, passwd, zipname) @@ -2110,7 +2095,7 @@ TclZipfs_MountBuffer( zf->isMemBuffer = 1; zf->length = datalen; if (copy) { - zf->data = (unsigned char *) attemptckalloc(datalen); + zf->data = (unsigned char *) Tcl_AttemptAlloc(datalen); if (!zf->data) { ZIPFS_MEM_ERROR(interp); return TCL_ERROR; @@ -2196,13 +2181,13 @@ TclZipfs_Unmount( Tcl_DeleteHashEntry(hPtr); } if (z->data) { - ckfree(z->data); + Tcl_Free(z->data); } - ckfree(z); + Tcl_Free(z); } ZipFSCloseArchive(interp, zf); Tcl_DeleteExitHandler(ZipfsMountExitHandler, zf); - ckfree(zf); + Tcl_Free(zf); unmounted = 1; done: @@ -2231,7 +2216,7 @@ TclZipfs_Unmount( static int ZipFSMountObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -2246,7 +2231,7 @@ ZipFSMountObjCmd( return TCL_ERROR; } if (objc > 1) { - mountPoint = Tcl_GetString(objv[1]); + mountPoint = TclGetString(objv[1]); } if (objc > 2) { zipFileObj = Tcl_FSGetNormalizedPath(interp, objv[2]); @@ -2257,10 +2242,10 @@ ZipFSMountObjCmd( return TCL_ERROR; } Tcl_IncrRefCount(zipFileObj); - zipFile = Tcl_GetString(zipFileObj); + zipFile = TclGetString(zipFileObj); } if (objc > 3) { - password = Tcl_GetString(objv[3]); + password = TclGetString(objv[3]); } result = TclZipfs_Mount(interp, mountPoint, zipFile, password); @@ -2288,14 +2273,14 @@ ZipFSMountObjCmd( static int ZipFSMountBufferObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *mountPoint; /* Mount point path. */ unsigned char *data; - int length; + size_t length; if (objc > 3) { Tcl_WrongNumArgs(interp, 1, objv, "?mountpoint? ?data?"); @@ -2310,7 +2295,7 @@ ZipFSMountBufferObjCmd( return ret; } - mountPoint = Tcl_GetString(objv[1]); + mountPoint = TclGetString(objv[1]); if (objc < 3) { ReadLock(); DescribeMounted(interp, mountPoint); @@ -2318,7 +2303,7 @@ ZipFSMountBufferObjCmd( return TCL_OK; } - data = TclGetBytesFromObj(interp, objv[2], &length); + data = Tcl_GetBytesFromObj(interp, objv[2], &length); if (data == NULL) { return TCL_ERROR; } @@ -2343,7 +2328,7 @@ ZipFSMountBufferObjCmd( static int ZipFSRootObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ TCL_UNUSED(int) /*objc*/, TCL_UNUSED(Tcl_Obj *const *)) /*objv*/ @@ -2370,7 +2355,7 @@ ZipFSRootObjCmd( static int ZipFSUnmountObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -2379,7 +2364,7 @@ ZipFSUnmountObjCmd( Tcl_WrongNumArgs(interp, 1, objv, "zipfile"); return TCL_ERROR; } - return TclZipfs_Unmount(interp, Tcl_GetString(objv[1])); + return TclZipfs_Unmount(interp, TclGetString(objv[1])); } /* @@ -2401,12 +2386,12 @@ ZipFSUnmountObjCmd( static int ZipFSMkKeyObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int len, i = 0; + size_t len, i = 0; const char *pw; Tcl_Obj *passObj; unsigned char *passBuf; @@ -2424,7 +2409,7 @@ ZipFSMkKeyObjCmd( } passObj = Tcl_NewByteArrayObj(NULL, 264); - passBuf = Tcl_GetByteArrayFromObj(passObj, (int *)NULL); + passBuf = Tcl_GetByteArrayFromObj(passObj, (size_t *)NULL); while (len > 0) { int ch = pw[len - 1]; @@ -2559,7 +2544,7 @@ ZipAddFile( zpathlen = strlen(zpathExt); if (zpathlen + ZIP_CENTRAL_HEADER_LEN > bufsize) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "path too long for \"%s\"", Tcl_GetString(pathObj))); + "path too long for \"%s\"", TclGetString(pathObj))); ZIPFS_ERROR_CODE(interp, "PATH_LEN"); Tcl_DStringFree(&zpathDs); return TCL_ERROR; @@ -2593,7 +2578,7 @@ ZipAddFile( nbyte = nbytecompr = 0; while (1) { len = Tcl_Read(in, buf, bufsize); - if (len == ERROR_LENGTH) { + if (len == TCL_INDEX_NONE) { Tcl_DStringFree(&zpathDs); if (nbyte == 0 && errno == EISDIR) { Tcl_Close(interp, in); @@ -2601,7 +2586,7 @@ ZipAddFile( } readErrorWithChannelOpen: Tcl_SetObjResult(interp, Tcl_ObjPrintf("read error on \"%s\": %s", - Tcl_GetString(pathObj), Tcl_PosixError(interp))); + TclGetString(pathObj), Tcl_PosixError(interp))); Tcl_Close(interp, in); return TCL_ERROR; } @@ -2613,7 +2598,7 @@ ZipAddFile( } if (Tcl_Seek(in, 0, SEEK_SET) == -1) { Tcl_SetObjResult(interp, Tcl_ObjPrintf("seek error on \"%s\": %s", - Tcl_GetString(pathObj), Tcl_PosixError(interp))); + TclGetString(pathObj), Tcl_PosixError(interp))); Tcl_Close(interp, in); Tcl_DStringFree(&zpathDs); return TCL_ERROR; @@ -2638,7 +2623,7 @@ ZipAddFile( writeErrorWithChannelOpen: Tcl_SetObjResult(interp, Tcl_ObjPrintf( "write error on \"%s\": %s", - Tcl_GetString(pathObj), Tcl_PosixError(interp))); + TclGetString(pathObj), Tcl_PosixError(interp))); Tcl_Close(interp, in); Tcl_DStringFree(&zpathDs); return TCL_ERROR; @@ -2714,7 +2699,7 @@ ZipAddFile( if (deflateInit2(&stream, 9, Z_DEFLATED, -15, 8, Z_DEFAULT_STRATEGY) != Z_OK) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "compression init error on \"%s\"", Tcl_GetString(pathObj))); + "compression init error on \"%s\"", TclGetString(pathObj))); ZIPFS_ERROR_CODE(interp, "DEFLATE_INIT"); Tcl_Close(interp, in); Tcl_DStringFree(&zpathDs); @@ -2723,7 +2708,7 @@ ZipAddFile( do { len = Tcl_Read(in, buf, bufsize); - if (len == ERROR_LENGTH) { + if (len == TCL_INDEX_NONE) { deflateEnd(&stream); goto readErrorWithChannelOpen; } @@ -2736,7 +2721,7 @@ ZipAddFile( len = deflate(&stream, flush); if (len == (size_t) Z_STREAM_ERROR) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "deflate error on \"%s\"", Tcl_GetString(pathObj))); + "deflate error on \"%s\"", TclGetString(pathObj))); ZIPFS_ERROR_CODE(interp, "DEFLATE"); deflateEnd(&stream); Tcl_Close(interp, in); @@ -2787,7 +2772,7 @@ ZipAddFile( nbytecompr = (passwd ? 12 : 0); while (1) { len = Tcl_Read(in, buf, bufsize); - if (len == ERROR_LENGTH) { + if (len == TCL_INDEX_NONE) { goto readErrorWithChannelOpen; } else if (len == 0) { break; @@ -2823,7 +2808,7 @@ ZipAddFile( hPtr = Tcl_CreateHashEntry(fileHash, zpathTcl, &isNew); if (!isNew) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "non-unique path name \"%s\"", Tcl_GetString(pathObj))); + "non-unique path name \"%s\"", TclGetString(pathObj))); ZIPFS_ERROR_CODE(interp, "DUPLICATE_PATH"); return TCL_ERROR; } @@ -2853,14 +2838,14 @@ ZipAddFile( zpathlen, align); if (Tcl_Seek(out, headerStartOffset, SEEK_SET) != headerStartOffset) { Tcl_DeleteHashEntry(hPtr); - ckfree(z); + Tcl_Free(z); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "seek error: %s", Tcl_PosixError(interp))); return TCL_ERROR; } if (Tcl_Write(out, buf, ZIP_LOCAL_HEADER_LEN) != ZIP_LOCAL_HEADER_LEN) { Tcl_DeleteHashEntry(hPtr); - ckfree(z); + Tcl_Free(z); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "write error: %s", Tcl_PosixError(interp))); return TCL_ERROR; @@ -2868,7 +2853,7 @@ ZipAddFile( Tcl_Flush(out); if (Tcl_Seek(out, dataEndOffset, SEEK_SET) != dataEndOffset) { Tcl_DeleteHashEntry(hPtr); - ckfree(z); + Tcl_Free(z); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "seek error: %s", Tcl_PosixError(interp))); return TCL_ERROR; @@ -2933,14 +2918,14 @@ ComputeNameInArchive( * archive */ const char *strip, /* A prefix to strip; may be NULL if no * stripping need be done. */ - int slen) /* The length of the prefix; must be 0 if no + size_t slen) /* The length of the prefix; must be 0 if no * stripping need be done. */ { const char *name; - int len; + size_t len; if (directNameObj) { - name = Tcl_GetString(directNameObj); + name = TclGetString(directNameObj); } else { name = Tcl_GetStringFromObj(pathObj, &len); if (slen > 0) { @@ -3005,8 +2990,8 @@ ZipFSMkZipOrImg( * there's no password protection. */ { Tcl_Channel out; - int pwlen = 0, slen = 0, count, ret = TCL_ERROR, lobjc; - size_t len, i = 0; + int count, ret = TCL_ERROR; + size_t pwlen = 0, slen = 0, lobjc, len, i = 0; long long directoryStartOffset; /* The overall file offset of the start of the * central directory. */ @@ -3032,9 +3017,8 @@ ZipFSMkZipOrImg( if (IsPasswordValid(interp, pw, pwlen) != TCL_OK) { return TCL_ERROR; } - if (pwlen <= 0) { + if (pwlen == 0) { pw = NULL; - pwlen = 0; } } if (dirRoot != NULL) { @@ -3078,7 +3062,7 @@ ZipFSMkZipOrImg( const char *imgName; // TODO: normalize the origin file name - imgName = (originFile != NULL) ? Tcl_GetString(originFile) : + imgName = (originFile != NULL) ? TclGetString(originFile) : Tcl_GetNameOfExecutable(); if (pwlen) { i = 0; @@ -3262,7 +3246,7 @@ ZipFSMkZipOrImg( for (hPtr = Tcl_FirstHashEntry(&fileHash, &search); hPtr; hPtr = Tcl_NextHashEntry(&search)) { z = (ZipEntry *) Tcl_GetHashValue(hPtr); - ckfree(z); + Tcl_Free(z); Tcl_DeleteHashEntry(hPtr); } Tcl_DeleteHashTable(&fileHash); @@ -3310,7 +3294,7 @@ CopyImageFile( */ i = Tcl_Seek(in, 0, SEEK_END); - if (i == ERROR_LENGTH) { + if (i == TCL_INDEX_NONE) { errMsg = "seek error"; goto copyError; } @@ -3473,7 +3457,7 @@ SerializeCentralDirectorySuffix( static int ZipFSMkZipObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -3498,7 +3482,7 @@ ZipFSMkZipObjCmd( static int ZipFSLMkZipObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -3539,7 +3523,7 @@ ZipFSLMkZipObjCmd( static int ZipFSMkImgObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -3566,7 +3550,7 @@ ZipFSMkImgObjCmd( static int ZipFSLMkImgObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -3608,7 +3592,7 @@ ZipFSLMkImgObjCmd( static int ZipFSCanonicalObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -3624,11 +3608,11 @@ ZipFSCanonicalObjCmd( } Tcl_DStringInit(&dPath); if (objc == 2) { - filename = Tcl_GetString(objv[1]); + filename = TclGetString(objv[1]); result = CanonicalPath("", filename, &dPath, 1); } else if (objc == 3) { - mntpoint = Tcl_GetString(objv[1]); - filename = Tcl_GetString(objv[2]); + mntpoint = TclGetString(objv[1]); + filename = TclGetString(objv[2]); result = CanonicalPath(mntpoint, filename, &dPath, 1); } else { int zipfs = 0; @@ -3636,8 +3620,8 @@ ZipFSCanonicalObjCmd( if (Tcl_GetBooleanFromObj(interp, objv[3], &zipfs)) { return TCL_ERROR; } - mntpoint = Tcl_GetString(objv[1]); - filename = Tcl_GetString(objv[2]); + mntpoint = TclGetString(objv[1]); + filename = TclGetString(objv[2]); result = CanonicalPath(mntpoint, filename, &dPath, zipfs); } Tcl_SetObjResult(interp, Tcl_NewStringObj(result, -1)); @@ -3664,7 +3648,7 @@ ZipFSCanonicalObjCmd( static int ZipFSExistsObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -3682,7 +3666,7 @@ ZipFSExistsObjCmd( * Prepend ZIPFS_VOLUME to filename, eliding the final / */ - filename = Tcl_GetString(objv[1]); + filename = TclGetString(objv[1]); Tcl_DStringInit(&ds); Tcl_DStringAppend(&ds, ZIPFS_VOLUME, ZIPFS_VOLUME_LEN - 1); Tcl_DStringAppend(&ds, filename, -1); @@ -3717,7 +3701,7 @@ ZipFSExistsObjCmd( static int ZipFSInfoObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -3729,7 +3713,7 @@ ZipFSInfoObjCmd( Tcl_WrongNumArgs(interp, 1, objv, "filename"); return TCL_ERROR; } - filename = Tcl_GetString(objv[1]); + filename = TclGetString(objv[1]); ReadLock(); z = ZipFSLookup(filename); if (z) { @@ -3767,7 +3751,7 @@ ZipFSInfoObjCmd( static int ZipFSListObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -3797,17 +3781,17 @@ ZipFSListObjCmd( } switch (idx) { case OPT_GLOB: - pattern = Tcl_GetString(objv[2]); + pattern = TclGetString(objv[2]); break; case OPT_REGEXP: - regexp = Tcl_RegExpCompile(interp, Tcl_GetString(objv[2])); + regexp = Tcl_RegExpCompile(interp, TclGetString(objv[2])); if (!regexp) { return TCL_ERROR; } break; } } else if (objc == 2) { - pattern = Tcl_GetString(objv[1]); + pattern = TclGetString(objv[1]); } /* @@ -3966,7 +3950,7 @@ TclZipfs_TclLibrary(void) static int ZipFSTclLibraryObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ TCL_UNUSED(int) /*objc*/, TCL_UNUSED(Tcl_Obj *const *)) /*objv*/ @@ -4011,7 +3995,7 @@ ZipChannelClose( } if (info->iscompr && info->ubuf) { - ckfree(info->ubuf); + Tcl_Free(info->ubuf); info->ubuf = NULL; } if (info->isEncrypted) { @@ -4021,11 +4005,11 @@ ZipChannelClose( if (info->isWriting) { ZipEntry *z = info->zipEntryPtr; unsigned char *newdata = (unsigned char *) - attemptckrealloc(info->ubuf, info->numRead); + Tcl_AttemptRealloc(info->ubuf, info->numRead); if (newdata) { if (z->data) { - ckfree(z->data); + Tcl_Free(z->data); } z->data = newdata; z->numBytes = z->numCompressedBytes = info->numBytes; @@ -4036,13 +4020,13 @@ ZipChannelClose( z->offset = 0; z->crc32 = 0; } else { - ckfree(info->ubuf); + Tcl_Free(info->ubuf); } } WriteLock(); info->zipFilePtr->numOpen--; Unlock(); - ckfree(info); + Tcl_Free(info); return TCL_OK; } @@ -4236,18 +4220,6 @@ ZipChannelWideSeek( info->numRead = (size_t) offset; return info->numRead; } - -#if !defined(TCL_NO_DEPRECATED) && (TCL_MAJOR_VERSION < 9) -static int -ZipChannelSeek( - void *instanceData, - long offset, - int mode, - int *errloc) -{ - return ZipChannelWideSeek(instanceData, offset, mode, errloc); -} -#endif /* *------------------------------------------------------------------------- @@ -4268,7 +4240,7 @@ ZipChannelSeek( static void ZipChannelWatchChannel( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), TCL_UNUSED(int) /*mask*/) { return; @@ -4293,9 +4265,9 @@ ZipChannelWatchChannel( static int ZipChannelGetFile( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), TCL_UNUSED(int) /*direction*/, - TCL_UNUSED(ClientData *) /*handlePtr*/) + TCL_UNUSED(void **) /*handlePtr*/) { return TCL_ERROR; } @@ -4392,7 +4364,7 @@ ZipChannelOpen( flags |= TCL_WRITABLE; if (InitWritableChannel(interp, info, z, trunc) == TCL_ERROR) { - ckfree(info); + Tcl_Free(info); goto error; } } else if (z->data) { @@ -4410,7 +4382,7 @@ ZipChannelOpen( flags |= TCL_READABLE; if (InitReadableChannel(interp, info, z) == TCL_ERROR) { - ckfree(info); + Tcl_Free(info); goto error; } } @@ -4467,7 +4439,7 @@ InitWritableChannel( info->isWriting = 1; info->maxWrite = ZipFS.wrmax; - info->ubuf = (unsigned char *) attemptckalloc(info->maxWrite); + info->ubuf = (unsigned char *) Tcl_AttemptAlloc(info->maxWrite); if (!info->ubuf) { goto memoryError; } @@ -4529,7 +4501,7 @@ InitWritableChannel( unsigned int j; stream.avail_in -= 12; - cbuf = (unsigned char *) attemptckalloc(stream.avail_in); + cbuf = (unsigned char *) Tcl_AttemptAlloc(stream.avail_in); if (!cbuf) { goto memoryError; } @@ -4552,7 +4524,7 @@ InitWritableChannel( || ((err == Z_OK) && (stream.avail_in == 0))) { if (cbuf) { memset(info->keys, 0, sizeof(info->keys)); - ckfree(cbuf); + Tcl_Free(cbuf); } return TCL_OK; } @@ -4579,7 +4551,7 @@ InitWritableChannel( memoryError: if (info->ubuf) { - ckfree(info->ubuf); + Tcl_Free(info->ubuf); } ZIPFS_MEM_ERROR(interp); return TCL_ERROR; @@ -4587,10 +4559,10 @@ InitWritableChannel( corruptionError: if (cbuf) { memset(info->keys, 0, sizeof(info->keys)); - ckfree(cbuf); + Tcl_Free(cbuf); } if (info->ubuf) { - ckfree(info->ubuf); + Tcl_Free(info->ubuf); } ZIPFS_ERROR(interp, "decompression error"); ZIPFS_ERROR_CODE(interp, "CORRUPT"); @@ -4666,7 +4638,7 @@ InitReadableChannel( stream.avail_in = z->numCompressedBytes; if (info->isEncrypted) { stream.avail_in -= 12; - ubuf = (unsigned char *) attemptckalloc(stream.avail_in); + ubuf = (unsigned char *) Tcl_AttemptAlloc(stream.avail_in); if (!ubuf) { info->ubuf = NULL; goto memoryError; @@ -4681,7 +4653,7 @@ InitReadableChannel( stream.next_in = info->ubuf; } stream.next_out = info->ubuf = (unsigned char *) - attemptckalloc(info->numBytes); + Tcl_AttemptAlloc(info->numBytes); if (!info->ubuf) { goto memoryError; } @@ -4705,7 +4677,7 @@ InitReadableChannel( if (ubuf) { info->isEncrypted = 0; memset(info->keys, 0, sizeof(info->keys)); - ckfree(ubuf); + Tcl_Free(ubuf); } return TCL_OK; } else if (info->isEncrypted) { @@ -4717,7 +4689,7 @@ InitReadableChannel( */ len = z->numCompressedBytes - 12; - ubuf = (unsigned char *) attemptckalloc(len); + ubuf = (unsigned char *) Tcl_AttemptAlloc(len); if (ubuf == NULL) { goto memoryError; } @@ -4734,10 +4706,10 @@ InitReadableChannel( if (ubuf) { info->isEncrypted = 0; memset(info->keys, 0, sizeof(info->keys)); - ckfree(ubuf); + Tcl_Free(ubuf); } if (info->ubuf) { - ckfree(info->ubuf); + Tcl_Free(info->ubuf); } ZIPFS_ERROR(interp, "decompression error"); ZIPFS_ERROR_CODE(interp, "CORRUPT"); @@ -4747,7 +4719,7 @@ InitReadableChannel( if (ubuf) { info->isEncrypted = 0; memset(info->keys, 0, sizeof(info->keys)); - ckfree(ubuf); + Tcl_Free(ubuf); } ZIPFS_MEM_ERROR(interp); return TCL_ERROR; @@ -4876,7 +4848,7 @@ ZipFSOpenFileChannelProc( return NULL; } - return ZipChannelOpen(interp, Tcl_GetString(pathPtr), wr, trunc); + return ZipChannelOpen(interp, TclGetString(pathPtr), wr, trunc); } /* @@ -4905,7 +4877,7 @@ ZipFSStatProc( if (!pathPtr) { return -1; } - return ZipEntryStat(Tcl_GetString(pathPtr), buf); + return ZipEntryStat(TclGetString(pathPtr), buf); } /* @@ -4934,7 +4906,7 @@ ZipFSAccessProc( if (!pathPtr) { return -1; } - return ZipEntryAccess(Tcl_GetString(pathPtr), mode); + return ZipEntryAccess(TclGetString(pathPtr), mode); } /* @@ -5025,7 +4997,8 @@ ZipFSMatchInDirectoryProc( Tcl_HashEntry *hPtr; Tcl_HashSearch search; Tcl_Obj *normPathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr); - int scnt, l, dirOnly = -1, prefixLen, strip = 0, mounts = 0, len; + int scnt, l, dirOnly = -1, strip = 0, mounts = 0; + size_t prefixLen, len; char *pat, *prefix, *path; Tcl_DString dsPref, *prefixBuf = NULL; @@ -5098,7 +5071,7 @@ ZipFSMatchInDirectoryProc( */ l = strlen(pattern); - pat = (char *) ckalloc(len + l + 2); + pat = (char *) Tcl_Alloc(len + l + 2); memcpy(pat, path, len); while ((len > 1) && (pat[len - 1] == '/')) { --len; @@ -5122,7 +5095,7 @@ ZipFSMatchInDirectoryProc( AppendWithPrefix(result, prefixBuf, z->name + strip, -1); } } - ckfree(pat); + Tcl_Free(pat); end: Unlock(); @@ -5161,9 +5134,9 @@ ZipFSMatchMountPoints( { Tcl_HashEntry *hPtr; Tcl_HashSearch search; - int l, normLength; + size_t l, normLength; const char *path = Tcl_GetStringFromObj(normPathPtr, &normLength); - size_t len = (size_t) normLength; + size_t len = normLength; if (len < 1) { /* @@ -5238,11 +5211,12 @@ ZipFSMatchMountPoints( static int ZipFSPathInFilesystemProc( Tcl_Obj *pathPtr, - TCL_UNUSED(ClientData *)) + TCL_UNUSED(void **)) { Tcl_HashEntry *hPtr; Tcl_HashSearch search; - int ret = -1, len; + int ret = -1; + size_t len; char *path; pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr); @@ -5389,7 +5363,8 @@ ZipFSFileAttrsGetProc( Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef) { - int len, ret = TCL_OK; + size_t len; + int ret = TCL_OK; char *path; ZipEntry *z; @@ -5754,7 +5729,7 @@ ZipfsAppHookFindTclInit( static void ZipfsExitHandler( - TCL_UNUSED(ClientData) + TCL_UNUSED(void *) ) { Tcl_HashEntry *hPtr; @@ -5775,13 +5750,13 @@ static void ZipfsFinalize(void) { Tcl_FSUnregister(&zipfsFilesystem); Tcl_DeleteHashTable(&ZipFS.fileHash); - ckfree(ZipFS.fallbackEntryEncoding); + Tcl_Free(ZipFS.fallbackEntryEncoding); ZipFS.initialized = -1; } static void ZipfsMountExitHandler( - ClientData clientData) + void *clientData) { Tcl_HashEntry *hPtr; Tcl_HashSearch search; @@ -5823,12 +5798,12 @@ TclZipfs_AppHook( #endif /* _WIN32 */ { const char *archive; - const char *version = Tcl_InitSubsystems(); + const char *result; #ifdef _WIN32 - Tcl_FindExecutable(NULL); + result = Tcl_FindExecutable(NULL); #else - Tcl_FindExecutable((*argvPtr)[0]); + result = Tcl_FindExecutable((*argvPtr)[0]); #endif archive = Tcl_GetNameOfExecutable(); TclZipfs_Init(NULL); @@ -5866,7 +5841,7 @@ TclZipfs_AppHook( Tcl_DecrRefCount(vfsInitScript); if (found == TCL_OK) { zipfs_literal_tcl_library = ZIPFS_APP_MOUNT "/tcl_library"; - return version; + return result; } } #ifdef SUPPORT_BUILTIN_ZIP_INSTALL @@ -5899,7 +5874,7 @@ TclZipfs_AppHook( if (Tcl_FSAccess(vfsInitScript, F_OK) == 0) { Tcl_SetStartupScript(vfsInitScript, NULL); } - return version; + return result; } else if (!TclZipfs_Mount(NULL, ZIPFS_APP_MOUNT, archive, NULL)) { int found; Tcl_Obj *vfsInitScript; @@ -5923,7 +5898,7 @@ TclZipfs_AppHook( Tcl_DecrRefCount(vfsInitScript); if (found == TCL_OK) { zipfs_literal_tcl_library = ZIPFS_APP_MOUNT "/tcl_library"; - return version; + return result; } } #ifdef _WIN32 @@ -5931,7 +5906,7 @@ TclZipfs_AppHook( #endif /* _WIN32 */ #endif /* SUPPORT_BUILTIN_ZIP_INSTALL */ } - return version; + return result; } #else /* !HAVE_ZLIB */ diff --git a/generic/tclZlib.c b/generic/tclZlib.c index 61dc0ee..5a6dbc4 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. */ - int outPos; + size_t outPos; int mode; /* Either TCL_ZLIB_STREAM_DEFLATE or * TCL_ZLIB_STREAM_INFLATE. */ int format; /* Flags from the TCL_ZLIB_FORMAT_* */ @@ -181,7 +181,7 @@ static void ConvertError(Tcl_Interp *interp, int code, uLong adler); static Tcl_Obj * ConvertErrorToList(int code, uLong adler); static inline int Deflate(z_streamp strm, void *bufferPtr, - int bufferSize, int flush, int *writtenPtr); + size_t bufferSize, int flush, size_t *writtenPtr); static void ExtractHeader(gz_header *headerPtr, Tcl_Obj *dictObj); static int GenerateHeader(Tcl_Interp *interp, Tcl_Obj *dictObj, GzipHeader *headerPtr, int *extraSizePtr); @@ -206,7 +206,7 @@ static void ZlibTransformTimerRun(void *clientData); static const Tcl_ChannelType zlibChannelType = { "zlib", TCL_CHANNEL_VERSION_5, - TCL_CLOSE2PROC, + NULL, ZlibTransformInput, ZlibTransformOutput, NULL, /* seekProc */ @@ -423,6 +423,7 @@ GenerateHeader( { Tcl_Obj *value; int len, result = TCL_ERROR; + size_t length; Tcl_WideInt wideValue = 0; const char *valueStr; Tcl_Encoding latin1enc; @@ -442,8 +443,8 @@ GenerateHeader( if (GetValue(interp, dictObj, "comment", &value) != TCL_OK) { goto error; } else if (value != NULL) { - valueStr = TclGetStringFromObj(value, &len); - Tcl_UtfToExternal(NULL, latin1enc, valueStr, len, 0, NULL, + valueStr = Tcl_GetStringFromObj(value, &length); + Tcl_UtfToExternal(NULL, latin1enc, valueStr, length, 0, NULL, headerPtr->nativeCommentBuf, MAX_COMMENT_LEN-1, NULL, &len, NULL); headerPtr->nativeCommentBuf[len] = '\0'; @@ -463,8 +464,8 @@ GenerateHeader( if (GetValue(interp, dictObj, "filename", &value) != TCL_OK) { goto error; } else if (value != NULL) { - valueStr = TclGetStringFromObj(value, &len); - Tcl_UtfToExternal(NULL, latin1enc, valueStr, len, 0, NULL, + valueStr = Tcl_GetStringFromObj(value, &length); + Tcl_UtfToExternal(NULL, latin1enc, valueStr, length, 0, NULL, headerPtr->nativeFilenameBuf, MAXPATHLEN-1, NULL, &len, NULL); headerPtr->nativeFilenameBuf[len] = '\0'; headerPtr->header.name = (Bytef *) headerPtr->nativeFilenameBuf; @@ -546,8 +547,8 @@ ExtractHeader( } } - Tcl_ExternalToUtfDString(latin1enc, (char *) headerPtr->comment, -1, - &tmp); + Tcl_ExternalToUtfDStringEx(latin1enc, (char *) headerPtr->comment, -1, + TCL_ENCODING_NOCOMPLAIN, &tmp); SetValue(dictObj, "comment", Tcl_DStringToObj(&tmp)); } SetValue(dictObj, "crc", Tcl_NewBooleanObj(headerPtr->hcrc)); @@ -563,8 +564,8 @@ ExtractHeader( } } - Tcl_ExternalToUtfDString(latin1enc, (char *) headerPtr->name, -1, - &tmp); + Tcl_ExternalToUtfDStringEx(latin1enc, (char *) headerPtr->name, -1, + TCL_ENCODING_NOCOMPLAIN, &tmp); SetValue(dictObj, "filename", Tcl_DStringToObj(&tmp)); } if (headerPtr->os != 255) { @@ -593,9 +594,12 @@ SetInflateDictionary( Tcl_Obj *compDictObj) { if (compDictObj != NULL) { - int length; + size_t length = 0; unsigned char *bytes = Tcl_GetByteArrayFromObj(compDictObj, &length); + if (bytes == NULL) { + return Z_DATA_ERROR; + } return inflateSetDictionary(strm, bytes, length); } return Z_OK; @@ -607,9 +611,12 @@ SetDeflateDictionary( Tcl_Obj *compDictObj) { if (compDictObj != NULL) { - int length; + size_t length = 0; unsigned char *bytes = Tcl_GetByteArrayFromObj(compDictObj, &length); + if (bytes == NULL) { + return Z_DATA_ERROR; + } return deflateSetDictionary(strm, bytes, length); } return Z_OK; @@ -619,9 +626,9 @@ static inline int Deflate( z_streamp strm, void *bufferPtr, - int bufferSize, + size_t bufferSize, int flush, - int *writtenPtr) + size_t *writtenPtr) { int e; @@ -638,7 +645,7 @@ static inline void AppendByteArray( Tcl_Obj *listObj, void *buffer, - int size) + size_t size) { if (size > 0) { Tcl_Obj *baObj = Tcl_NewByteArrayObj((unsigned char *) buffer, size); @@ -700,11 +707,11 @@ Tcl_ZlibStreamInit( case TCL_ZLIB_FORMAT_GZIP: wbits = WBITS_GZIP; if (dictObj) { - gzHeaderPtr = (GzipHeader *)ckalloc(sizeof(GzipHeader)); + gzHeaderPtr = (GzipHeader *)Tcl_Alloc(sizeof(GzipHeader)); memset(gzHeaderPtr, 0, sizeof(GzipHeader)); if (GenerateHeader(interp, dictObj, gzHeaderPtr, NULL) != TCL_OK) { - ckfree(gzHeaderPtr); + Tcl_Free(gzHeaderPtr); return TCL_ERROR; } } @@ -734,7 +741,7 @@ Tcl_ZlibStreamInit( break; case TCL_ZLIB_FORMAT_GZIP: wbits = WBITS_GZIP; - gzHeaderPtr = (GzipHeader *)ckalloc(sizeof(GzipHeader)); + gzHeaderPtr = (GzipHeader *)Tcl_Alloc(sizeof(GzipHeader)); memset(gzHeaderPtr, 0, sizeof(GzipHeader)); gzHeaderPtr->header.name = (Bytef *) gzHeaderPtr->nativeFilenameBuf; @@ -760,7 +767,7 @@ Tcl_ZlibStreamInit( " TCL_ZLIB_STREAM_INFLATE"); } - zshPtr = (ZlibStreamHandle *)ckalloc(sizeof(ZlibStreamHandle)); + zshPtr = (ZlibStreamHandle *)Tcl_Alloc(sizeof(ZlibStreamHandle)); zshPtr->interp = interp; zshPtr->mode = mode; zshPtr->format = format; @@ -860,9 +867,9 @@ Tcl_ZlibStreamInit( Tcl_DecrRefCount(zshPtr->compDictObj); } if (zshPtr->gzHeaderPtr) { - ckfree(zshPtr->gzHeaderPtr); + Tcl_Free(zshPtr->gzHeaderPtr); } - ckfree(zshPtr); + Tcl_Free(zshPtr); return TCL_ERROR; } @@ -973,10 +980,10 @@ ZlibStreamCleanup( Tcl_DecrRefCount(zshPtr->compDictObj); } if (zshPtr->gzHeaderPtr) { - ckfree(zshPtr->gzHeaderPtr); + Tcl_Free(zshPtr->gzHeaderPtr); } - ckfree(zshPtr); + Tcl_Free(zshPtr); } /* @@ -1153,8 +1160,8 @@ Tcl_ZlibStreamSetCompressionDictionary( { ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle; - if (compressionDictionaryObj && (NULL == TclGetBytesFromObj(NULL, - compressionDictionaryObj, (int *)NULL))) { + if (compressionDictionaryObj && (NULL == Tcl_GetByteArrayFromObj( + compressionDictionaryObj, (size_t *)NULL))) { /* Missing or invalid compression dictionary */ compressionDictionaryObj = NULL; } @@ -1196,7 +1203,8 @@ Tcl_ZlibStreamPut( { ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle; char *dataTmp = NULL; - int e, size, outSize, toStore; + int e; + size_t size = 0, outSize, toStore; unsigned char *bytes; if (zshPtr->streamEnd) { @@ -1208,7 +1216,7 @@ Tcl_ZlibStreamPut( return TCL_ERROR; } - bytes = TclGetBytesFromObj(zshPtr->interp, data, &size); + bytes = Tcl_GetBytesFromObj(zshPtr->interp, data, &size); if (bytes == NULL) { return TCL_ERROR; } @@ -1245,7 +1253,7 @@ Tcl_ZlibStreamPut( if (outSize > BUFFER_SIZE_LIMIT) { outSize = BUFFER_SIZE_LIMIT; } - dataTmp = (char *)ckalloc(outSize); + dataTmp = (char *)Tcl_Alloc(outSize); while (1) { e = Deflate(&zshPtr->stream, dataTmp, outSize, flush, &toStore); @@ -1279,7 +1287,7 @@ Tcl_ZlibStreamPut( if (outSize < BUFFER_SIZE_LIMIT) { outSize = BUFFER_SIZE_LIMIT; /* There may be *lots* of data left to output... */ - dataTmp = (char *)ckrealloc(dataTmp, outSize); + dataTmp = (char *)Tcl_Realloc(dataTmp, outSize); } } @@ -1288,7 +1296,7 @@ Tcl_ZlibStreamPut( */ AppendByteArray(zshPtr->outData, dataTmp, toStore); - ckfree(dataTmp); + Tcl_Free(dataTmp); } else { /* * This is easy. Just append to the inData list. @@ -1321,14 +1329,15 @@ int Tcl_ZlibStreamGet( Tcl_ZlibStream zshandle, /* As obtained from Tcl_ZlibStreamInit */ Tcl_Obj *data, /* A place to append the data. */ - int count) /* Number of bytes to grab as a maximum, you + size_t count) /* Number of bytes to grab as a maximum, you * may get less! */ { ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle; - int e, i, listLen, itemLen, dataPos = 0; + int e; + size_t listLen, i, itemLen = 0, dataPos = 0; Tcl_Obj *itemObj; unsigned char *dataPtr, *itemPtr; - int existing; + size_t existing = 0; /* * Getting beyond the of stream, just return empty string. @@ -1338,12 +1347,12 @@ Tcl_ZlibStreamGet( return TCL_OK; } - if (NULL == TclGetBytesFromObj(zshPtr->interp, data, &existing)) { + if (NULL == Tcl_GetBytesFromObj(zshPtr->interp, data, &existing)) { return TCL_ERROR; } if (zshPtr->mode == TCL_ZLIB_STREAM_INFLATE) { - if (count == -1) { + if (count == TCL_INDEX_NONE) { /* * 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. @@ -1500,7 +1509,7 @@ Tcl_ZlibStreamGet( } } else { TclListObjLengthM(NULL, zshPtr->outData, &listLen); - if (count == -1) { + if (count == TCL_INDEX_NONE) { count = 0; for (i=0; i<listLen; i++) { Tcl_ListObjIndex(NULL, zshPtr->outData, i, &itemObj); @@ -1530,7 +1539,7 @@ Tcl_ZlibStreamGet( Tcl_ListObjIndex(NULL, zshPtr->outData, 0, &itemObj); itemPtr = Tcl_GetByteArrayFromObj(itemObj, &itemLen); - if (itemLen-zshPtr->outPos >= count-dataPos) { + if (itemLen-zshPtr->outPos + dataPos >= count) { size_t len = count - dataPos; memcpy(dataPtr + dataPos, itemPtr + zshPtr->outPos, len); @@ -1576,7 +1585,8 @@ Tcl_ZlibDeflate( int level, Tcl_Obj *gzipHeaderDictObj) { - int wbits = 0, inLen = 0, e = 0, extraSize = 0; + int wbits = 0, e = 0, extraSize = 0; + size_t inLen = 0; Byte *inData = NULL; z_stream stream; GzipHeader header; @@ -1592,7 +1602,7 @@ Tcl_ZlibDeflate( * to the deflate command. */ - inData = TclGetBytesFromObj(interp, data, &inLen); + inData = Tcl_GetBytesFromObj(interp, data, &inLen); if (inData == NULL) { return TCL_ERROR; } @@ -1642,7 +1652,7 @@ Tcl_ZlibDeflate( TclNewObj(obj); memset(&stream, 0, sizeof(z_stream)); - stream.avail_in = (uInt) inLen; + stream.avail_in = inLen; stream.next_in = inData; /* @@ -1727,10 +1737,11 @@ Tcl_ZlibInflate( Tcl_Interp *interp, int format, Tcl_Obj *data, - int bufferSize, + size_t bufferSize, Tcl_Obj *gzipHeaderDictObj) { - int wbits = 0, inLen = 0, e = 0, newBufferSize; + int wbits = 0, e = 0; + size_t inLen = 0, newBufferSize; Byte *inData = NULL, *outData = NULL, *newOutData = NULL; z_stream stream; gz_header header, *headerPtr = NULL; @@ -1741,7 +1752,7 @@ Tcl_ZlibInflate( return TCL_ERROR; } - inData = TclGetBytesFromObj(interp, data, &inLen); + inData = Tcl_GetBytesFromObj(interp, data, &inLen); if (inData == NULL) { return TCL_ERROR; } @@ -1775,10 +1786,10 @@ Tcl_ZlibInflate( if (gzipHeaderDictObj) { headerPtr = &header; memset(headerPtr, 0, sizeof(gz_header)); - nameBuf = (char *)ckalloc(MAXPATHLEN); + nameBuf = (char *)Tcl_Alloc(MAXPATHLEN); header.name = (Bytef *) nameBuf; header.name_max = MAXPATHLEN - 1; - commentBuf = (char *)ckalloc(MAX_COMMENT_LEN); + commentBuf = (char *)Tcl_Alloc(MAX_COMMENT_LEN); header.comment = (Bytef *) commentBuf; header.comm_max = MAX_COMMENT_LEN - 1; } @@ -1800,7 +1811,7 @@ Tcl_ZlibInflate( TclNewObj(obj); outData = Tcl_SetByteArrayLength(obj, bufferSize); memset(&stream, 0, sizeof(z_stream)); - stream.avail_in = (uInt) inLen+1; /* +1 because zlib can "over-request" + stream.avail_in = inLen+1; /* +1 because zlib can "over-request" * input (but ignore it!) */ stream.next_in = inData; stream.avail_out = bufferSize; @@ -1883,8 +1894,8 @@ Tcl_ZlibInflate( ExtractHeader(&header, gzipHeaderDictObj); SetValue(gzipHeaderDictObj, "size", Tcl_NewWideIntObj(stream.total_out)); - ckfree(nameBuf); - ckfree(commentBuf); + Tcl_Free(nameBuf); + Tcl_Free(commentBuf); } Tcl_SetObjResult(interp, obj); return TCL_OK; @@ -1893,10 +1904,10 @@ Tcl_ZlibInflate( TclDecrRefCount(obj); ConvertError(interp, e, stream.adler); if (nameBuf) { - ckfree(nameBuf); + Tcl_Free(nameBuf); } if (commentBuf) { - ckfree(commentBuf); + Tcl_Free(commentBuf); } return TCL_ERROR; } @@ -1915,7 +1926,7 @@ unsigned int Tcl_ZlibCRC32( unsigned int crc, const unsigned char *buf, - int len) + size_t len) { /* Nothing much to do, just wrap the crc32(). */ return crc32(crc, (Bytef *) buf, len); @@ -1925,7 +1936,7 @@ unsigned int Tcl_ZlibAdler32( unsigned int adler, const unsigned char *buf, - int len) + size_t len) { return adler32(adler, (Bytef *) buf, len); } @@ -1947,8 +1958,9 @@ ZlibCmd( int objc, Tcl_Obj *const objv[]) { - int command, dlen, i, option, level = -1; - unsigned start, buffersize = 0; + int i, option, level = -1; + size_t dlen = 0, start, buffersize = 0; + Tcl_WideInt wideLen; Byte *data; Tcl_Obj *headerDictObj; const char *extraInfoStr = NULL; @@ -1960,7 +1972,7 @@ ZlibCmd( enum zlibCommands { CMD_ADLER, CMD_COMPRESS, CMD_CRC, CMD_DECOMPRESS, CMD_DEFLATE, CMD_GUNZIP, CMD_GZIP, CMD_INFLATE, CMD_PUSH, CMD_STREAM - }; + } command; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "command arg ?...?"); @@ -1971,14 +1983,14 @@ ZlibCmd( return TCL_ERROR; } - switch ((enum zlibCommands) command) { + switch (command) { case CMD_ADLER: /* adler32 str ?startvalue? * -> checksum */ if (objc < 3 || objc > 4) { Tcl_WrongNumArgs(interp, 2, objv, "data ?startValue?"); return TCL_ERROR; } - data = TclGetBytesFromObj(interp, objv[2], &dlen); + data = Tcl_GetBytesFromObj(interp, objv[2], &dlen); if (data == NULL) { return TCL_ERROR; } @@ -1998,7 +2010,7 @@ ZlibCmd( Tcl_WrongNumArgs(interp, 2, objv, "data ?startValue?"); return TCL_ERROR; } - data = TclGetBytesFromObj(interp, objv[2], &dlen); + data = Tcl_GetBytesFromObj(interp, objv[2], &dlen); if (data == NULL) { return TCL_ERROR; } @@ -2101,14 +2113,15 @@ ZlibCmd( return TCL_ERROR; } if (objc > 3) { - if (Tcl_GetIntFromObj(interp, objv[3], - (int *) &buffersize) != TCL_OK) { + if (Tcl_GetWideIntFromObj(interp, objv[3], + &wideLen) != TCL_OK) { return TCL_ERROR; } - if (buffersize < MIN_NONSTREAM_BUFFER_SIZE - || buffersize > MAX_BUFFER_SIZE) { + if (wideLen < MIN_NONSTREAM_BUFFER_SIZE + || wideLen > MAX_BUFFER_SIZE) { goto badBuffer; } + buffersize = wideLen; } return Tcl_ZlibInflate(interp, TCL_ZLIB_FORMAT_RAW, objv[2], buffersize, NULL); @@ -2120,14 +2133,15 @@ ZlibCmd( return TCL_ERROR; } if (objc > 3) { - if (Tcl_GetIntFromObj(interp, objv[3], - (int *) &buffersize) != TCL_OK) { + if (Tcl_GetWideIntFromObj(interp, objv[3], + &wideLen) != TCL_OK) { return TCL_ERROR; } - if (buffersize < MIN_NONSTREAM_BUFFER_SIZE - || buffersize > MAX_BUFFER_SIZE) { + if (wideLen < MIN_NONSTREAM_BUFFER_SIZE + || wideLen > MAX_BUFFER_SIZE) { goto badBuffer; } + buffersize = wideLen; } return Tcl_ZlibInflate(interp, TCL_ZLIB_FORMAT_ZLIB, objv[2], buffersize, NULL); @@ -2151,14 +2165,15 @@ ZlibCmd( } switch (option) { case 0: - if (Tcl_GetIntFromObj(interp, objv[i+1], - (int *) &buffersize) != TCL_OK) { + if (Tcl_GetWideIntFromObj(interp, objv[i+1], + &wideLen) != TCL_OK) { return TCL_ERROR; } - if (buffersize < MIN_NONSTREAM_BUFFER_SIZE - || buffersize > MAX_BUFFER_SIZE) { + if (wideLen < MIN_NONSTREAM_BUFFER_SIZE + || wideLen > MAX_BUFFER_SIZE) { goto badBuffer; } + buffersize = wideLen; break; case 1: headerVarObj = objv[i+1]; @@ -2228,7 +2243,7 @@ ZlibStreamSubcmd( enum zlibFormats { FMT_COMPRESS, FMT_DECOMPRESS, FMT_DEFLATE, FMT_GUNZIP, FMT_GZIP, FMT_INFLATE - }; + } fmt; int i, format, mode = 0, option, level; enum objIndices { OPT_COMPRESSION_DICTIONARY = 0, @@ -2269,7 +2284,7 @@ ZlibStreamSubcmd( return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[2], stream_formats, "mode", 0, - &format) != TCL_OK) { + &fmt) != TCL_OK) { return TCL_ERROR; } @@ -2278,7 +2293,7 @@ ZlibStreamSubcmd( * specified. */ - switch ((enum zlibFormats) format) { + switch (fmt) { case FMT_DEFLATE: desc = compressionOpts; mode = TCL_ZLIB_STREAM_DEFLATE; @@ -2342,7 +2357,7 @@ ZlibStreamSubcmd( } if (compDictObj) { - if (NULL == TclGetBytesFromObj(interp, compDictObj, NULL)) { + if (NULL == Tcl_GetBytesFromObj(interp, compDictObj, (size_t *)NULL)) { return TCL_ERROR; } } @@ -2388,9 +2403,9 @@ ZlibPushSubcmd( enum zlibFormats { FMT_COMPRESS, FMT_DECOMPRESS, FMT_DEFLATE, FMT_GUNZIP, FMT_GZIP, FMT_INFLATE - }; + } fmt; Tcl_Channel chan; - int chanMode, format, mode = 0, level, i, option; + int chanMode, format, mode = 0, level, i; static const char *const pushCompressOptions[] = { "-dictionary", "-header", "-level", NULL }; @@ -2398,9 +2413,10 @@ ZlibPushSubcmd( "-dictionary", "-header", "-level", "-limit", NULL }; const char *const *pushOptions = pushDecompressOptions; - enum pushOptionsEnum {poDictionary, poHeader, poLevel, poLimit}; + enum pushOptionsEnum {poDictionary, poHeader, poLevel, poLimit} option; Tcl_Obj *headerObj = NULL, *compDictObj = NULL; - int limit = DEFAULT_BUFFER_SIZE, dummy; + int limit = DEFAULT_BUFFER_SIZE; + size_t dummy; if (objc < 4) { Tcl_WrongNumArgs(interp, 2, objv, "mode channel ?options...?"); @@ -2408,10 +2424,10 @@ ZlibPushSubcmd( } if (Tcl_GetIndexFromObj(interp, objv[2], stream_formats, "mode", 0, - &format) != TCL_OK) { + &fmt) != TCL_OK) { return TCL_ERROR; } - switch ((enum zlibFormats) format) { + switch (fmt) { case FMT_DEFLATE: mode = TCL_ZLIB_STREAM_DEFLATE; format = TCL_ZLIB_FORMAT_RAW; @@ -2480,7 +2496,7 @@ ZlibPushSubcmd( Tcl_SetErrorCode(interp, "TCL", "ZIP", "NOVAL", NULL); return TCL_ERROR; } - switch ((enum pushOptionsEnum) option) { + switch (option) { case poHeader: headerObj = objv[i]; if (Tcl_DictObjSize(interp, headerObj, &dummy) != TCL_OK) { @@ -2524,7 +2540,7 @@ ZlibPushSubcmd( } } - if (compDictObj && (NULL == TclGetBytesFromObj(interp, compDictObj, NULL))) { + if (compDictObj && (NULL == Tcl_GetBytesFromObj(interp, compDictObj, (size_t *)NULL))) { return TCL_ERROR; } @@ -2560,7 +2576,7 @@ ZlibStreamCmd( Tcl_Obj *const objv[]) { Tcl_ZlibStream zstream = (Tcl_ZlibStream)cd; - int command, count, code; + int count, code; Tcl_Obj *obj; static const char *const cmds[] = { "add", "checksum", "close", "eof", "finalize", "flush", @@ -2570,7 +2586,7 @@ ZlibStreamCmd( enum zlibStreamCommands { zs_add, zs_checksum, zs_close, zs_eof, zs_finalize, zs_flush, zs_fullflush, zs_get, zs_header, zs_put, zs_reset - }; + } command; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "option data ?...?"); @@ -2582,7 +2598,7 @@ ZlibStreamCmd( return TCL_ERROR; } - switch ((enum zlibStreamCommands) command) { + switch (command) { case zs_add: /* $strm add ?$flushopt? $data */ return ZlibStreamAddCmd(zstream, interp, objc, objv); case zs_header: /* $strm header */ @@ -2686,14 +2702,14 @@ ZlibStreamAddCmd( Tcl_Obj *const objv[]) { Tcl_ZlibStream zstream = (Tcl_ZlibStream)cd; - int index, code, buffersize = -1, flush = -1, i; + int code, buffersize = -1, flush = -1, i; Tcl_Obj *obj, *compDictObj = NULL; static const char *const add_options[] = { "-buffer", "-dictionary", "-finalize", "-flush", "-fullflush", NULL }; enum addOptions { ao_buffer, ao_dictionary, ao_finalize, ao_flush, ao_fullflush - }; + } index; for (i=2; i<objc-1; i++) { if (Tcl_GetIndexFromObj(interp, objv[i], add_options, "option", 0, @@ -2701,7 +2717,7 @@ ZlibStreamAddCmd( return TCL_ERROR; } - switch ((enum addOptions) index) { + switch (index) { case ao_flush: /* -flush */ if (flush >= 0) { flush = -2; @@ -2771,9 +2787,9 @@ ZlibStreamAddCmd( */ if (compDictObj != NULL) { - int len; + size_t len = 0; - if (NULL == TclGetBytesFromObj(interp, compDictObj, &len)) { + if (NULL == Tcl_GetBytesFromObj(interp, compDictObj, &len)) { return TCL_ERROR; } @@ -2813,14 +2829,14 @@ ZlibStreamPutCmd( Tcl_Obj *const objv[]) { Tcl_ZlibStream zstream = (Tcl_ZlibStream)cd; - int index, flush = -1, i; + int flush = -1, i; Tcl_Obj *compDictObj = NULL; static const char *const put_options[] = { "-dictionary", "-finalize", "-flush", "-fullflush", NULL }; enum putOptions { po_dictionary, po_finalize, po_flush, po_fullflush - }; + } index; for (i=2; i<objc-1; i++) { if (Tcl_GetIndexFromObj(interp, objv[i], put_options, "option", 0, @@ -2828,7 +2844,7 @@ ZlibStreamPutCmd( return TCL_ERROR; } - switch ((enum putOptions) index) { + switch (index) { case po_flush: /* -flush */ if (flush >= 0) { flush = -2; @@ -2878,9 +2894,9 @@ ZlibStreamPutCmd( */ if (compDictObj != NULL) { - int len; + size_t len = 0; - if (NULL == TclGetBytesFromObj(interp, compDictObj, &len)) { + if (NULL == Tcl_GetBytesFromObj(interp, compDictObj, &len)) { return TCL_ERROR; } if (len == 0) { @@ -2942,7 +2958,8 @@ ZlibTransformClose( int flags) { ZlibChannelData *cd = (ZlibChannelData *)instanceData; - int e, written, result = TCL_OK; + int e, result = TCL_OK; + size_t written; if ((flags & (TCL_CLOSE_READ | TCL_CLOSE_WRITE)) != 0) { return EINVAL; @@ -3018,14 +3035,14 @@ ZlibTransformClose( } if (cd->inBuffer) { - ckfree(cd->inBuffer); + Tcl_Free(cd->inBuffer); cd->inBuffer = NULL; } if (cd->outBuffer) { - ckfree(cd->outBuffer); + Tcl_Free(cd->outBuffer); cd->outBuffer = NULL; } - ckfree(cd); + Tcl_Free(cd); return result; } @@ -3098,13 +3115,13 @@ ZlibTransformInput( * Three cases here: * 1. Got some data from the underlying channel (readBytes > 0) so * it should be fed through the decompression engine. - * 2. Got an error (readBytes < 0) which we should report up except + * 2. Got an error (readBytes == -1) which we should report up except * for the case where we can convert it to a short read. * 3. Got an end-of-data from EOF or blocking (readBytes == 0). If * it is EOF, try flushing the data out of the decompressor. */ - if (readBytes < 0) { + if (readBytes == -1) { /* See ReflectInput() in tclIORTrans.c */ if (Tcl_InputBlocked(cd->parent) && (gotBytes > 0)) { @@ -3184,7 +3201,8 @@ ZlibTransformOutput( ZlibChannelData *cd = (ZlibChannelData *)instanceData; Tcl_DriverOutputProc *outProc = Tcl_ChannelOutputProc(Tcl_GetChannelType(cd->parent)); - int e, produced; + int e; + size_t produced; Tcl_Obj *errObj; if (cd->mode == TCL_ZLIB_STREAM_INFLATE) { @@ -3246,7 +3264,8 @@ ZlibTransformFlush( ZlibChannelData *cd, int flushType) { - int e, len; + int e; + size_t len; cd->outStream.avail_in = 0; do { @@ -3318,7 +3337,7 @@ ZlibTransformSetOption( /* not used */ TclNewStringObj(compDictObj, value, strlen(value)); Tcl_IncrRefCount(compDictObj); - if (NULL == TclGetBytesFromObj(interp, compDictObj, NULL)) { + if (NULL == Tcl_GetBytesFromObj(interp, compDictObj, (size_t *)NULL)) { Tcl_DecrRefCount(compDictObj); return TCL_ERROR; } @@ -3462,16 +3481,16 @@ ZlibTransformGetOption( Tcl_DStringAppendElement(dsPtr, "-dictionary"); if (cd->compDictObj) { Tcl_DStringAppendElement(dsPtr, - Tcl_GetString(cd->compDictObj)); + TclGetString(cd->compDictObj)); } else { Tcl_DStringAppendElement(dsPtr, ""); } } else { if (cd->compDictObj) { - int len; - const char *str = TclGetStringFromObj(cd->compDictObj, &len); + size_t length; + const char *str = Tcl_GetStringFromObj(cd->compDictObj, &length); - Tcl_DStringAppend(dsPtr, str, len); + Tcl_DStringAppend(dsPtr, str, length); } return TCL_OK; } @@ -3490,7 +3509,7 @@ ZlibTransformGetOption( ExtractHeader(&cd->inHeader.header, tmpObj); if (optionName == NULL) { Tcl_DStringAppendElement(dsPtr, "-header"); - Tcl_DStringAppendElement(dsPtr, Tcl_GetString(tmpObj)); + Tcl_DStringAppendElement(dsPtr, TclGetString(tmpObj)); Tcl_DecrRefCount(tmpObj); } else { TclDStringAppendObj(dsPtr, tmpObj); @@ -3673,7 +3692,7 @@ ZlibStackChannelTransform( * dictionary (not dictObj!) to use if * necessary. */ { - ZlibChannelData *cd = (ZlibChannelData *)ckalloc(sizeof(ZlibChannelData)); + ZlibChannelData *cd = (ZlibChannelData *)Tcl_Alloc(sizeof(ZlibChannelData)); Tcl_Channel chan; int wbits = 0; @@ -3709,7 +3728,7 @@ ZlibStackChannelTransform( if (compDictObj != NULL) { cd->compDictObj = Tcl_DuplicateObj(compDictObj); Tcl_IncrRefCount(cd->compDictObj); - TclGetByteArrayFromObj(cd->compDictObj, NULL); + Tcl_GetByteArrayFromObj(cd->compDictObj, (size_t *)NULL); } if (format == TCL_ZLIB_FORMAT_RAW) { @@ -3736,7 +3755,7 @@ ZlibStackChannelTransform( if (cd->inAllocated < cd->readAheadLimit) { cd->inAllocated = cd->readAheadLimit; } - cd->inBuffer = (char *)ckalloc(cd->inAllocated); + cd->inBuffer = (char *)Tcl_Alloc(cd->inAllocated); if (cd->flags & IN_HEADER) { if (inflateGetHeader(&cd->inStream, &cd->inHeader.header) != Z_OK) { goto error; @@ -3753,7 +3772,7 @@ ZlibStackChannelTransform( goto error; } cd->outAllocated = DEFAULT_BUFFER_SIZE; - cd->outBuffer = (char *)ckalloc(cd->outAllocated); + cd->outBuffer = (char *)Tcl_Alloc(cd->outAllocated); if (cd->flags & OUT_HEADER) { if (deflateSetHeader(&cd->outStream, &cd->outHeader.header) != Z_OK) { goto error; @@ -3778,17 +3797,17 @@ ZlibStackChannelTransform( error: if (cd->inBuffer) { - ckfree(cd->inBuffer); + Tcl_Free(cd->inBuffer); inflateEnd(&cd->inStream); } if (cd->outBuffer) { - ckfree(cd->outBuffer); + Tcl_Free(cd->outBuffer); deflateEnd(&cd->outStream); } if (cd->compDictObj) { Tcl_DecrRefCount(cd->compDictObj); } - ckfree(cd); + Tcl_Free(cd); return NULL; } @@ -3957,10 +3976,7 @@ TclZlibInit( * Formally provide the package as a Tcl built-in. */ -#if !defined(TCL_NO_DEPRECATED) && (TCL_MAJOR_VERSION < 9) - Tcl_PkgProvide(interp, "zlib", TCL_ZLIB_VERSION); -#endif - return Tcl_PkgProvide(interp, "tcl::zlib", TCL_ZLIB_VERSION); + return Tcl_PkgProvideEx(interp, "tcl::zlib", TCL_ZLIB_VERSION, NULL); } /* @@ -4035,7 +4051,7 @@ int Tcl_ZlibStreamGet( Tcl_ZlibStream zshandle, Tcl_Obj *data, - int count) + size_t count) { return TCL_OK; } @@ -4060,7 +4076,7 @@ Tcl_ZlibInflate( Tcl_Interp *interp, int format, Tcl_Obj *data, - int bufferSize, + size_t bufferSize, Tcl_Obj *gzipHeaderDictObj) { if (interp) { @@ -4074,7 +4090,7 @@ unsigned int Tcl_ZlibCRC32( TCL_UNUSED(unsigned int), TCL_UNUSED(const unsigned char *), - TCL_UNUSED(int)) + TCL_UNUSED(size_t)) { return 0; } @@ -4083,7 +4099,7 @@ unsigned int Tcl_ZlibAdler32( TCL_UNUSED(unsigned int), TCL_UNUSED(const unsigned char *), - TCL_UNUSED(int)) + TCL_UNUSED(size_t)) { return 0; } diff --git a/library/auto.tcl b/library/auto.tcl index 3b1bb05..1b1c7fe 100644 --- a/library/auto.tcl +++ b/library/auto.tcl @@ -108,7 +108,7 @@ proc tcl_findLibrary {basename version patch initScript enVarName varName} { catch {lappend paths [::tcl::pkgconfig get bindir,runtime]} } if {[catch {::${basename}::pkgconfig get dllfile,runtime} dllfile]} { - set dllfile "lib${basename}${version}[info sharedlibextension]" + set dllfile "libtcl9${basename}${version}[info sharedlibextension]" } set dir [file dirname [file join [pwd] [info nameofexecutable]]] lappend paths $dir @@ -302,7 +302,7 @@ proc auto_mkindex_old {dir args} { set f "" set error [catch { set f [open $file] - fconfigure $f -encoding utf-8 -eofchar "\x1A {}" + fconfigure $f -encoding utf-8 -eofchar \x1A while {[gets $f line] >= 0} { if {[regexp {^proc[ ]+([^ ]*)} $line match procName]} { set procName [lindex [auto_qualify $procName "::"] 0] @@ -414,7 +414,7 @@ proc auto_mkindex_parser::mkindex {file} { set scriptFile $file set fid [open $file] - fconfigure $fid -encoding utf-8 -eofchar "\x1A {}" + fconfigure $fid -encoding utf-8 -eofchar \x1A set contents [read $fid] close $fid diff --git a/library/cookiejar/cookiejar.tcl b/library/cookiejar/cookiejar.tcl index 85f73b4..c9c0b1c 100644 --- a/library/cookiejar/cookiejar.tcl +++ b/library/cookiejar/cookiejar.tcl @@ -8,7 +8,7 @@ # this file, and for a DISCLAIMER OF ALL WARRANTIES. # Dependencies -package require Tcl 8.6 +package require Tcl 8.6- package require http 2.8.4 package require sqlite3 package require tcl::idna 1.0 diff --git a/library/init.tcl b/library/init.tcl index bbff158..2646aa7 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -19,7 +19,7 @@ if {[info commands package] == ""} { error "version mismatch: library\nscripts expect Tcl version 7.5b1 or later but the loaded version is\nonly [info patchlevel]" } -package require -exact tcl 8.7a6 +package require -exact tcl 9.0a4 # Compute the auto path to use in this interpreter. # The values on the path come from several locations: @@ -47,7 +47,15 @@ package require -exact tcl 8.7a6 if {![info exists auto_path]} { if {[info exists env(TCLLIBPATH)] && (![interp issafe])} { - set auto_path $env(TCLLIBPATH) + set auto_path [apply {{} { + lmap path $::env(TCLLIBPATH) { + # Paths relative to unresolvable home dirs are ignored + if {[catch {file tildeexpand $path} expanded_path]} { + continue + } + set expanded_path + } + }}] } else { set auto_path "" } @@ -442,7 +450,7 @@ proc auto_load_index {} { continue } else { set error [catch { - fconfigure $f -encoding utf-8 -eofchar "\x1A {}" + fconfigure $f -encoding utf-8 -eofchar \x1A set id [gets $f] if {$id eq "# Tcl autoload index file, version 2.0"} { eval [read $f] diff --git a/library/install.tcl b/library/install.tcl index 50e40df..4abdead 100644 --- a/library/install.tcl +++ b/library/install.tcl @@ -35,7 +35,7 @@ proc ::practcl::_pkgindex_directory {path} { # Read the file, and override assumptions as needed ### set fin [open $file r] - fconfigure $fin -encoding utf-8 -eofchar "\x1A {}" + fconfigure $fin -encoding utf-8 -eofchar \x1A set dat [read $fin] close $fin # Look for a teapot style Package statement @@ -59,7 +59,7 @@ proc ::practcl::_pkgindex_directory {path} { foreach file [glob -nocomplain $path/*.tcl] { if { [file tail $file] == "version_info.tcl" } continue set fin [open $file r] - fconfigure $fin -encoding utf-8 -eofchar "\x1A {}" + fconfigure $fin -encoding utf-8 -eofchar \x1A set dat [read $fin] close $fin if {![regexp "package provide" $dat]} continue @@ -79,7 +79,7 @@ proc ::practcl::_pkgindex_directory {path} { return $buffer } set fin [open $pkgidxfile r] - fconfigure $fin -encoding utf-8 -eofchar "\x1A {}" + fconfigure $fin -encoding utf-8 -eofchar \x1A set dat [read $fin] close $fin set trace 0 diff --git a/library/package.tcl b/library/package.tcl index 5f0795f..0c4aa29 100644 --- a/library/package.tcl +++ b/library/package.tcl @@ -137,6 +137,9 @@ proc pkg_mkIndex {args} { } on error {msg opt} { return -options $opt $msg } + if {[llength $fileList] == 0} { + return -code error "no files matched glob pattern \"$patternList\"" + } foreach file $fileList { # For each file, figure out what commands and packages it provides. # To do this, create a child interpreter, load the file into the diff --git a/library/safe.tcl b/library/safe.tcl index 7fc2b5c..fd7bd73 100644 --- a/library/safe.tcl +++ b/library/safe.tcl @@ -127,7 +127,7 @@ proc ::safe::CheckInterp {child} { # we had the bad idea to support for the sake of user simplicity in # create/init but which makes life hard in configure... # So this will be hopefully written and some integrated with opt1.0 -# (hopefully for tcl8.1 ?) +# (hopefully for tcl9.0 ?) proc ::safe::interpConfigure {args} { variable AutoPathSync switch [llength $args] { @@ -619,8 +619,6 @@ proc ::safe::InterpInit { ::interp alias $child ::tcl::info::nameofexecutable {} \ ::safe::AliasExeName $child - # The allowed child variables already have been set by Tcl_MakeSafe(3) - # Source init.tcl and tm.tcl into the child, to get auto_load and # other procedures defined: @@ -832,9 +830,6 @@ proc ::safe::CheckFileName {child file} { # prevent discovery of what home directories exist. proc ::safe::AliasFileSubcommand {child subcommand name} { - if {[string match ~* $name]} { - set name ./$name - } tailcall ::interp invokehidden $child tcl:file:$subcommand $name } @@ -1081,7 +1076,7 @@ proc ::safe::AliasSource {child args} { set replacementMsg "script error" set code [catch { set f [open $realfile] - fconfigure $f -encoding $encoding -eofchar "\x1A {}" + fconfigure $f -encoding $encoding -eofchar \x1A set contents [read $f] close $f ::interp eval $child [list info script $file] @@ -1424,7 +1419,7 @@ namespace eval ::safe { # Set to 1 for "traditional" behavior: a child's entire access path and # module path are copied to its ::auto_path, which is updated whenever # the user calls ::safe::interpAddToAccessPath to add to the access path. - variable AutoPathSync 1 + variable AutoPathSync 0 # Log command, set via 'setLogCmd'. Logging is disabled when empty. variable Log {} diff --git a/library/tm.tcl b/library/tm.tcl index c1a8f8a..88ce4af 100644 --- a/library/tm.tcl +++ b/library/tm.tcl @@ -338,7 +338,10 @@ proc ::tcl::tm::Defaults {} { ] { if {![info exists env($ev)]} continue foreach p [split $env($ev) $sep] { - path add $p + # Paths relative to unresolvable home dirs are ignored + if {![catch {file tildeexpand $p} expanded_path]} { + path add $expanded_path + } } } } diff --git a/library/tzdata/SystemV/AST4 b/library/tzdata/SystemV/AST4 deleted file mode 100644 index eced0d2..0000000 --- a/library/tzdata/SystemV/AST4 +++ /dev/null @@ -1,5 +0,0 @@ -# created by ../tools/tclZIC.tcl - do not edit -if {![info exists TZData(America/Puerto_Rico)]} { - LoadTimeZoneFile America/Puerto_Rico -} -set TZData(:SystemV/AST4) $TZData(:America/Puerto_Rico) diff --git a/library/tzdata/SystemV/AST4ADT b/library/tzdata/SystemV/AST4ADT deleted file mode 100644 index c24308f..0000000 --- a/library/tzdata/SystemV/AST4ADT +++ /dev/null @@ -1,5 +0,0 @@ -# created by ../tools/tclZIC.tcl - do not edit -if {![info exists TZData(America/Halifax)]} { - LoadTimeZoneFile America/Halifax -} -set TZData(:SystemV/AST4ADT) $TZData(:America/Halifax) diff --git a/library/tzdata/SystemV/CST6 b/library/tzdata/SystemV/CST6 deleted file mode 100644 index d46c015..0000000 --- a/library/tzdata/SystemV/CST6 +++ /dev/null @@ -1,5 +0,0 @@ -# created by ../tools/tclZIC.tcl - do not edit -if {![info exists TZData(America/Regina)]} { - LoadTimeZoneFile America/Regina -} -set TZData(:SystemV/CST6) $TZData(:America/Regina) diff --git a/library/tzdata/SystemV/CST6CDT b/library/tzdata/SystemV/CST6CDT deleted file mode 100644 index 234af89..0000000 --- a/library/tzdata/SystemV/CST6CDT +++ /dev/null @@ -1,5 +0,0 @@ -# created by ../tools/tclZIC.tcl - do not edit -if {![info exists TZData(America/Chicago)]} { - LoadTimeZoneFile America/Chicago -} -set TZData(:SystemV/CST6CDT) $TZData(:America/Chicago) diff --git a/library/tzdata/SystemV/EST5 b/library/tzdata/SystemV/EST5 deleted file mode 100644 index 52818c1..0000000 --- a/library/tzdata/SystemV/EST5 +++ /dev/null @@ -1,5 +0,0 @@ -# created by ../tools/tclZIC.tcl - do not edit -if {![info exists TZData(America/Indianapolis)]} { - LoadTimeZoneFile America/Indianapolis -} -set TZData(:SystemV/EST5) $TZData(:America/Indianapolis) diff --git a/library/tzdata/SystemV/EST5EDT b/library/tzdata/SystemV/EST5EDT deleted file mode 100644 index 6cf2743..0000000 --- a/library/tzdata/SystemV/EST5EDT +++ /dev/null @@ -1,5 +0,0 @@ -# created by ../tools/tclZIC.tcl - do not edit -if {![info exists TZData(America/New_York)]} { - LoadTimeZoneFile America/New_York -} -set TZData(:SystemV/EST5EDT) $TZData(:America/New_York) diff --git a/library/tzdata/SystemV/HST10 b/library/tzdata/SystemV/HST10 deleted file mode 100644 index a4316af..0000000 --- a/library/tzdata/SystemV/HST10 +++ /dev/null @@ -1,5 +0,0 @@ -# created by ../tools/tclZIC.tcl - do not edit -if {![info exists TZData(Pacific/Honolulu)]} { - LoadTimeZoneFile Pacific/Honolulu -} -set TZData(:SystemV/HST10) $TZData(:Pacific/Honolulu) diff --git a/library/tzdata/SystemV/MST7 b/library/tzdata/SystemV/MST7 deleted file mode 100644 index e67a781..0000000 --- a/library/tzdata/SystemV/MST7 +++ /dev/null @@ -1,5 +0,0 @@ -# created by ../tools/tclZIC.tcl - do not edit -if {![info exists TZData(America/Phoenix)]} { - LoadTimeZoneFile America/Phoenix -} -set TZData(:SystemV/MST7) $TZData(:America/Phoenix) diff --git a/library/tzdata/SystemV/MST7MDT b/library/tzdata/SystemV/MST7MDT deleted file mode 100644 index fda5bf1..0000000 --- a/library/tzdata/SystemV/MST7MDT +++ /dev/null @@ -1,5 +0,0 @@ -# created by ../tools/tclZIC.tcl - do not edit -if {![info exists TZData(America/Denver)]} { - LoadTimeZoneFile America/Denver -} -set TZData(:SystemV/MST7MDT) $TZData(:America/Denver) diff --git a/library/tzdata/SystemV/PST8 b/library/tzdata/SystemV/PST8 deleted file mode 100644 index 8e30bb8..0000000 --- a/library/tzdata/SystemV/PST8 +++ /dev/null @@ -1,5 +0,0 @@ -# created by ../tools/tclZIC.tcl - do not edit -if {![info exists TZData(Pacific/Pitcairn)]} { - LoadTimeZoneFile Pacific/Pitcairn -} -set TZData(:SystemV/PST8) $TZData(:Pacific/Pitcairn) diff --git a/library/tzdata/SystemV/PST8PDT b/library/tzdata/SystemV/PST8PDT deleted file mode 100644 index 8281a9a..0000000 --- a/library/tzdata/SystemV/PST8PDT +++ /dev/null @@ -1,5 +0,0 @@ -# created by ../tools/tclZIC.tcl - do not edit -if {![info exists TZData(America/Los_Angeles)]} { - LoadTimeZoneFile America/Los_Angeles -} -set TZData(:SystemV/PST8PDT) $TZData(:America/Los_Angeles) diff --git a/library/tzdata/SystemV/YST9 b/library/tzdata/SystemV/YST9 deleted file mode 100644 index 32d3717..0000000 --- a/library/tzdata/SystemV/YST9 +++ /dev/null @@ -1,5 +0,0 @@ -# created by ../tools/tclZIC.tcl - do not edit -if {![info exists TZData(Pacific/Gambier)]} { - LoadTimeZoneFile Pacific/Gambier -} -set TZData(:SystemV/YST9) $TZData(:Pacific/Gambier) diff --git a/library/tzdata/SystemV/YST9YDT b/library/tzdata/SystemV/YST9YDT deleted file mode 100644 index fba405f..0000000 --- a/library/tzdata/SystemV/YST9YDT +++ /dev/null @@ -1,5 +0,0 @@ -# created by ../tools/tclZIC.tcl - do not edit -if {![info exists TZData(America/Anchorage)]} { - LoadTimeZoneFile America/Anchorage -} -set TZData(:SystemV/YST9YDT) $TZData(:America/Anchorage) diff --git a/libtommath/tommath_private.h b/libtommath/tommath_private.h index 138d39e..5123f53 100644 --- a/libtommath/tommath_private.h +++ b/libtommath/tommath_private.h @@ -194,9 +194,6 @@ MP_STATIC_ASSERT(prec_geq_min_prec, MP_PREC >= MP_MIN_PREC) /* random number source */ extern MP_PRIVATE mp_err(*s_mp_rand_source)(void *out, size_t size); -#ifdef __cplusplus -extern "C" { -#endif /* lowlevel functions, do not call! */ MP_PRIVATE mp_bool s_mp_get_bit(const mp_int *a, unsigned int b); MP_PRIVATE mp_err s_mp_add(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; @@ -252,10 +249,6 @@ MP_DEPRECATED(s_mp_toom_mul) mp_err mp_toom_mul(const mp_int *a, const mp_int *b MP_DEPRECATED(s_mp_toom_sqr) mp_err mp_toom_sqr(const mp_int *a, mp_int *b); MP_DEPRECATED(s_mp_reverse) void bn_reverse(unsigned char *s, int len); -#ifdef __cplusplus -} -#endif - #ifndef TCL_WITH_EXTERNAL_TOMMATH #undef mp_sqr #define mp_sqr TclBN_mp_sqr diff --git a/macosx/README b/macosx/README index d0208fa..c1f9e87 100644 --- a/macosx/README +++ b/macosx/README @@ -108,7 +108,7 @@ The following build configurations are available: The Xcode projects refer to the toplevel tcl source directory via the TCL_SRCROOT user build setting, by default this is set to the project-relative path '../../tcl', if your tcl source directory is named differently, e.g. -'../../tcl8.7', you need to manually change the TCL_SRCROOT setting by editing +'../../tcl9.0', you need to manually change the TCL_SRCROOT setting by editing your ${USER}.pbxuser file (located inside the Tcl.xcodeproj bundle directory) with a text editor. @@ -126,9 +126,9 @@ Detailed Instructions for building with macosx/GNUmakefile - Unpack the Tcl source release archive. - The following instructions assume the Tcl source tree is named "tcl${ver}", -(where ${ver} is a shell variable containing the Tcl version number e.g. '8.7'). +(where ${ver} is a shell variable containing the Tcl version number e.g. '9.0'). Setup this shell variable as follows: - ver="8.7" + ver="9.0" If you are building from CVS, omit this step (CVS source tree names usually do not contain a version number). diff --git a/macosx/Tcl-Common.xcconfig b/macosx/Tcl-Common.xcconfig index 5193b70..7f181c0 100644 --- a/macosx/Tcl-Common.xcconfig +++ b/macosx/Tcl-Common.xcconfig @@ -27,11 +27,9 @@ FRAMEWORK_INSTALL_PATH = /Library/Frameworks INCLUDEDIR = $(PREFIX)/include LIBDIR = $(PREFIX)/lib MANDIR = $(PREFIX)/man -PER_ARCH_CFLAGS_ppc = -mcpu=G3 -mtune=G4 $(PER_ARCH_CFLAGS_ppc) -PER_ARCH_CFLAGS_ppc64 = -mcpu=G5 -mpowerpc64 $(PER_ARCH_CFLAGS_ppc64) PREFIX = /usr/local TCL_CONFIGURE_ARGS = --enable-dtrace TCL_LIBRARY = $(LIBDIR)/tcl$(VERSION) TCL_PACKAGE_PATH = "$(LIBDIR)" TCL_DEFS = HAVE_TCL_CONFIG_H -VERSION = 8.7 +VERSION = 9.0 diff --git a/macosx/Tcl.xcodeproj/project.pbxproj b/macosx/Tcl.xcodeproj/project.pbxproj index 4143128..872a8cd 100644 --- a/macosx/Tcl.xcodeproj/project.pbxproj +++ b/macosx/Tcl.xcodeproj/project.pbxproj @@ -1323,7 +1323,6 @@ F96D3F3B08F272A8004A47F5 /* dde */, F96D3F8C08F272A8004A47F5 /* history.tcl */, F96D3F8D08F272A8004A47F5 /* http */, - F96D3F9008F272A8004A47F5 /* http1.0 */, F96D3F9308F272A8004A47F5 /* init.tcl */, F96D3F9408F272A8004A47F5 /* msgcat */, F96D401708F272AA004A47F5 /* opt */, @@ -1357,15 +1356,6 @@ path = http; sourceTree = "<group>"; }; - F96D3F9008F272A8004A47F5 /* http1.0 */ = { - isa = PBXGroup; - children = ( - F96D3F9108F272A8004A47F5 /* http.tcl */, - F96D3F9208F272A8004A47F5 /* pkgIndex.tcl */, - ); - path = http1.0; - sourceTree = "<group>"; - }; F96D3F9408F272A8004A47F5 /* msgcat */ = { isa = PBXGroup; children = ( diff --git a/macosx/tclMacOSXBundle.c b/macosx/tclMacOSXBundle.c index 6707ef0..57ed0b9 100644 --- a/macosx/tclMacOSXBundle.c +++ b/macosx/tclMacOSXBundle.c @@ -146,41 +146,6 @@ OpenResourceMap( /* *---------------------------------------------------------------------- * - * Tcl_MacOSXOpenBundleResources -- - * - * Given the bundle name for a shared library, this routine sets - * libraryPath to the Resources/Scripts directory in the framework - * package. If hasResourceFile is true, it will also open the main - * resource file for the bundle. - * - * Results: - * TCL_OK if the bundle could be opened, and the Scripts folder found. - * TCL_ERROR otherwise. - * - * Side effects: - * libraryVariableName may be set, and the resource file opened. - * - *---------------------------------------------------------------------- - */ - -#if !defined(TCL_NO_DEPRECATED) && (TCL_MAJOR_VERSION < 9) -#undef Tcl_MacOSXOpenBundleResources -int -Tcl_MacOSXOpenBundleResources( - Tcl_Interp *interp, - const char *bundleName, - int hasResourceFile, - int maxPathLen, - char *libraryPath) -{ - return Tcl_MacOSXOpenVersionedBundleResources(interp, bundleName, NULL, - hasResourceFile, maxPathLen, libraryPath); -} -#endif - -/* - *---------------------------------------------------------------------- - * * Tcl_MacOSXOpenVersionedBundleResources -- * * Given the bundle and version name for a shared library (version name @@ -205,7 +170,7 @@ Tcl_MacOSXOpenVersionedBundleResources( const char *bundleName, const char *bundleVersion, int hasResourceFile, - int maxPathLen, + size_t maxPathLen, char *libraryPath) { #ifdef HAVE_COREFOUNDATION diff --git a/macosx/tclMacOSXFCmd.c b/macosx/tclMacOSXFCmd.c index 60cb7f3..7bdc72a 100644 --- a/macosx/tclMacOSXFCmd.c +++ b/macosx/tclMacOSXFCmd.c @@ -88,7 +88,8 @@ static const Tcl_ObjType tclOSTypeType = { NULL, /* freeIntRepProc */ NULL, /* dupIntRepProc */ UpdateStringOfOSType, /* updateStringProc */ - SetOSTypeFromAny /* setFromAnyProc */ + SetOSTypeFromAny, /* setFromAnyProc */ + TCL_OBJTYPE_V0 }; enum { @@ -639,9 +640,10 @@ SetOSTypeFromAny( int result = TCL_OK; Tcl_DString ds; Tcl_Encoding encoding = Tcl_GetEncoding(NULL, "macRoman"); + size_t length; - string = TclGetString(objPtr); - Tcl_UtfToExternalDString(encoding, string, objPtr->length, &ds); + string = Tcl_GetStringFromObj(objPtr, &length); + Tcl_UtfToExternalDStringEx(encoding, string, length, TCL_ENCODING_NOCOMPLAIN, &ds); if (Tcl_DStringLength(&ds) > 4) { if (interp) { @@ -692,7 +694,7 @@ UpdateStringOfOSType( Tcl_Obj *objPtr) /* OSType object whose string rep to * update. */ { - const int size = TCL_UTF_MAX * 4; + const size_t size = TCL_UTF_MAX * 4; char *dst = Tcl_InitStringRep(objPtr, NULL, size); OSType osType = (OSType) objPtr->internalRep.wideValue; int written = 0; diff --git a/macosx/tclMacOSXNotify.c b/macosx/tclMacOSXNotify.c index d7c4d7f..36c3f59 100644 --- a/macosx/tclMacOSXNotify.c +++ b/macosx/tclMacOSXNotify.c @@ -311,7 +311,7 @@ typedef struct FileHandler { * for this file. */ Tcl_FileProc *proc; /* Function to call, in the style of * Tcl_CreateFileHandler. */ - ClientData clientData; /* Argument to pass to proc. */ + void *clientData; /* Argument to pass to proc. */ struct FileHandler *nextPtr;/* Next in list of all files we care about. */ } FileHandler; @@ -505,7 +505,7 @@ static CFStringRef tclEventsOnlyRunLoopMode = NULL; */ static void StartNotifierThread(void); -static TCL_NORETURN void NotifierThreadProc(ClientData clientData); +static TCL_NORETURN void NotifierThreadProc(void *clientData); static int FileHandlerEventProc(Tcl_Event *evPtr, int flags); static void TimerWakeUp(CFRunLoopTimerRef timer, void *info); static void QueueFileEvents(void *info); @@ -612,7 +612,7 @@ LookUpFileHandler( *---------------------------------------------------------------------- */ -ClientData +void * TclpInitNotifier(void) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -868,7 +868,7 @@ StartNotifierThread(void) void TclpFinalizeNotifier( - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -970,7 +970,7 @@ TclpFinalizeNotifier( void TclpAlertNotifier( - ClientData clientData) + void *clientData) { ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData; @@ -1047,7 +1047,7 @@ TclpSetTimer( static void TimerWakeUp( TCL_UNUSED(CFRunLoopTimerRef), - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { } @@ -1114,13 +1114,13 @@ TclpCreateFileHandler( * called. */ Tcl_FileProc *proc, /* Function to call for each selected * event. */ - ClientData clientData) /* Arbitrary data to pass to proc. */ + void *clientData) /* Arbitrary data to pass to proc. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); FileHandler *filePtr = LookUpFileHandler(tsdPtr, fd, NULL); if (filePtr == NULL) { - filePtr = (FileHandler *) ckalloc(sizeof(FileHandler)); + filePtr = (FileHandler *) Tcl_Alloc(sizeof(FileHandler)); filePtr->fd = fd; filePtr->readyMask = 0; filePtr->nextPtr = tsdPtr->firstFileHandlerPtr; @@ -1235,7 +1235,7 @@ TclpDeleteFileHandler( } else { prevPtr->nextPtr = filePtr->nextPtr; } - ckfree(filePtr); + Tcl_Free(filePtr); } /* @@ -1334,7 +1334,7 @@ FileHandlerEventProc( *---------------------------------------------------------------------- */ -ClientData +void * TclpNotifierData(void) { return NULL; @@ -1518,7 +1518,7 @@ QueueFileEvents( if (filePtr->readyMask == 0) { FileHandlerEvent *fileEvPtr = (FileHandlerEvent *) - ckalloc(sizeof(FileHandlerEvent)); + Tcl_Alloc(sizeof(FileHandlerEvent)); fileEvPtr->header.proc = FileHandlerEventProc; fileEvPtr->fd = filePtr->fd; @@ -1908,7 +1908,7 @@ int TclAsyncNotifier( int sigNumber, /* Signal number. */ TCL_UNUSED(Tcl_ThreadId), /* Target thread. */ - TCL_UNUSED(ClientData), /* Notifier data. */ + TCL_UNUSED(void *), /* Notifier data. */ int *flagPtr, /* Flag to mark. */ int value) /* Value of mark. */ { @@ -1967,7 +1967,7 @@ TclAsyncNotifier( static TCL_NORETURN void NotifierThreadProc( - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { ThreadSpecificData *tsdPtr; fd_set readableMask, writableMask, exceptionalMask; diff --git a/tests/apply.test b/tests/apply.test index 24b27cc..a5f1f8f 100644 --- a/tests/apply.test +++ b/tests/apply.test @@ -261,7 +261,7 @@ test apply-9.1 {leaking internal rep} -setup { lindex $lines 3 3 } set lam [list {} {set a 1}] -} -constraints {memory} -body { +} -constraints memory -body { set end [getbytes] for {set i 0} {$i < 5} {incr i} { ::apply [lrange $lam 0 end] diff --git a/tests/assemble.test b/tests/assemble.test index b656894..d4e44f8 100644 --- a/tests/assemble.test +++ b/tests/assemble.test @@ -532,18 +532,6 @@ test assemble-7.16 {incrStk} { -result 12 -cleanup {rename x {}} } -test assemble-7.17 {land/lor} { - -body { - proc x {a b} { - list \ - [assemble {load a; load b; land}] \ - [assemble {load a; load b; lor}] - } - list [x 0 0] [x 0 23] [x 35 0] [x 47 59] - } - -result {{0 0} {0 1} {0 1} {1 1}} - -cleanup {rename x {}} -} test assemble-7.18 {lappendArrayStk} { -body { proc x {} { diff --git a/tests/binary.test b/tests/binary.test index c51d0e9..a947410 100644 --- a/tests/binary.test +++ b/tests/binary.test @@ -3002,7 +3002,7 @@ test binary-78.1 {unicode (out of BMP) to byte-array conversion, bug-[bd94500678 binary encode hex \U0001f415 binary scan \U0001f415 a* v; set v set str {} -} -result {} +} -result * -match glob -returnCodes error testConstraint testsetbytearraylength \ @@ -3011,20 +3011,32 @@ testConstraint testsetbytearraylength \ test binary-79.1 {Tcl_SetByteArrayLength} testsetbytearraylength { testsetbytearraylength [string cat A B C] 1 } A -test binary-79.2 {Tcl_SetByteArrayLength} testsetbytearraylength { +test binary-79.2 {Tcl_SetByteArrayLength} -body { testsetbytearraylength [string cat Ł B C] 1 +} -constraints testsetbytearraylength -returnCodes error -match glob -result * +test binary-79.3 {Tcl_SetByteArrayLength} testsetbytearraylength { + testsetbytearraylength [string cat A B \u0141] 0 +} {} +test binary-79.4 {Tcl_SetByteArrayLength} testsetbytearraylength { + testsetbytearraylength [string cat A B \u0141] 1 } A - -test binary-80.1 {TclGetBytesFromObj} -constraints testbytestring -returnCodes 1 -body { +test binary-79.5 {Tcl_SetByteArrayLength} testsetbytearraylength { + testsetbytearraylength [string cat A B \u0141] 2 +} AB +test binary-79.6 {Tcl_SetByteArrayLength} -body { + testsetbytearraylength [string cat A B \u0141] 3 +} -constraints testsetbytearraylength -returnCodes error -match glob -result * + +test binary-80.1 {Tcl_GetBytesFromObj} -constraints testbytestring -returnCodes 1 -body { testbytestring "乎" } -result "expected byte sequence but character 0 was '乎' (U+004E4E)" -test binary-80.2 {TclGetBytesFromObj} -constraints testbytestring -returnCodes 1 -body { +test binary-80.2 {Tcl_GetBytesFromObj} -constraints testbytestring -returnCodes 1 -body { testbytestring [testbytestring "\x00\xA0\xA0\xA0\xE4\xB9\x8E"] } -result "expected byte sequence but character 4 was '乎' (U+004E4E)" -test binary-80.3 {TclGetBytesFromObj} -constraints testbytestring -returnCodes 1 -body { +test binary-80.3 {Tcl_GetBytesFromObj} -constraints testbytestring -returnCodes 1 -body { testbytestring [testbytestring "\xC0\x80\xA0\xA0\xA0\xE4\xB9\x8E"] } -result "expected byte sequence but character 4 was '乎' (U+004E4E)" -test binary-80.4 {TclGetBytesFromObj} -constraints testbytestring -returnCodes 1 -body { +test binary-80.4 {Tcl_GetBytesFromObj} -constraints testbytestring -returnCodes 1 -body { testbytestring [testbytestring "\xC0\x80\xA0\xA0\xA0\xF0\x9F\x98\x81"] } -result "expected byte sequence but character 4 was '\U01F601' (U+01F601)" diff --git a/tests/case.test b/tests/case.test deleted file mode 100644 index 1c12e3a..0000000 --- a/tests/case.test +++ /dev/null @@ -1,94 +0,0 @@ -# Commands covered: case -# -# This file contains a collection of tests for one or more of the Tcl -# built-in commands. Sourcing this file into Tcl runs the tests and -# generates output for errors. No output means no errors were found. -# -# Copyright © 1991-1993 The Regents of the University of California. -# Copyright © 1994 Sun Microsystems, Inc. -# Copyright © 1998-1999 Scriptics Corporation. -# -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. - -if {![llength [info commands case]]} { - # No "case" command? So no need to test - return -} - -if {"::tcltest" ni [namespace children]} { - package require tcltest 2.5 - namespace import -force ::tcltest::* -} - -test case-1.1 {simple pattern} { - case a in a {format 1} b {format 2} c {format 3} default {format 4} -} 1 -test case-1.2 {simple pattern} { - case b a {format 1} b {format 2} c {format 3} default {format 4} -} 2 -test case-1.3 {simple pattern} { - case x in a {format 1} b {format 2} c {format 3} default {format 4} -} 4 -test case-1.4 {simple pattern} { - case x a {format 1} b {format 2} c {format 3} -} {} -test case-1.5 {simple pattern matches many times} { - case b a {format 1} b {format 2} b {format 3} b {format 4} -} 2 -test case-1.6 {fancier pattern} { - case cx a {format 1} *c {format 2} *x {format 3} default {format 4} -} 3 -test case-1.7 {list of patterns} { - case abc in {a b c} {format 1} {def abc ghi} {format 2} -} 2 - -test case-2.1 {error in executed command} { - list [catch {case a in a {error "Just a test"} default {format 1}} msg] \ - $msg $::errorInfo -} {1 {Just a test} {Just a test - while executing -"error "Just a test"" - ("a" arm line 1) - invoked from within -"case a in a {error "Just a test"} default {format 1}"}} -test case-2.2 {error: not enough args} { - list [catch {case} msg] $msg -} {1 {wrong # args: should be "case string ?in? ?pattern body ...? ?default body?"}} -test case-2.3 {error: pattern with no body} { - list [catch {case a b} msg] $msg -} {1 {extra case pattern with no body}} -test case-2.4 {error: pattern with no body} { - list [catch {case a in b {format 1} c} msg] $msg -} {1 {extra case pattern with no body}} -test case-2.5 {error in default command} { - list [catch {case foo in a {error case1} default {error case2} \ - b {error case 3}} msg] $msg $::errorInfo -} {1 case2 {case2 - while executing -"error case2" - ("default" arm line 1) - invoked from within -"case foo in a {error case1} default {error case2} b {error case 3}"}} - -test case-3.1 {single-argument form for pattern/command pairs} { - case b in { - a {format 1} - b {format 2} - default {format 6} - } -} {2} -test case-3.2 {single-argument form for pattern/command pairs} { - case b { - a {format 1} - b {format 2} - default {format 6} - } -} {2} -test case-3.3 {single-argument form for pattern/command pairs} { - list [catch {case z in {a 2 b}} msg] $msg -} {1 {extra case pattern with no body}} - -# cleanup -::tcltest::cleanupTests -return diff --git a/tests/chan.test b/tests/chan.test index 4155c36..946e424 100644 --- a/tests/chan.test +++ b/tests/chan.test @@ -12,6 +12,8 @@ if {"::tcltest" ni [namespace children]} { namespace import -force ::tcltest::* } +package require tcltests + # # Note: The tests for the chan methods "create" and "postevent" # currently reside in the file "ioCmd.test". @@ -49,19 +51,19 @@ test chan-4.1 {chan command: configure subcommand} -body { } -returnCodes error -result "wrong # args: should be \"chan configure channelId ?-option value ...?\"" test chan-4.2 {chan command: [Bug 800753]} -body { chan configure stdout -eofchar Ā -} -returnCodes error -match glob -result {bad value*} +} -returnCodes error -result {bad value for -eofchar: must be non-NUL ASCII character} test chan-4.3 {chan command: [Bug 800753]} -body { chan configure stdout -eofchar \x00 -} -returnCodes error -match glob -result {bad value*} -test chan-4.4 {chan command: check valid inValue, no outValue} -body { +} -returnCodes error -result {bad value for -eofchar: must be non-NUL ASCII character} +test chan-4.4 {chan command: check valid inValue, no outValue} -constraints deprecated -body { chan configure stdout -eofchar [list \x27 {}] } -result {} test chan-4.5 {chan command: check valid inValue, invalid outValue} -body { chan configure stdout -eofchar [list \x27 \x80] -} -returnCodes error -match glob -result {bad value for -eofchar:*} +} -returnCodes error -result {bad value for -eofchar: must be non-NUL ASCII character} test chan-4.6 {chan command: check no inValue, valid outValue} -body { chan configure stdout -eofchar [list {} \x27] -} -result {} -cleanup {chan configure stdout -eofchar [list {} {}]} +} -returnCodes error -result {bad value for -eofchar: must be non-NUL ASCII character} -cleanup {chan configure stdout -eofchar {}} test chan-5.1 {chan command: copy subcommand} -body { chan copy foo diff --git a/tests/chanio.test b/tests/chanio.test index 2189cc4..1d0b225 100644 --- a/tests/chanio.test +++ b/tests/chanio.test @@ -61,7 +61,7 @@ namespace eval ::tcl::test::io { set umaskValue 0 testConstraint umask [expr {![catch {set umaskValue [scan [exec /bin/sh -c umask] %o]}]}] - testConstraint makeFileInHome [expr {![file exists ~/_test_] && [file writable ~]}] + testConstraint makeFileInHome [expr {![file exists $::env(HOME)/_test_] && [file writable $::env(HOME)]}] # set up a long data file for some of the following tests @@ -80,7 +80,7 @@ namespace eval ::tcl::test::io { if {$argv != ""} { set f [open [lindex $argv 0]] } - chan configure $f -encoding binary -translation lf -blocking 0 -eofchar "\x1A \x1A" + chan configure $f -encoding binary -translation lf -blocking 0 -eofchar \x1A chan configure stdout -encoding binary -translation lf -buffering none chan event $f readable "foo $f" proc foo {f} { @@ -481,7 +481,7 @@ test chan-io-6.8 {Tcl_GetsObj: remember if EOF is seen} -body { chan puts $f "abcdef\x1Aghijk\nwombat" chan close $f set f [open $path(test1)] - chan configure $f -eofchar "\x1A \x1A" + chan configure $f -eofchar \x1A list [chan gets $f line] $line [chan gets $f line] $line } -cleanup { chan close $f @@ -491,7 +491,7 @@ test chan-io-6.9 {Tcl_GetsObj: remember if EOF is seen} -body { chan puts $f "abcdefghijk\nwom\x1Abat" chan close $f set f [open $path(test1)] - chan configure $f -eofchar "\x1A \x1A" + chan configure $f -eofchar \x1A list [chan gets $f line] $line [chan gets $f line] $line } -cleanup { chan close $f @@ -999,7 +999,7 @@ test chan-io-6.52 {Tcl_GetsObj: saw EOF character} -constraints {testchannel} -b chan puts -nonewline $f "123456\x1Ak9012345\r" chan close $f set f [open $path(test1)] - chan configure $f -eofchar "\x1A \x1A" + chan configure $f -eofchar \x1A list [chan gets $f] [testchannel queuedcr $f] [chan tell $f] [chan gets $f] } -cleanup { chan close $f @@ -1889,13 +1889,13 @@ test chan-io-20.2 {Tcl_CreateChannel: initial settings} -constraints {win} -body list [chan configure $f -eofchar] [chan configure $f -translation] } -cleanup { chan close $f -} -result [list [list \x1A ""] {auto crlf}] +} -result {{} {auto crlf}} test chan-io-20.3 {Tcl_CreateChannel: initial settings} -constraints {unix} -body { set f [open $path(test1) w+] list [chan configure $f -eofchar] [chan configure $f -translation] } -cleanup { chan close $f -} -result {{{} {}} {auto lf}} +} -result {{} {auto lf}} test chan-io-20.5 {Tcl_CreateChannel: install channel in empty slot} -setup { set path(stdout) [makeFile {} stdout] } -constraints {stdio notWinCI} -body { @@ -3105,7 +3105,7 @@ test chan-io-30.16 {Tcl_Write ^Z at end, Tcl_Read auto} -setup { chan puts -nonewline $f hello\nthere\nand\rhere\n\x1A chan close $f set f [open $path(test1) r] - chan configure $f -translation auto -eofchar "\x1A \x1A" + chan configure $f -translation auto -eofchar \x1A chan read $f } -cleanup { chan close $f @@ -3118,11 +3118,11 @@ test chan-io-30.17 {Tcl_Write, implicit ^Z at end, Tcl_Read auto} -setup { file delete $path(test1) } -constraints {win} -body { set f [open $path(test1) w] - chan configure $f -translation lf -eofchar "\x1A \x1A" + chan configure $f -translation lf -eofchar \x1A chan puts $f hello\nthere\nand\rhere chan close $f set f [open $path(test1) r] - chan configure $f -translation auto -eofchar "\x1A \x1A" + chan configure $f -translation auto -eofchar \x1A chan read $f } -cleanup { chan close $f @@ -3140,7 +3140,7 @@ test chan-io-30.18 {Tcl_Write, ^Z in middle, Tcl_Read auto} -setup { chan puts $f $s chan close $f set f [open $path(test1) r] - chan configure $f -translation auto -eofchar "\x1A \x1A" + chan configure $f -translation auto -eofchar \x1A set l "" lappend l [chan gets $f] lappend l [chan gets $f] @@ -3161,7 +3161,7 @@ test chan-io-30.19 {Tcl_Write, ^Z no newline in middle, Tcl_Read auto} -setup { chan puts $f $s chan close $f set f [open $path(test1) r] - chan configure $f -translation auto -eofchar "\x1A \x1A" + chan configure $f -translation auto -eofchar \x1A set l "" lappend l [chan gets $f] lappend l [chan gets $f] @@ -3239,7 +3239,7 @@ test chan-io-30.23 {Tcl_Write lf, ^Z in middle, Tcl_Read auto} -setup { chan puts $f [format abc\ndef\n%cqrs\ntuv 26] chan close $f set f [open $path(test1) r] - chan configure $f -translation auto -eofchar "\x1A \x1A" + chan configure $f -translation auto -eofchar \x1A list [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f @@ -3253,7 +3253,7 @@ test chan-io-30.24 {Tcl_Write lf, ^Z in middle, Tcl_Read lf} -setup { chan puts $f $c chan close $f set f [open $path(test1) r] - chan configure $f -translation lf -eofchar "\x1A \x1A" + chan configure $f -translation lf -eofchar \x1A list [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f @@ -3267,7 +3267,7 @@ test chan-io-30.25 {Tcl_Write cr, ^Z in middle, Tcl_Read auto} -setup { chan puts $f $c chan close $f set f [open $path(test1) r] - chan configure $f -translation auto -eofchar "\x1A \x1A" + chan configure $f -translation auto -eofchar \x1A list [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f @@ -3281,7 +3281,7 @@ test chan-io-30.26 {Tcl_Write cr, ^Z in middle, Tcl_Read cr} -setup { chan puts $f $c chan close $f set f [open $path(test1) r] - chan configure $f -translation cr -eofchar "\x1A \x1A" + chan configure $f -translation cr -eofchar \x1A list [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f @@ -3295,7 +3295,7 @@ test chan-io-30.27 {Tcl_Write crlf, ^Z in middle, Tcl_Read auto} -setup { chan puts $f $c chan close $f set f [open $path(test1) r] - chan configure $f -translation auto -eofchar "\x1A \x1A" + chan configure $f -translation auto -eofchar \x1A list [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f @@ -3309,7 +3309,7 @@ test chan-io-30.28 {Tcl_Write crlf, ^Z in middle, Tcl_Read crlf} -setup { chan puts $f $c chan close $f set f [open $path(test1) r] - chan configure $f -translation crlf -eofchar "\x1A \x1A" + chan configure $f -translation crlf -eofchar \x1A list [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f @@ -3660,7 +3660,7 @@ test chan-io-31.18 {Tcl_Write ^Z at end, Tcl_Gets auto} -setup { chan puts $f [format "hello\nthere\nand\rhere\n\%c" 26] chan close $f set f [open $path(test1) r] - chan configure $f -translation auto -eofchar "\x1A \x1A" + chan configure $f -translation auto -eofchar \x1A lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan gets $f] @@ -3676,11 +3676,11 @@ test chan-io-31.19 {Tcl_Write, implicit ^Z at end, Tcl_Gets auto} -setup { set l "" } -body { set f [open $path(test1) w] - chan configure $f -translation lf -eofchar "\x1A \x1A" + chan configure $f -translation lf -eofchar \x1A chan puts $f hello\nthere\nand\rhere chan close $f set f [open $path(test1) r] - chan configure $f -translation auto -eofchar "\x1A \x1A" + chan configure $f -translation auto -eofchar \x1A lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan gets $f] @@ -3700,7 +3700,7 @@ test chan-io-31.20 {Tcl_Write, ^Z in middle, Tcl_Gets auto, eofChar} -setup { chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26] chan close $f set f [open $path(test1) r] - chan configure $f -translation auto -eofchar "\x1A \x1A" + chan configure $f -translation auto -eofchar \x1A lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan eof $f] @@ -3718,7 +3718,7 @@ test chan-io-31.21 {Tcl_Write, no newline ^Z in middle, Tcl_Gets auto, eofChar} chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26] chan close $f set f [open $path(test1) r] - chan configure $f -translation auto -eofchar "\x1A \x1A" + chan configure $f -translation auto -eofchar \x1A lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan eof $f] @@ -3802,7 +3802,7 @@ test chan-io-31.25 {Tcl_Write lf, ^Z in middle, Tcl_Gets auto} -setup { chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26] chan close $f set f [open $path(test1) r] - chan configure $f -translation auto -eofchar "\x1A \x1A" + chan configure $f -translation auto -eofchar \x1A lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan eof $f] @@ -3820,7 +3820,7 @@ test chan-io-31.26 {Tcl_Write lf, ^Z in middle, Tcl_Gets lf} -setup { chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26] chan close $f set f [open $path(test1) r] - chan configure $f -translation lf -eofchar "\x1A \x1A" + chan configure $f -translation lf -eofchar \x1A lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan eof $f] @@ -3838,7 +3838,7 @@ test chan-io-31.27 {Tcl_Write cr, ^Z in middle, Tcl_Gets auto} -setup { chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26] chan close $f set f [open $path(test1) r] - chan configure $f -translation auto -eofchar "\x1A \x1A" + chan configure $f -translation auto -eofchar \x1A lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan eof $f] @@ -3856,7 +3856,7 @@ test chan-io-31.28 {Tcl_Write cr, ^Z in middle, Tcl_Gets cr} -setup { chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26] chan close $f set f [open $path(test1) r] - chan configure $f -translation cr -eofchar "\x1A \x1A" + chan configure $f -translation cr -eofchar \x1A lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan eof $f] @@ -3874,7 +3874,7 @@ test chan-io-31.29 {Tcl_Write crlf, ^Z in middle, Tcl_Gets auto} -setup { chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26] chan close $f set f [open $path(test1) r] - chan configure $f -translation auto -eofchar "\x1A \x1A" + chan configure $f -translation auto -eofchar \x1A lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan eof $f] @@ -3892,7 +3892,7 @@ test chan-io-31.30 {Tcl_Write crlf, ^Z in middle, Tcl_Gets crlf} -setup { chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26] chan close $f set f [open $path(test1) r] - chan configure $f -translation crlf -eofchar "\x1A \x1A" + chan configure $f -translation crlf -eofchar \x1A lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan eof $f] @@ -4648,86 +4648,86 @@ test chan-io-35.6 {Tcl_Eof, eof char, lf write, auto read} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] - chan configure $f -translation lf -eofchar "\x1A \x1A" + chan configure $f -translation lf -eofchar \x1A chan puts $f abc\ndef chan close $f set s [file size $path(test1)] set f [open $path(test1) r] - chan configure $f -translation auto -eofchar "\x1A \x1A" + chan configure $f -translation auto -eofchar \x1A list $s [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f -} -result {9 8 1} +} -result {8 8 1} test chan-io-35.7 {Tcl_Eof, eof char, lf write, lf read} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] - chan configure $f -translation lf -eofchar "\x1A \x1A" + chan configure $f -translation lf -eofchar \x1A chan puts $f abc\ndef chan close $f set s [file size $path(test1)] set f [open $path(test1) r] - chan configure $f -translation lf -eofchar "\x1A \x1A" + chan configure $f -translation lf -eofchar \x1A list $s [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f -} -result {9 8 1} +} -result {8 8 1} test chan-io-35.8 {Tcl_Eof, eof char, cr write, auto read} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] - chan configure $f -translation cr -eofchar "\x1A \x1A" + chan configure $f -translation cr -eofchar \x1A chan puts $f abc\ndef chan close $f set s [file size $path(test1)] set f [open $path(test1) r] - chan configure $f -translation auto -eofchar "\x1A \x1A" + chan configure $f -translation auto -eofchar \x1A list $s [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f -} -result {9 8 1} +} -result {8 8 1} test chan-io-35.9 {Tcl_Eof, eof char, cr write, cr read} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] - chan configure $f -translation cr -eofchar "\x1A \x1A" + chan configure $f -translation cr -eofchar \x1A chan puts $f abc\ndef chan close $f set s [file size $path(test1)] set f [open $path(test1) r] - chan configure $f -translation cr -eofchar "\x1A \x1A" + chan configure $f -translation cr -eofchar \x1A list $s [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f -} -result {9 8 1} +} -result {8 8 1} test chan-io-35.10 {Tcl_Eof, eof char, crlf write, auto read} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] - chan configure $f -translation crlf -eofchar "\x1A \x1A" + chan configure $f -translation crlf -eofchar \x1A chan puts $f abc\ndef chan close $f set s [file size $path(test1)] set f [open $path(test1) r] - chan configure $f -translation auto -eofchar "\x1A \x1A" + chan configure $f -translation auto -eofchar \x1A list $s [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f -} -result {11 8 1} +} -result {10 8 1} test chan-io-35.11 {Tcl_Eof, eof char, crlf write, crlf read} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] - chan configure $f -translation crlf -eofchar "\x1A \x1A" + chan configure $f -translation crlf -eofchar \x1A chan puts $f abc\ndef chan close $f set s [file size $path(test1)] set f [open $path(test1) r] - chan configure $f -translation crlf -eofchar "\x1A \x1A" + chan configure $f -translation crlf -eofchar \x1A list $s [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f -} -result {11 8 1} +} -result {10 8 1} test chan-io-35.12 {Tcl_Eof, eof char in middle, lf write, auto read} -setup { file delete $path(test1) } -body { @@ -4737,7 +4737,7 @@ test chan-io-35.12 {Tcl_Eof, eof char in middle, lf write, auto read} -setup { chan close $f set c [file size $path(test1)] set f [open $path(test1) r] - chan configure $f -translation auto -eofchar "\x1A \x1A" + chan configure $f -translation auto -eofchar \x1A list $c [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f @@ -4751,7 +4751,7 @@ test chan-io-35.13 {Tcl_Eof, eof char in middle, lf write, lf read} -setup { chan close $f set c [file size $path(test1)] set f [open $path(test1) r] - chan configure $f -translation lf -eofchar "\x1A \x1A" + chan configure $f -translation lf -eofchar \x1A list $c [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f @@ -4765,7 +4765,7 @@ test chan-io-35.14 {Tcl_Eof, eof char in middle, cr write, auto read} -setup { chan close $f set c [file size $path(test1)] set f [open $path(test1) r] - chan configure $f -translation auto -eofchar "\x1A \x1A" + chan configure $f -translation auto -eofchar \x1A list $c [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f @@ -4779,7 +4779,7 @@ test chan-io-35.15 {Tcl_Eof, eof char in middle, cr write, cr read} -setup { chan close $f set c [file size $path(test1)] set f [open $path(test1) r] - chan configure $f -translation cr -eofchar "\x1A \x1A" + chan configure $f -translation cr -eofchar \x1A list $c [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f @@ -4793,7 +4793,7 @@ test chan-io-35.16 {Tcl_Eof, eof char in middle, crlf write, auto read} -setup { chan close $f set c [file size $path(test1)] set f [open $path(test1) r] - chan configure $f -translation auto -eofchar "\x1A \x1A" + chan configure $f -translation auto -eofchar \x1A list $c [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f @@ -4807,7 +4807,7 @@ test chan-io-35.17 {Tcl_Eof, eof char in middle, crlf write, crlf read} -setup { chan close $f set c [file size $path(test1)] set f [open $path(test1) r] - chan configure $f -translation crlf -eofchar "\x1A \x1A" + chan configure $f -translation crlf -eofchar \x1A list $c [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f @@ -5285,29 +5285,29 @@ test chan-io-39.21 {Tcl_SetChannelOption, setting read mode independently} \ test chan-io-39.22 {Tcl_SetChannelOption, invariance} -setup { file delete $path(test1) set l "" -} -constraints {unix} -body { +} -constraints {unix deprecated} -body { set f1 [open $path(test1) w+] lappend l [chan configure $f1 -eofchar] - chan configure $f1 -eofchar {ON GO} + chan configure $f1 -eofchar {O {}} lappend l [chan configure $f1 -eofchar] - chan configure $f1 -eofchar {D D} + chan configure $f1 -eofchar D lappend l [chan configure $f1 -eofchar] } -cleanup { chan close $f1 -} -result {{{} {}} {O G} {D D}} +} -result {{} O D} test chan-io-39.22a {Tcl_SetChannelOption, invariance} -setup { file delete $path(test1) set l [list] -} -body { +} -constraints deprecated -body { set f1 [open $path(test1) w+] - chan configure $f1 -eofchar {ON GO} + chan configure $f1 -eofchar {O {}} lappend l [chan configure $f1 -eofchar] - chan configure $f1 -eofchar {D D} + chan configure $f1 -eofchar D lappend l [chan configure $f1 -eofchar] lappend l [list [catch {chan configure $f1 -eofchar {1 2 3}} msg] $msg] } -cleanup { chan close $f1 -} -result {{O G} {D D} {1 {bad value for -eofchar: should be a list of zero, one, or two elements}}} +} -result {O D {1 {bad value for -eofchar: must be non-NUL ASCII character}}} test chan-io-39.23 {Tcl_GetChannelOption, server socket is not readable or\ writeable, it should still have valid -eofchar and -translation options} -setup { set l [list] @@ -5317,7 +5317,7 @@ test chan-io-39.23 {Tcl_GetChannelOption, server socket is not readable or\ [chan configure $sock -translation] } -cleanup { chan close $sock -} -result {{{}} auto} +} -result {{} auto} test chan-io-39.24 {Tcl_SetChannelOption, server socket is not readable or\ writable so we can't change -eofchar or -translation} -setup { set l [list] @@ -5328,7 +5328,7 @@ test chan-io-39.24 {Tcl_SetChannelOption, server socket is not readable or\ [chan configure $sock -translation] } -cleanup { chan close $sock -} -result {{{}} auto} +} -result {{} auto} test chan-io-40.1 {POSIX open access modes: RDWR} -setup { file delete $path(test3) @@ -5488,21 +5488,16 @@ test chan-io-40.15 {POSIX open access modes: RDWR} { chan close $f lappend x [viewFile test3] } {zzy abzzy} -test chan-io-40.16 {tilde substitution in open} -constraints makeFileInHome -setup { - makeFile {Some text} _test_ ~ +test chan-io-40.16 {verify no tilde substitution in open} -setup { + set curdir [pwd] + cd [temporaryDirectory] } -body { - file exists [file join $::env(HOME) _test_] + close [open ~ w] + list [file isfile ~] } -cleanup { - removeFile _test_ ~ + file delete ./~ ;# ./ because don't want to delete home in case of bugs! + cd $curdir } -result 1 -test chan-io-40.17 {tilde substitution in open} -setup { - set home $::env(HOME) -} -body { - unset ::env(HOME) - open ~/foo -} -returnCodes error -cleanup { - set ::env(HOME) $home -} -result {couldn't find HOME environment variable to expand path} test chan-io-41.1 {Tcl_FileeventCmd: errors} -constraints fileevent -body { chan event foo @@ -6047,7 +6042,7 @@ test chan-io-48.4 {lf write, testing readability, ^Z termination, auto read mode chan puts -nonewline $f [format "abc\ndef\n%c" 26] chan close $f set f [open $path(test1) r] - chan configure $f -translation auto -eofchar "\x1A \x1A" + chan configure $f -translation auto -eofchar \x1A chan event $f readable [namespace code { if {[chan eof $f]} { set x done @@ -6071,7 +6066,7 @@ test chan-io-48.5 {lf write, testing readability, ^Z in middle, auto read mode} chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26] chan close $f set f [open $path(test1) r] - chan configure $f -translation auto -eofchar "\x1A \x1A" + chan configure $f -translation auto -eofchar \x1A chan event $f readable [namespace code { if {[chan eof $f]} { set x done @@ -6095,7 +6090,7 @@ test chan-io-48.6 {cr write, testing readability, ^Z termination, auto read mode chan puts -nonewline $f [format "abc\ndef\n%c" 26] chan close $f set f [open $path(test1) r] - chan configure $f -translation auto -eofchar "\x1A \x1A" + chan configure $f -translation auto -eofchar \x1A chan event $f readable [namespace code { if {[chan eof $f]} { set x done @@ -6119,7 +6114,7 @@ test chan-io-48.7 {cr write, testing readability, ^Z in middle, auto read mode} chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26] chan close $f set f [open $path(test1) r] - chan configure $f -translation auto -eofchar "\x1A \x1A" + chan configure $f -translation auto -eofchar \x1A chan event $f readable [namespace code { if {[chan eof $f]} { set x done @@ -6143,7 +6138,7 @@ test chan-io-48.8 {crlf write, testing readability, ^Z termination, auto read mo chan puts -nonewline $f [format "abc\ndef\n%c" 26] chan close $f set f [open $path(test1) r] - chan configure $f -translation auto -eofchar "\x1A \x1A" + chan configure $f -translation auto -eofchar \x1A chan event $f readable [namespace code { if {[chan eof $f]} { set x done @@ -6167,7 +6162,7 @@ test chan-io-48.9 {crlf write, testing readability, ^Z in middle, auto read mode chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26] chan close $f set f [open $path(test1) r] - chan configure $f -translation auto -eofchar "\x1A \x1A" + chan configure $f -translation auto -eofchar \x1A chan event $f readable [namespace code { if {[chan eof $f]} { set x done @@ -6191,7 +6186,7 @@ test chan-io-48.10 {lf write, testing readability, ^Z in middle, lf read mode} - chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26] chan close $f set f [open $path(test1) r] - chan configure $f -translation lf -eofchar "\x1A \x1A" + chan configure $f -translation lf -eofchar \x1A chan event $f readable [namespace code { if {[chan eof $f]} { set x done @@ -6215,7 +6210,7 @@ test chan-io-48.11 {lf write, testing readability, ^Z termination, lf read mode} chan puts -nonewline $f [format "abc\ndef\n%c" 26] chan close $f set f [open $path(test1) r] - chan configure $f -translation lf -eofchar "\x1A \x1A" + chan configure $f -translation lf -eofchar \x1A chan event $f readable [namespace code { if {[chan eof $f]} { set x done @@ -6239,7 +6234,7 @@ test chan-io-48.12 {cr write, testing readability, ^Z in middle, cr read mode} - chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26] chan close $f set f [open $path(test1) r] - chan configure $f -translation cr -eofchar "\x1A \x1A" + chan configure $f -translation cr -eofchar \x1A chan event $f readable [namespace code { if {[chan eof $f]} { set x done @@ -6263,7 +6258,7 @@ test chan-io-48.13 {cr write, testing readability, ^Z termination, cr read mode} chan puts -nonewline $f [format "abc\ndef\n%c" 26] chan close $f set f [open $path(test1) r] - chan configure $f -translation cr -eofchar "\x1A \x1A" + chan configure $f -translation cr -eofchar \x1A chan event $f readable [namespace code { if {[chan eof $f]} { set x done @@ -6287,7 +6282,7 @@ test chan-io-48.14 {crlf write, testing readability, ^Z in middle, crlf read mod chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26] chan close $f set f [open $path(test1) r] - chan configure $f -translation crlf -eofchar "\x1A \x1A" + chan configure $f -translation crlf -eofchar \x1A chan event $f readable [namespace code { if {[chan eof $f]} { set x done @@ -6311,7 +6306,7 @@ test chan-io-48.15 {crlf write, testing readability, ^Z termi, crlf read mode} - chan puts -nonewline $f [format "abc\ndef\n%c" 26] chan close $f set f [open $path(test1) r] - chan configure $f -translation crlf -eofchar "\x1A \x1A" + chan configure $f -translation crlf -eofchar \x1A chan event $f readable [namespace code { if {[chan eof $f]} { set x done diff --git a/tests/cmdAH.test b/tests/cmdAH.test index cb7e1cf..5dbeae1 100644 --- a/tests/cmdAH.test +++ b/tests/cmdAH.test @@ -22,10 +22,6 @@ testConstraint testchmod [llength [info commands testchmod]] testConstraint testsetplatform [llength [info commands testsetplatform]] testConstraint testvolumetype [llength [info commands testvolumetype]] testConstraint testbytestring [llength [info commands testbytestring]] -testConstraint time64bit [expr { - $::tcl_platform(pointerSize) >= 8 || - [llength [info command testsize]] && [testsize st_mtime] >= 8 -}] testConstraint linkDirectory [expr { ![testConstraint win] || ($::tcl_platform(osVersion) >= 5.0 @@ -65,8 +61,6 @@ test cmdAH-0.2 {Tcl_BreakObjCmd, success} { list [catch {break} msg] $msg } {3 {}} -# Tcl_CaseObjCmd is tested in case.test - test cmdAH-1.1 {Tcl_CatchObjCmd, errors} -returnCodes error -body { catch } -result {wrong # args: should be "catch script ?resultVarName? ?optionVarName?"} @@ -107,7 +101,7 @@ test cmdAH-2.3 {Tcl_CdObjCmd} -setup { set env(HOME) $oldpwd file mkdir $foodir cd $foodir - cd ~ + cd [file home] string equal [pwd] $oldpwd } -cleanup { cd $oldpwd @@ -131,8 +125,21 @@ test cmdAH-2.4 {Tcl_CdObjCmd} -setup { set env(HOME) $temp } -result 1 test cmdAH-2.5 {Tcl_CdObjCmd} -returnCodes error -body { - cd ~~ -} -result {user "~" doesn't exist} + cd ~ +} -result {couldn't change working directory to "~": no such file or directory} +test cmdAH-2.5.1 {Tcl_CdObjCmd} -setup { + set oldpwd [pwd] + cd [temporaryDirectory] + file delete ./~ + file mkdir ~ +} -body { + cd ~ + pwd +} -cleanup { + cd [temporaryDirectory] + file delete ./~ + cd $oldpwd +} -result [file join [temporaryDirectory] ~] test cmdAH-2.6 {Tcl_CdObjCmd} -returnCodes error -body { cd _foobar } -result {couldn't change working directory to "_foobar": no such file or directory} @@ -522,7 +529,7 @@ test cmdAH-8.43 {Tcl_FileObjCmd: dirname} -setup { } -constraints testsetplatform -body { set env(HOME) "/homewontexist/test" testsetplatform unix - file dirname ~ + file dirname [file home] } -cleanup { set env(HOME) $temp } -result /homewontexist @@ -532,19 +539,13 @@ test cmdAH-8.44 {Tcl_FileObjCmd: dirname} -setup { } -constraints testsetplatform -body { set env(HOME) "~" testsetplatform unix - file dirname ~ + file dirname [file home] } -cleanup { set env(HOME) $temp -} -result ~ -test cmdAH-8.45 {Tcl_FileObjCmd: dirname} -setup { - set temp $::env(HOME) -} -constraints {win testsetplatform} -match regexp -body { - set ::env(HOME) "/homewontexist/test" - testsetplatform windows +} -result . +test cmdAH-8.45 {Tcl_FileObjCmd: dirname ~} -body { file dirname ~ -} -cleanup { - set ::env(HOME) $temp -} -result {([a-zA-Z]:?)/homewontexist} +} -result . test cmdAH-8.46 {Tcl_FileObjCmd: dirname} { set f [file normalize [info nameof]] file exists $f @@ -652,36 +653,19 @@ test cmdAH-9.26 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform windows file tail {//foo/bar} } {} -test cmdAH-9.42 {Tcl_FileObjCmd: tail} -constraints testsetplatform -setup { - global env - set temp $env(HOME) -} -body { - set env(HOME) "/home/test" - testsetplatform unix +test cmdAH-9.42 {Tcl_FileObjCmd: tail ~} -body { file tail ~ -} -cleanup { - set env(HOME) $temp -} -result test +} -result ~ test cmdAH-9.43 {Tcl_FileObjCmd: tail} -constraints testsetplatform -setup { global env set temp $env(HOME) } -body { set env(HOME) "~" testsetplatform unix - file tail ~ + file tail [file home] } -cleanup { set env(HOME) $temp -} -result {} -test cmdAH-9.44 {Tcl_FileObjCmd: tail} -constraints testsetplatform -setup { - global env - set temp $env(HOME) -} -body { - set env(HOME) "/home/test" - testsetplatform windows - file tail ~ -} -cleanup { - set env(HOME) $temp -} -result test +} -result ~ test cmdAH-9.46 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform unix file tail {f.oo\bar/baz.bat} @@ -712,7 +696,7 @@ test cmdAH-9.52 {Tcl_FileObjCmd: tail / normalize, bug 7a9dc52b29} { [file tail {~/test/~foo}] \ [file tail [file normalize {~/~foo}]] \ [file tail [file normalize {~/test/~foo}]] -} [lrepeat 4 ./~foo] +} [lrepeat 4 ~foo] # rootname test cmdAH-10.1 {Tcl_FileObjCmd: rootname} -returnCodes error -body { @@ -966,7 +950,7 @@ test cmdAH-14.3 {Tcl_FileObjCmd: join} testsetplatform { test cmdAH-15.1 {Tcl_FileObjCmd} -constraints testsetplatform -body { testsetplatform unix file atime ~_bad_user -} -returnCodes error -result {user "_bad_user" doesn't exist} +} -returnCodes error -result {could not read "~_bad_user": no such file or directory} catch {testsetplatform $platform} @@ -1089,9 +1073,8 @@ test cmdAH-19.9 {Tcl_FileObjCmd: ~ : exists} { file exists ~nOsUcHuSeR } 0 test cmdAH-19.10 {Tcl_FileObjCmd: ~ : nativename} -body { - # should probably be a non-error in fact... file nativename ~nOsUcHuSeR -} -returnCodes error -match glob -result * +} -result ~nOsUcHuSeR # The test below has to be done in /tmp rather than the current directory in # order to guarantee (?) a local file system: some NFS file systems won't do # the stuff below correctly. @@ -1431,14 +1414,14 @@ test cmdAH-24.14.1 { } -match regexp -result {could not (?:get modification time|read)} -returnCodes error # 3155760000 is 64-bit unix time, Wed Jan 01 00:00:00 GMT 2070: -test cmdAH-24.20.1 {Tcl_FileObjCmd: atime 64-bit time_t, bug [4718b41c56]} -constraints {time64bit} -setup { +test cmdAH-24.20.1 {Tcl_FileObjCmd: atime 64-bit time_t, bug [4718b41c56]} -setup { set filename [makeFile "" foo.text] } -body { list [file atime $filename 3155760000] [file atime $filename] } -cleanup { removeFile $filename } -result {3155760000 3155760000} -test cmdAH-24.20.2 {Tcl_FileObjCmd: mtime 64-bit time_t, bug [4718b41c56]} -constraints {time64bit} -setup { +test cmdAH-24.20.2 {Tcl_FileObjCmd: mtime 64-bit time_t, bug [4718b41c56]} -setup { set filename [makeFile "" foo.text] } -body { list [file mtime $filename 3155760000] [file mtime $filename] @@ -1735,9 +1718,6 @@ test cmdAH-30.6 {Tcl_FileObjCmd: error conditions} -returnCodes error -body { test cmdAH-30.7 {Tcl_FileObjCmd: error conditions} -returnCodes error -body { file t x } -match glob -result {unknown or ambiguous subcommand "t": must be *} -test cmdAH-30.8 {Tcl_FileObjCmd: error conditions} -returnCodes error -body { - file dirname ~woohgy -} -result {user "woohgy" doesn't exist} # channels # In testing 'file channels', we need to make sure that a channel created in diff --git a/tests/compExpr-old.test b/tests/compExpr-old.test index 40dea76..5f705c3 100644 --- a/tests/compExpr-old.test +++ b/tests/compExpr-old.test @@ -19,7 +19,6 @@ if {"::tcltest" ni [namespace children]} { ::tcltest::loadTestedCommands -catch [list package require -exact tcl::test [info patchlevel]] # Big test for correct ordering of data in [expr] diff --git a/tests/compExpr.test b/tests/compExpr.test index eaef772..84c53de 100644 --- a/tests/compExpr.test +++ b/tests/compExpr.test @@ -14,7 +14,6 @@ if {"::tcltest" ni [namespace children]} { } ::tcltest::loadTestedCommands -catch [list package require -exact tcl::test [info patchlevel]] # Constrain memory leak tests testConstraint memory [llength [info commands memory]] diff --git a/tests/compile.test b/tests/compile.test index aec1ef1..06ebb10 100644 --- a/tests/compile.test +++ b/tests/compile.test @@ -326,7 +326,7 @@ test compile-11.2 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body { } -returnCodes error -result {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?} test compile-11.3 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body { apply {{} { set r [list foobar] ; string index a 0o9 }} -} -returnCodes error -match glob -result {*invalid octal number*} +} -returnCodes error -match glob -result {*} test compile-11.4 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body { apply {{} { set r [list foobar] ; array set var {one two many} }} } -returnCodes error -result {list must have an even number of elements} diff --git a/tests/encoding.test b/tests/encoding.test index 9aa123d..63270fd 100644 --- a/tests/encoding.test +++ b/tests/encoding.test @@ -22,8 +22,6 @@ catch { package require -exact tcl::test [info patchlevel] } -source [file join [file dirname [info script]] tcltests.tcl] - proc toutf {args} { variable x lappend x "toutf $args" @@ -42,7 +40,10 @@ testConstraint testbytestring [llength [info commands testbytestring]] testConstraint teststringbytes [llength [info commands teststringbytes]] testConstraint exec [llength [info commands exec]] testConstraint testgetencpath [llength [info commands testgetencpath]] - +testConstraint fullutf [expr {[format %c 0x010000] ne "\uFFFD"}] +testConstraint utf32 [expr {[testConstraint fullutf] + && [string length [format %c 0x10000]] == 1}] + # TclInitEncodingSubsystem is tested by the rest of this file # TclFinalizeEncodingSubsystem is not currently tested @@ -338,74 +339,74 @@ test encoding-15.3 {UtfToUtfProc null character input} teststringbytes { } c080 test encoding-15.4 {UtfToUtfProc emoji character input} -body { set x \xED\xA0\xBD\xED\xB8\x82 - set y [encoding convertfrom utf-8 \xED\xA0\xBD\xED\xB8\x82] + set y [encoding convertfrom -nocomplain utf-8 \xED\xA0\xBD\xED\xB8\x82] list [string length $x] $y -} -result "6 😂" +} -result "6 \uD83D\uDE02" test encoding-15.5 {UtfToUtfProc emoji character input} { set x \xF0\x9F\x98\x82 set y [encoding convertfrom utf-8 \xF0\x9F\x98\x82] list [string length $x] $y } "4 😂" -test encoding-15.6 {UtfToUtfProc emoji character output} { +test encoding-15.6 {UtfToUtfProc emoji character output} utf32 { set x \uDE02\uD83D\uDE02\uD83D set y [encoding convertto -nocomplain utf-8 \uDE02\uD83D\uDE02\uD83D] binary scan $y H* z list [string length $y] $z -} {10 edb882f09f9882eda0bd} -test encoding-15.7 {UtfToUtfProc emoji character output} { +} {12 efbfbdefbfbdefbfbdefbfbd} +test encoding-15.7 {UtfToUtfProc emoji character output} utf32 { set x \uDE02\uD83D\uD83D set y [encoding convertto -nocomplain utf-8 \uDE02\uD83D\uD83D] binary scan $y H* z list [string length $x] [string length $y] $z -} {3 9 edb882eda0bdeda0bd} -test encoding-15.8 {UtfToUtfProc emoji character output} { +} {3 9 efbfbdefbfbdefbfbd} +test encoding-15.8 {UtfToUtfProc emoji character output} utf32 { set x \uDE02\uD83Dé set y [encoding convertto -nocomplain utf-8 \uDE02\uD83Dé] binary scan $y H* z list [string length $x] [string length $y] $z -} {3 8 edb882eda0bdc3a9} -test encoding-15.9 {UtfToUtfProc emoji character output} { +} {3 8 efbfbdefbfbdc3a9} +test encoding-15.9 {UtfToUtfProc emoji character output} utf32 { set x \uDE02\uD83DX set y [encoding convertto -nocomplain utf-8 \uDE02\uD83DX] binary scan $y H* z list [string length $x] [string length $y] $z -} {3 7 edb882eda0bd58} -test encoding-15.10 {UtfToUtfProc high surrogate character output} { +} {3 7 efbfbdefbfbd58} +test encoding-15.10 {UtfToUtfProc high surrogate character output} utf32 { set x \uDE02é set y [encoding convertto -nocomplain utf-8 \uDE02é] binary scan $y H* z list [string length $x] [string length $y] $z -} {2 5 edb882c3a9} -test encoding-15.11 {UtfToUtfProc low surrogate character output} { +} {2 5 efbfbdc3a9} +test encoding-15.11 {UtfToUtfProc low surrogate character output} utf32 { set x \uDA02é set y [encoding convertto -nocomplain utf-8 \uDA02é] binary scan $y H* z list [string length $x] [string length $y] $z -} {2 5 eda882c3a9} -test encoding-15.12 {UtfToUtfProc high surrogate character output} { +} {2 5 efbfbdc3a9} +test encoding-15.12 {UtfToUtfProc high surrogate character output} utf32 { set x \uDE02Y set y [encoding convertto -nocomplain utf-8 \uDE02Y] binary scan $y H* z list [string length $x] [string length $y] $z -} {2 4 edb88259} -test encoding-15.13 {UtfToUtfProc low surrogate character output} { +} {2 4 efbfbd59} +test encoding-15.13 {UtfToUtfProc low surrogate character output} utf32 { set x \uDA02Y set y [encoding convertto -nocomplain utf-8 \uDA02Y] binary scan $y H* z list [string length $x] [string length $y] $z -} {2 4 eda88259} -test encoding-15.14 {UtfToUtfProc high surrogate character output} { +} {2 4 efbfbd59} +test encoding-15.14 {UtfToUtfProc high surrogate character output} utf32 { set x \uDE02 set y [encoding convertto -nocomplain utf-8 \uDE02] binary scan $y H* z list [string length $x] [string length $y] $z -} {1 3 edb882} -test encoding-15.15 {UtfToUtfProc low surrogate character output} { +} {1 3 efbfbd} +test encoding-15.15 {UtfToUtfProc low surrogate character output} utf32 { set x \uDA02 set y [encoding convertto -nocomplain utf-8 \uDA02] binary scan $y H* z list [string length $x] [string length $y] $z -} {1 3 eda882} +} {1 3 efbfbd} test encoding-15.16 {UtfToUtfProc: Invalid 4-byte UTF-8, see [ed29806ba]} { set x \xF0\xA0\xA1\xC2 set y [encoding convertfrom -nocomplain utf-8 \xF0\xA0\xA1\xC2] @@ -637,16 +638,16 @@ test encoding-24.10 {Parse valid or invalid utf-8} { test encoding-24.11 {Parse valid or invalid utf-8} { string length [encoding convertfrom -nocomplain utf-8 "\xEF\xBF\xBF"] } 1 -test encoding-24.12 {Parse valid or invalid utf-8} -constraints deprecated -body { - encoding convertfrom utf-8 "\xC0\x81" -} -result \xC0\x81 -test encoding-24.13 {Parse valid or invalid utf-8} -constraints deprecated -body { - encoding convertfrom utf-8 "\xC1\xBF" -} -result \xC1\xBF +test encoding-24.12 {Parse valid or invalid utf-8} -body { + encoding convertfrom -strict utf-8 "\xC0\x81" +} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xC0'} +test encoding-24.13 {Parse valid or invalid utf-8} -body { + encoding convertfrom -strict utf-8 "\xC1\xBF" +} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xC1'} test encoding-24.14 {Parse valid or invalid utf-8} { string length [encoding convertfrom utf-8 "\xC2\x80"] } 1 -test encoding-24.15 {Parse valid or invalid utf-8} -constraints deprecated -body { +test encoding-24.15 {Parse valid or invalid utf-8} -body { encoding convertfrom utf-8 "Z\xE0\x80" } -result Z\xE0\x80 test encoding-24.16 {Parse valid or invalid utf-8} -constraints testbytestring -body { @@ -658,9 +659,9 @@ test encoding-24.17 {Parse valid or invalid utf-8} -constraints testbytestring - test encoding-24.18 {Parse valid or invalid utf-8} -constraints testbytestring -body { encoding convertto utf-8 [testbytestring "Z\xE0\x80xxxxxx"] } -result "Z\xC3\xA0\xE2\x82\xACxxxxxx" -test encoding-24.19 {Parse valid or invalid utf-8} -constraints deprecated -body { +test encoding-24.19 {Parse valid or invalid utf-8} -body { encoding convertto utf-8 "ZX\uD800" -} -result ZX\xED\xA0\x80 +} -returnCodes 1 -match glob -result "unexpected character at index 2: 'U+00D800'" test encoding-24.20 {Parse with -nocomplain but without providing encoding} { string length [encoding convertfrom -nocomplain "\x20"] } 1 @@ -842,7 +843,9 @@ test encoding-27.2 {encoding dirs basic behavior} -returnCodes error -body { test encoding-28.0 {all encodings load} -body { set string hello foreach name [encoding names] { - incr count + if {$name ne "unicode"} { + incr count + } encoding convertto -nocomplain $name $string # discard the cached internal representation of Tcl_Encoding @@ -850,7 +853,7 @@ test encoding-28.0 {all encodings load} -body { llength $name } return $count -} -result [expr {[info exists ::tcl_precision] ? 92 : 91}] +} -result 91 runtests diff --git a/tests/env.test b/tests/env.test index ce7c01e..bf3d9a1 100644 --- a/tests/env.test +++ b/tests/env.test @@ -411,6 +411,56 @@ test env-7.3 { }} } -cleanup cleanup1 -result 1 +test env-7.4 { + get env variable through upvar +} -setup setup1 -body { + apply {{} { + set ::env(test7_4) origvalue + upvar #0 env(test7_4) var + return $var + }} +} -cleanup cleanup1 -result origvalue + +test env-7.5 { + set env variable through upvar +} -setup setup1 -body { + apply {{} { + set ::env(test7_5) origvalue + upvar #0 env(test7_5) var + set var newvalue + return $::env(test7_5) + }} +} -cleanup cleanup1 -result newvalue + +test env-7.6 { + unset env variable through upvar +} -setup setup1 -body { + apply {{} { + set ::env(test7_6) origvalue + upvar #0 env(test7_6) var + unset var + return [array get env test7_6] + }} +} -cleanup cleanup1 -result {} + +test env-7.7 { + create new (unset) env variable through upvar +} -setup setup1 -body { + apply {{} { + unset -nocomplain ::env(test7_7) + upvar #0 env(test7_7) var + interp create interp1 + set var newvalue + set result [interp1 eval {info exists ::env(test7_7)}] + if {$result} { + lappend result [interp1 eval {set ::env(test7_7)}] + } + interp delete interp1 + return $result + }} +} -cleanup cleanup1 -result {1 newvalue} + + test env-8.0 { memory usage - valgrind does not report reachable memory } -body { diff --git a/tests/exec.test b/tests/exec.test index d1ef418..3e25360 100644 --- a/tests/exec.test +++ b/tests/exec.test @@ -434,15 +434,21 @@ test exec-10.19 {errors in exec invocation} -constraints {exec} -body { exec cat >@ $f } -returnCodes error -result "channel \"$f\" wasn't opened for writing" close $f -test exec-10.20 {errors in exec invocation} -constraints {exec notValgrind} -body { +test exec-10.20.1 {errors in exec invocation} -constraints {unix exec notValgrind} -body { exec ~non_existent_user/foo/bar -} -returnCodes error -result {user "non_existent_user" doesn't exist} -test exec-10.21 {errors in exec invocation} -constraints {exec notValgrind} -body { +} -returnCodes error -result {couldn't execute "~non_existent_user/foo/bar": no such file or directory} +test exec-10.20.1 {errors in exec invocation} -constraints {win exec notValgrind} -body { + exec ~non_existent_user/foo/bar +} -returnCodes error -result {couldn't execute "~non_existent_user\foo\bar": no such file or directory} +test exec-10.21.1 {errors in exec invocation} -constraints {unix exec notValgrind} -body { + exec [interpreter] true | ~xyzzy_bad_user/x | false +} -returnCodes error -result {couldn't execute "~xyzzy_bad_user/x": no such file or directory} +test exec-10.21.2 {errors in exec invocation} -constraints {win exec notValgrind} -body { exec [interpreter] true | ~xyzzy_bad_user/x | false -} -returnCodes error -result {user "xyzzy_bad_user" doesn't exist} +} -returnCodes error -result {couldn't execute "~xyzzy_bad_user\x": no such file or directory} test exec-10.22 {errors in exec invocation} -constraints {exec notValgrind} -body { exec echo test > ~non_existent_user/foo/bar -} -returnCodes error -result {user "non_existent_user" doesn't exist} +} -returnCodes error -result {couldn't write file "~non_existent_user/foo/bar": no such file or directory} # Commands in background. test exec-11.1 {commands in background} {exec} { diff --git a/tests/execute.test b/tests/execute.test index 8702de6..6d8ce99 100644 --- a/tests/execute.test +++ b/tests/execute.test @@ -464,10 +464,6 @@ test execute-3.71 {TclExecuteByteCode, INST_LNOT, op is non-numeric} {testobj} { list [catch {expr {! $x}} msg] $msg } {1 {can't use non-numeric string "foo" as operand of "!"}} -# INST_BITNOT not tested -# INST_CALL_BUILTIN_FUNC1 not tested -# INST_CALL_FUNC1 not tested - # INST_TRY_CVT_TO_NUMERIC is partially tested: test execute-3.72 {TclExecuteByteCode, INST_TRY_CVT_TO_NUMERIC, op is int} {testobj} { set x [testintobj set 1 1] @@ -1066,7 +1062,7 @@ test execute-9.1 {Interp result resetting [Bug 1522803]} { } SUCCESS test execute-10.1 {TclExecuteByteCode, INST_CONCAT1, bytearrays} { - apply {s {binary scan $s c x; list $x [scan $s$s %c%c]}} İ + apply {s {binary scan [binary format a $s] c x; list $x [scan $s$s %c%c]}} İ } {48 {304 304}} test execute-10.2 {Bug 2802881} -setup { interp create child diff --git a/tests/expr-old.test b/tests/expr-old.test index 2401bd4..7344e08 100644 --- a/tests/expr-old.test +++ b/tests/expr-old.test @@ -950,7 +950,7 @@ test expr-old-36.1 {ExprLooksLikeInt procedure} -body { test expr-old-36.2 {ExprLooksLikeInt procedure} { set x 0o289 list [catch {expr {$x+1}} msg] $msg -} {1 {can't use invalid octal number "0o289" as operand of "+"}} +} {1 {can't use non-numeric string "0o289" as operand of "+"}} test expr-old-36.3 {ExprLooksLikeInt procedure} { list [catch {expr 0289.1} msg] $msg } {0 289.1} @@ -1002,7 +1002,7 @@ test expr-old-36.14 {ExprLooksLikeInt procedure} { test expr-old-36.15 {ExprLooksLikeInt procedure} { set x "0o99 " list [catch {expr {$x+1}} msg] $msg -} {1 {can't use invalid octal number "0o99 " as operand of "+"}} +} {1 {can't use non-numeric string "0o99 " as operand of "+"}} test expr-old-36.16 {ExprLooksLikeInt procedure} { set x " 0xffffffffffffffffffffffffffffffffffffff " expr {$x+1} diff --git a/tests/expr.test b/tests/expr.test index 25a02e3..62b1c27 100644 --- a/tests/expr.test +++ b/tests/expr.test @@ -16,7 +16,6 @@ if {"::tcltest" ni [namespace children]} { } ::tcltest::loadTestedCommands -catch [list package require -exact tcl::test [info patchlevel]] # Determine if "long int" type is a 32 bit number and if the wide # type is a 64 bit number on this machine. @@ -853,7 +852,7 @@ test expr-21.21 {non-numeric boolean variables} { test expr-21.22 {non-numeric boolean variables} { set v "" list [catch {expr {!$v}} err] $err -} {1 {can't use empty string "" as operand of "!"}} +} {1 {can't use non-numeric string "" as operand of "!"}} # Test for non-numeric float handling. test expr-22.1 {non-numeric floats} { diff --git a/tests/fCmd.test b/tests/fCmd.test index 8c9f799..93793d1 100644 --- a/tests/fCmd.test +++ b/tests/fCmd.test @@ -96,6 +96,14 @@ if {[testConstraint unix]} { set user "root" } } +if {[testConstraint win]} { + catch { + set user $::env(USERNAME) + } + if {$user eq ""} { + set user Administrator + } +} proc createfile {file {string a}} { set f [open $file w] @@ -122,6 +130,10 @@ proc checkcontent {file matchString} { } proc openup {path} { + # Double check for inadvertent ~ -> home directory mapping + if {[string match ~* $path]} { + set file ./$path + } testchmod 0o777 $path if {[file isdirectory $path]} { catch { @@ -137,9 +149,13 @@ proc cleanup {args} { foreach p [concat $wd $args] { set x "" catch { - set x [glob -directory $p tf* td*] + set x [glob -directory $p tf* td* ~*] } foreach file $x { + # Double check for inadvertent ~ -> home directory mapping + if {[string match ~* $file]} { + set file ./$file + } if { [catch {file delete -force -- $file}] && [testConstraint testchmod] @@ -179,6 +195,43 @@ test fCmd-1.1 {TclFileRenameCmd} -constraints {notRoot} -setup { file rename tf1 tf2 glob tf* } -result {tf2} +test fCmd-1.2 {TclFileRenameCmd when target is ~} -setup { + cleanup + createfile tf1 +} -cleanup { + file delete ./~ +} -body { + file rename tf1 ~ + file isfile ~ +} -result 1 +test fCmd-1.3 {TclFileRenameCmd when target is ~user} -setup { + cleanup + createfile tf1 +} -cleanup { + file delete ./~$user +} -body { + file rename tf1 ~$user + file isfile ~$user +} -result 1 +test fCmd-1.4 {TclFileRenameCmd when source is ~} -setup { + cleanup + createfile ./~ +} -cleanup { + file delete ./~ +} -body { + file rename ~ tf1 + list [file exists ~] [file exists tf1] +} -result {0 1} +test fCmd-1.5 {TclFileRenameCmd when source is ~user} -setup { + cleanup + createfile ./~$user +} -cleanup { + file delete ./~$user +} -body { + file rename ~$user tf1 + list [file exists ~$user] [file exists tf1] +} -result {0 1} + test fCmd-2.1 {TclFileCopyCmd} -constraints {notRoot} -setup { cleanup @@ -187,6 +240,42 @@ test fCmd-2.1 {TclFileCopyCmd} -constraints {notRoot} -setup { file copy tf1 tf2 lsort [glob tf*] } -result {tf1 tf2} +test fCmd-2.2 {TclFileCopyCmd when target is ~} -setup { + cleanup + createfile tf1 +} -cleanup { + file delete ./~ +} -body { + file copy tf1 ~ + list [file exists tf1] [file exists ~] +} -result {1 1} +test fCmd-2.3 {TclFileCopyCmd when target is ~user} -setup { + cleanup + createfile tf1 +} -cleanup { + file delete ./~$user +} -body { + file copy tf1 ~$user + list [file exists tf1] [file exists ~$user] +} -result {1 1} +test fCmd-2.4 {TclFileCopyCmd when source is ~} -setup { + cleanup + createfile ./~ +} -cleanup { + file delete ./~ +} -body { + file copy ~ tf1 + list [file exists ~] [file exists tf1] +} -result {1 1} +test fCmd-2.5 {TclFileCopyCmd when source is ~user} -setup { + cleanup + createfile ./~$user +} -cleanup { + file delete ./~$user +} -body { + file copy ~$user tf1 + list [file exists ~$user] [file exists tf1] +} -result {1 1} test fCmd-3.1 {FileCopyRename: FileForceOption fails} -constraints {notRoot} -body { file rename -xyz @@ -196,7 +285,7 @@ test fCmd-3.2 {FileCopyRename: not enough args} -constraints {notRoot} -body { } -returnCodes error -result {wrong # args: should be "file rename ?-option value ...? source ?source ...? target"} test fCmd-3.3 {FileCopyRename: Tcl_TranslateFileName fails} -constraints {notRoot} -body { file rename xyz ~_totally_bogus_user -} -returnCodes error -result {user "_totally_bogus_user" doesn't exist} +} -returnCodes error -result {error renaming "xyz": no such file or directory} test fCmd-3.4 {FileCopyRename: Tcl_TranslateFileName passes} -setup { cleanup } -constraints {notRoot} -returnCodes error -body { @@ -270,7 +359,7 @@ test fCmd-3.14 {FileCopyRename: FileBasename fails} -setup { } -constraints {notRoot} -returnCodes error -body { file mkdir td1 file rename ~_totally_bogus_user td1 -} -result {user "_totally_bogus_user" doesn't exist} +} -result {error renaming "~_totally_bogus_user": no such file or directory} test fCmd-3.15 {FileCopyRename: source[0] == '\x00'} -setup { cleanup } -constraints {notRoot unixOrWin} -returnCodes error -body { @@ -308,11 +397,17 @@ test fCmd-4.3 {TclFileMakeDirsCmd: stops on first error} -setup { catch {file mkdir td1 td2 tf1 td3 td4} glob td1 td2 tf1 td3 td4 } -result {td1 td2 tf1} -test fCmd-4.4 {TclFileMakeDirsCmd: Tcl_TranslateFileName fails} -setup { +test fCmd-4.4 {TclFileMakeDirsCmd: Tcl_TranslateFileName treats ~ as normal char} -setup { cleanup -} -constraints {notRoot} -returnCodes error -body { +} -constraints {notRoot} -body { + list [file isdir ~] [file mkdir ~] [file isdir ~] +} -result {0 {} 1} +test fCmd-4.4.1 {TclFileMakeDirsCmd: Tcl_TranslateFileName treats ~ as normal char} -setup { + cleanup +} -constraints {notRoot} -body { file mkdir ~_totally_bogus_user -} -result {user "_totally_bogus_user" doesn't exist} + file isdir ~_totally_bogus_user +} -result 1 test fCmd-4.5 {TclFileMakeDirsCmd: Tcl_SplitPath returns 0: *name == '\x00'} -setup { cleanup } -constraints {notRoot} -returnCodes error -body { @@ -420,15 +515,16 @@ test fCmd-5.5 {TclFileDeleteCmd: stop at first error} -setup { catch {file delete tf1 td1 $root tf2} list [file exists tf1] [file exists tf2] [file exists td1] } -cleanup {cleanup} -result {0 1 0} -test fCmd-5.6 {TclFileDeleteCmd: Tcl_TranslateFileName fails} -constraints {notRoot} -body { +test fCmd-5.6 { + TclFileDeleteCmd: Tcl_TranslateFileName treats ~user as normal char +} -constraints {notRoot} -body { file delete ~_totally_bogus_user -} -returnCodes error -result {user "_totally_bogus_user" doesn't exist} -test fCmd-5.7 {TclFileDeleteCmd: Tcl_TranslateFileName succeeds} -setup { - catch {file delete ~/tf1} +} -result {} +test fCmd-5.7 { + TclFileDeleteCmd: Tcl_TranslateFileName treats ~ as normal char } -constraints {notRoot} -body { createfile ~/tf1 - file delete ~/tf1 -} -result {} +} -returnCodes error -result {couldn't open "~/tf1": no such file or directory} test fCmd-5.8 {TclFileDeleteCmd: file doesn't exist: lstat(name) != 0} -setup { cleanup } -constraints {notRoot} -body { @@ -627,37 +723,37 @@ test fCmd-6.23 {CopyRenameOneFile: TclpCopyDirectory failed} -setup { test fCmd-6.24 {CopyRenameOneFile: error uses original name} -setup { cleanup } -constraints {unix notRoot} -body { - file mkdir ~/td1/td2 - set td1name [file join [file dirname ~] [file tail ~] td1] + file mkdir [file home]/td1/td2 + set td1name [file join [file dirname [file home]] [file tail [file home]] td1] file attributes $td1name -permissions 0 - file copy ~/td1 td1 + file copy [file home]/td1 td1 } -returnCodes error -cleanup { file attributes $td1name -permissions 0o755 - file delete -force ~/td1 -} -result {error copying "~/td1": permission denied} + file delete -force [file home]/td1 +} -result "error copying \"[file home]/td1\": permission denied" test fCmd-6.25 {CopyRenameOneFile: error uses original name} -setup { cleanup } -constraints {unix notRoot} -body { file mkdir td2 - file mkdir ~/td1 - set td1name [file join [file dirname ~] [file tail ~] td1] + file mkdir [file home]/td1 + set td1name [file join [file dirname [file home]] [file tail [file home]] td1] file attributes $td1name -permissions 0 - file copy td2 ~/td1 + file copy td2 [file home]/td1 } -returnCodes error -cleanup { file attributes $td1name -permissions 0o755 - file delete -force ~/td1 -} -result {error copying "td2" to "~/td1/td2": permission denied} + file delete -force [file home]/td1 +} -result "error copying \"td2\" to \"[file home]/td1/td2\": permission denied" test fCmd-6.26 {CopyRenameOneFile: doesn't use original name} -setup { cleanup } -constraints {unix notRoot} -body { - file mkdir ~/td1/td2 - set td2name [file join [file dirname ~] [file tail ~] td1 td2] + file mkdir [file home]/td1/td2 + set td2name [file join [file dirname [file home]] [file tail [file home]] td1 td2] file attributes $td2name -permissions 0 - file copy ~/td1 td1 + file copy [file home]/td1 td1 } -returnCodes error -cleanup { file attributes $td2name -permissions 0o755 - file delete -force ~/td1 -} -result "error copying \"~/td1\" to \"td1\": \"[file join $::env(HOME) td1 td2]\": permission denied" + file delete -force [file home]/td1 +} -result "error copying \"[file home]/td1\" to \"td1\": \"[file join $::env(HOME) td1 td2]\": permission denied" test fCmd-6.27 {CopyRenameOneFile: TclpCopyDirectory failed} -setup { cleanup $tmpspace } -constraints {notRoot xdev} -returnCodes error -body { @@ -733,15 +829,15 @@ test fCmd-7.4 {FileForceOption: bad option} -constraints {notRoot} -setup { } -result {bad option "-tf1": must be -force or --} test fCmd-7.5 {FileForceOption: multiple times through loop} -setup { cleanup -} -constraints {notRoot} -returnCodes error -body { +} -constraints {notRoot} -body { createfile -- createfile -force file delete -force -force -- -- -force glob -- -- -force -} -result {no files matched glob patterns "-- -force"} +} -result {} test fCmd-8.1 {FileBasename: basename of ~user: argc == 1 && *path == ~} \ - -constraints {unix notRoot knownBug} -body { + -constraints {unix notRoot knownBug tildeexpansion} -body { # Labelled knownBug because it is dangerous [Bug: 3881] file mkdir td1 file attr td1 -perm 0o40000 @@ -752,11 +848,11 @@ test fCmd-8.1 {FileBasename: basename of ~user: argc == 1 && *path == ~} \ test fCmd-8.2 {FileBasename: basename of ~user: argc == 1 && *path == ~} \ -constraints {unix notRoot} -body { string equal [file tail ~$user] ~$user -} -result 0 +} -result 1 test fCmd-8.3 {file copy and path translation: ensure correct error} -body { - file copy ~ [file join this file doesnt exist] + file copy [file home] [file join this file doesnt exist] } -returnCodes error -result [subst \ - {error copying "~" to "[file join this file doesnt exist]": no such file or directory}] + {error copying "[file home]" to "[file join this file doesnt exist]": no such file or directory}] test fCmd-9.1 {file rename: comprehensive: EACCES} -setup { cleanup @@ -898,9 +994,9 @@ test fCmd-9.10 {file rename: comprehensive: file to new name and dir} -setup { testchmod 0o444 tf2 file rename tf1 [file join td1 tf3] file rename tf2 [file join td1 tf4] - list [catch {glob tf*}] [lsort [glob -directory td1 t*]] \ + list [glob tf*] [lsort [glob -directory td1 t*]] \ [file writable [file join td1 tf3]] [file writable [file join td1 tf4]] -} -result [subst {1 {[file join td1 tf3] [file join td1 tf4]} 1 0}] +} -result [subst {{} {[file join td1 tf3] [file join td1 tf4]} 1 0}] test fCmd-9.11 {file rename: comprehensive: dir to new name and dir} -setup { cleanup } -constraints {notRoot testchmod} -body { @@ -1498,15 +1594,17 @@ test fCmd-14.8 {copyfile: copy directory failing} -setup { # # Coverage tests for TclMkdirCmd() # + +# ~ is no longer a special char. Need a test case where translation fails. test fCmd-15.1 {TclMakeDirsCmd: target filename translation failing} -setup { set temp $::env(HOME) -} -constraints {notRoot} -body { +} -constraints {notRoot TODO} -body { global env unset env(HOME) catch {file mkdir ~/tfa} } -cleanup { set ::env(HOME) $temp -} -result {1} +} -result 1 # # Can Tcl_SplitPath return argc == 0? If so them we need a test for that code. # @@ -1599,9 +1697,10 @@ test fCmd-16.4 {accept zero files (TIP 323)} -body { test fCmd-16.5 {accept zero files (TIP 323)} -body { file delete -- } -result {} +# ~ is no longer a special char. Need a test case where translation fails. test fCmd-16.6 {delete: source filename translation failing} -setup { set temp $::env(HOME) -} -constraints {notRoot} -body { +} -constraints {notRoot TODO} -body { global env unset env(HOME) catch {file delete ~/tfa} @@ -2227,7 +2326,7 @@ test fCmd-27.2 {TclFileAttrsCmd - Tcl_TranslateFileName fails} -setup { file attributes ~_totally_bogus_user } -returnCodes error -cleanup { testsetplatform $platform -} -result {user "_totally_bogus_user" doesn't exist} +} -result {could not read "~_totally_bogus_user": no such file or directory} test fCmd-27.3 {TclFileAttrsCmd - all attributes} -setup { catch {file delete -force -- foo.tmp} } -body { diff --git a/tests/fileName.test b/tests/fileName.test index 575a17f..416c419 100644 --- a/tests/fileName.test +++ b/tests/fileName.test @@ -71,15 +71,15 @@ test filename-1.4 {Tcl_GetPathType: unix} {testsetplatform} { test filename-1.5 {Tcl_GetPathType: unix} {testsetplatform} { testsetplatform unix file pathtype ~ -} absolute +} relative test filename-1.6 {Tcl_GetPathType: unix} {testsetplatform} { testsetplatform unix file pathtype ~/foo -} absolute +} relative test filename-1.7 {Tcl_GetPathType: unix} {testsetplatform} { testsetplatform unix file pathtype ~foo -} absolute +} relative test filename-1.8 {Tcl_GetPathType: unix} {testsetplatform} { testsetplatform unix file pathtype ./~foo @@ -136,15 +136,15 @@ test filename-3.12 {Tcl_GetPathType: windows} {testsetplatform} { test filename-3.13 {Tcl_GetPathType: windows} {testsetplatform} { testsetplatform windows file pathtype ~foo -} absolute +} relative test filename-3.14 {Tcl_GetPathType: windows} {testsetplatform} { testsetplatform windows file pathtype ~ -} absolute +} relative test filename-3.15 {Tcl_GetPathType: windows} {testsetplatform} { testsetplatform windows file pathtype ~/foo -} absolute +} relative test filename-3.16 {Tcl_GetPathType: windows} {testsetplatform} { testsetplatform windows file pathtype ./~foo @@ -213,11 +213,11 @@ test filename-4.15 {Tcl_SplitPath: unix} {testsetplatform} { test filename-4.16 {Tcl_SplitPath: unix} {testsetplatform} { testsetplatform unix file split ~foo/~bar -} {~foo ./~bar} +} {~foo ~bar} test filename-4.17 {Tcl_SplitPath: unix} {testsetplatform} { testsetplatform unix file split ~foo/~bar/~baz -} {~foo ./~bar ./~baz} +} {~foo ~bar ~baz} test filename-4.18 {Tcl_SplitPath: unix} {testsetplatform} { testsetplatform unix file split foo/bar~/baz @@ -357,11 +357,11 @@ test filename-6.26 {Tcl_SplitPath: win} {testsetplatform} { test filename-6.27 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split ~foo/~bar -} {~foo ./~bar} +} {~foo ~bar} test filename-6.28 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split ~foo/~bar/~baz -} {~foo ./~bar ./~baz} +} {~foo ~bar ~baz} test filename-6.29 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split foo/bar~/baz @@ -369,7 +369,7 @@ test filename-6.29 {Tcl_SplitPath: win} {testsetplatform} { test filename-6.30 {Tcl_SplitPath: win} {testsetplatform} { testsetplatform win file split c:~foo -} {c: ./~foo} +} {c: ~foo} test filename-7.1 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix @@ -414,7 +414,7 @@ test filename-7.10 {Tcl_JoinPath: unix} {testsetplatform} { test filename-7.11 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join ~a ~b -} {~b} +} {~a/~b} test filename-7.12 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join ./~a b @@ -422,11 +422,11 @@ test filename-7.12 {Tcl_JoinPath: unix} {testsetplatform} { test filename-7.13 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join ./~a ~b -} {~b} +} {./~a/~b} test filename-7.14 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join ./~a ./~b -} {./~a/~b} +} {./~a/./~b} test filename-7.15 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join a . b @@ -434,7 +434,7 @@ test filename-7.15 {Tcl_JoinPath: unix} {testsetplatform} { test filename-7.16 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join a . ./~b -} {a/./~b} +} {a/././~b} test filename-7.17 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join //a b @@ -490,11 +490,11 @@ test filename-9.10 {Tcl_JoinPath: win} {testsetplatform} { test filename-9.11 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win file join ~ ./~foo -} {~/~foo} +} {~/./~foo} test filename-9.12 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win file join / ~foo -} {~foo} +} {/~foo} test filename-9.13 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win file join ./a/ b c @@ -600,7 +600,7 @@ test filename-10.6 {Tcl_TranslateFileName} -setup { testtranslatefilename ~/foo } -cleanup { set env(HOME) $temp -} -result {/home/test/foo} +} -result {~/foo} test filename-10.7 {Tcl_TranslateFileName} -setup { global env set temp $env(HOME) @@ -608,9 +608,9 @@ test filename-10.7 {Tcl_TranslateFileName} -setup { unset env(HOME) testsetplatform unix testtranslatefilename ~/foo -} -returnCodes error -cleanup { +} -cleanup { set env(HOME) $temp -} -result {couldn't find HOME environment variable to expand path} +} -result {~/foo} test filename-10.8 {Tcl_TranslateFileName} -setup { global env set temp $env(HOME) @@ -620,7 +620,7 @@ test filename-10.8 {Tcl_TranslateFileName} -setup { testtranslatefilename ~ } -cleanup { set env(HOME) $temp -} -result {/home/test} +} -result {~} test filename-10.9 {Tcl_TranslateFileName} -setup { global env set temp $env(HOME) @@ -630,7 +630,7 @@ test filename-10.9 {Tcl_TranslateFileName} -setup { testtranslatefilename ~ } -cleanup { set env(HOME) $temp -} -result {/home/test} +} -result {~} test filename-10.10 {Tcl_TranslateFileName} -setup { global env set temp $env(HOME) @@ -640,7 +640,7 @@ test filename-10.10 {Tcl_TranslateFileName} -setup { testtranslatefilename ~/foo } -cleanup { set env(HOME) $temp -} -result {/home/test/foo} +} -result {~/foo} test filename-10.17 {Tcl_TranslateFileName} -setup { global env set temp $env(HOME) @@ -650,7 +650,7 @@ test filename-10.17 {Tcl_TranslateFileName} -setup { testtranslatefilename ~/foo } -cleanup { set env(HOME) $temp -} -result {\home\foo} +} -result {~\foo} test filename-10.18 {Tcl_TranslateFileName} -setup { global env set temp $env(HOME) @@ -660,7 +660,7 @@ test filename-10.18 {Tcl_TranslateFileName} -setup { testtranslatefilename ~/foo\\bar } -cleanup { set env(HOME) $temp -} -result {\home\foo\bar} +} -result {~\foo\bar} test filename-10.19 {Tcl_TranslateFileName} -setup { global env set temp $env(HOME) @@ -670,11 +670,11 @@ test filename-10.19 {Tcl_TranslateFileName} -setup { testtranslatefilename ~/foo } -cleanup { set env(HOME) $temp -} -result {c:foo} -test filename-10.20 {Tcl_TranslateFileName} -returnCodes error -body { +} -result {~\foo} +test filename-10.20 {Tcl_TranslateFileName} -body { testtranslatefilename ~blorp/foo } -constraints {testtranslatefilename testtranslatefilename} \ - -result {user "blorp" doesn't exist} + -result {~blorp\foo} test filename-10.21 {Tcl_TranslateFileName} -setup { global env set temp $env(HOME) @@ -684,7 +684,7 @@ test filename-10.21 {Tcl_TranslateFileName} -setup { testtranslatefilename ~/foo } -cleanup { set env(HOME) $temp -} -result {c:\foo} +} -result {~\foo} test filename-10.22 {Tcl_TranslateFileName} -body { testsetplatform windows testtranslatefilename foo//bar @@ -701,9 +701,9 @@ test filename-10.24 {Tcl_TranslateFileName} -body { testtranslatefilename ~ouster/foo } -result {/home/ouster/foo} -constraints {nonPortable testtranslatefilename} -test filename-11.1 {Tcl_GlobCmd} -returnCodes error -body { +test filename-11.1 {Tcl_GlobCmd} -body { glob -} -result {no files matched glob patterns ""} +} -result {} test filename-11.2 {Tcl_GlobCmd} -returnCodes error -body { glob -gorp } -result {bad option "-gorp": must be -directory, -join, -nocomplain, -path, -tails, -types, or --} @@ -713,45 +713,46 @@ test filename-11.3 {Tcl_GlobCmd} -body { test filename-11.4 {Tcl_GlobCmd} -body { glob -nocomplain } -result {} -test filename-11.5 {Tcl_GlobCmd} -returnCodes error -body { - glob -nocomplain * ~xyqrszzz -} -result {user "xyqrszzz" doesn't exist} -test filename-11.6 {Tcl_GlobCmd} -returnCodes error -body { +test filename-11.5 {Tcl_GlobCmd} -body { + # Should not error out because of ~ + catch {glob -nocomplain * ~xyqrszzz} +} -result 0 +test filename-11.6 {Tcl_GlobCmd} -body { glob ~xyqrszzz -} -result {user "xyqrszzz" doesn't exist} -test filename-11.7 {Tcl_GlobCmd} -returnCodes error -body { +} -result {} +test filename-11.7 {Tcl_GlobCmd} -body { glob -- -nocomplain -} -result {no files matched glob pattern "-nocomplain"} +} -result {} test filename-11.8 {Tcl_GlobCmd} -body { glob -nocomplain -- -nocomplain } -result {} test filename-11.9 {Tcl_GlobCmd} -constraints {testsetplatform} -body { testsetplatform unix glob ~\\xyqrszzz/bar -} -returnCodes error -result {user "\xyqrszzz" doesn't exist} +} -result {} test filename-11.10 {Tcl_GlobCmd} -constraints {testsetplatform} -body { testsetplatform unix glob -nocomplain ~\\xyqrszzz/bar -} -returnCodes error -result {user "\xyqrszzz" doesn't exist} +} -result {} test filename-11.11 {Tcl_GlobCmd} -constraints {testsetplatform} -body { testsetplatform unix glob ~xyqrszzz\\/\\bar -} -returnCodes error -result {user "xyqrszzz" doesn't exist} +} -result {} test filename-11.12 {Tcl_GlobCmd} -constraints {testsetplatform} -setup { testsetplatform unix set home $env(HOME) } -body { unset env(HOME) glob ~/* -} -returnCodes error -cleanup { +} -cleanup { set env(HOME) $home -} -result {couldn't find HOME environment variable to expand path} +} -result {} if {[testConstraint testsetplatform]} { testsetplatform $platform } -test filename-11.13 {Tcl_GlobCmd} { +test filename-11.13 {Tcl_GlobCmd} -body { file join [lindex [glob ~] 0] -} [file join $env(HOME)] +} -result {} set oldpwd [pwd] set oldhome $env(HOME) catch {cd [makeDirectory tcl[pid]]} @@ -769,12 +770,12 @@ touch globTest/a1/b1/x2.c touch globTest/a1/b2/y2.c touch globTest/.1 touch globTest/x,z1.c -test filename-11.14 {Tcl_GlobCmd} { +test filename-11.14 {Tcl_GlobCmd} -body { glob ~/globTest -} [list [file join $env(HOME) globTest]] -test filename-11.15 {Tcl_GlobCmd} { +} -result {} +test filename-11.15 {Tcl_GlobCmd} -body { glob ~\\/globTest -} [list [file join $env(HOME) globTest]] +} -result {} test filename-11.16 {Tcl_GlobCmd} { glob globTest } {globTest} @@ -1097,42 +1098,42 @@ file delete -force $tildeglobname set globname globTest unset horribleglobname tildeglobname -test filename-12.1 {simple globbing} {unixOrWin} { +test filename-12.1 {simple globbing} -constraints {unixOrWin} -body { glob {} -} {.} +} -result {.} test filename-12.1.1 {simple globbing} -constraints {unixOrWin} -body { glob -types f {} -} -returnCodes error -result {no files matched glob pattern ""} -test filename-12.1.2 {simple globbing} {unixOrWin} { +} -result {} +test filename-12.1.2 {simple globbing} -constraints {unixOrWin} -body { glob -types d {} -} {.} -test filename-12.1.3 {simple globbing} {unix} { +} -result {.} +test filename-12.1.3 {simple globbing} -constraints {unix} -body { glob -types hidden {} -} {.} +} -result {.} test filename-12.1.4 {simple globbing} -constraints {win} -body { glob -types hidden {} -} -returnCodes error -result {no files matched glob pattern ""} +} -result {} test filename-12.1.5 {simple globbing} -constraints {win} -body { glob -types hidden c:/ -} -returnCodes error -result {no files matched glob pattern "c:/"} -test filename-12.1.6 {simple globbing} {win} { +} -result {} +test filename-12.1.6 {simple globbing} -constraints {win} -body { glob c:/ -} {c:/} -test filename-12.3 {simple globbing} { +} -result {c:/} +test filename-12.3 {simple globbing} -body { glob -nocomplain \{a1,a2\} -} {} +} -result {} set globPreResult globTest/ set x1 x1.c set y1 y1.c -test filename-12.4 {simple globbing} {unixOrWin} { +test filename-12.4 {simple globbing} -constraints {unixOrWin} -body { lsort [glob globTest/x1.c globTest/y1.c globTest/foo] -} "$globPreResult$x1 $globPreResult$y1" -test filename-12.5 {simple globbing} { +} -result "$globPreResult$x1 $globPreResult$y1" +test filename-12.5 {simple globbing} -body { glob globTest\\/x1.c -} "$globPreResult$x1" -test filename-12.6 {simple globbing} { +} -result "$globPreResult$x1" +test filename-12.6 {simple globbing} -body { glob globTest\\/\\x1.c -} "$globPreResult$x1" +} -result "$globPreResult$x1" test filename-12.7 {globbing at filesystem root} -constraints {unix} -body { list [glob -nocomplain /*] [glob -path / *] } -match compareWords -result equal @@ -1252,7 +1253,7 @@ test filename-14.17 {asterisks, question marks, and brackets} -setup { set temp $env(HOME) } -body { set env(HOME) [file join $env(HOME) globTest] - glob ~/z* + glob [file home]/z* } -cleanup { set env(HOME) $temp } -result [list [file join $env(HOME) globTest z1.c]] @@ -1264,10 +1265,10 @@ test filename-14.20 {asterisks, question marks, and brackets} { } {} test filename-14.21 {asterisks, question marks, and brackets} -body { glob globTest/*/gorp -} -returnCodes error -result {no files matched glob pattern "globTest/*/gorp"} +} -result {} test filename-14.22 {asterisks, question marks, and brackets} -body { glob goo/* x*z foo?q -} -returnCodes error -result {no files matched glob patterns "goo/* x*z foo?q"} +} -result {} test filename-14.23 {slash globbing} {unix} { glob / } / @@ -1349,11 +1350,10 @@ test filename-15.4 {unix specific no complain: no errors, good result} \ glob -nocomplain ~ouster ~foo ~welch } {/home/ouster /home/welch} test filename-15.4.1 {no complain: errors, sequencing} { - # test used to fail because if an error occurs, the interp's result is - # reset... But, the sequence means we throw a different error first. + # ~xxx no longer expanded so errors about unknown users should not occur list [catch {glob -nocomplain ~wontexist ~blahxyz ~} res1] $res1 \ [catch {glob -nocomplain ~ ~blahxyz ~wontexist} res2] $res2 -} {1 {user "wontexist" doesn't exist} 1 {user "blahxyz" doesn't exist}} +} {0 {} 0 {}} test filename-15.4.2 {no complain: errors, sequencing} -body { # test used to fail because if an error occurs, the interp's result is # reset... @@ -1363,20 +1363,12 @@ test filename-15.4.2 {no complain: errors, sequencing} -body { test filename-15.5 {unix specific globbing} {unix nonPortable} { glob ~ouster/.csh* } "/home/ouster/.cshrc" -touch globTest/odd\\\[\]*?\{\}name -test filename-15.6 {unix specific globbing} -constraints {unix} -setup { - global env - set temp $env(HOME) -} -body { - set env(HOME) $env(HOME)/globTest/odd\\\[\]*?\{\}name - glob ~ -} -cleanup { - set env(HOME) $temp -} -result [list [lindex [glob ~] 0]/globTest/odd\\\[\]*?\{\}name] -catch {file delete -force globTest/odd\\\[\]*?\{\}name} -test filename-15.7 {win specific globbing} -constraints {win} -body { +# 15.6 removed. It checked if glob ~ returned valid information if +# home directory contained glob chars. Since ~ expansion is no longer +# supported, the test was meaningless +test filename-15.7 {glob tilde} -body { glob ~ -} -match regexp -result {[^/]$} +} -result {} test filename-15.8 {win and unix specific globbing} -constraints {unixOrWin} -setup { global env set temp $env(HOME) @@ -1387,7 +1379,7 @@ test filename-15.8 {win and unix specific globbing} -constraints {unixOrWin} -se } -cleanup { set env(HOME) $temp catch {file delete -force $env(HOME)/globTest/anyname} -} -result [list [lindex [glob ~] 0]/globTest/anyname] +} -result {} # The following tests are only valid for Windows systems. set oldDir [pwd] @@ -1566,7 +1558,7 @@ test fileName-20.5 {Bug 2837800} -setup { test fileName-20.6 {Bug 2837800} -setup { # Recall that we have $env(HOME) set so that references # to ~ point to [temporaryDirectory] - makeFile {} test ~ + makeFile {} test [file home] set dd [makeDirectory isolate] set d [makeDirectory ./~ $dd] set savewd [pwd] @@ -1602,33 +1594,21 @@ test fileName-20.8 {Bug 2806250} -setup { removeFile ./~test $d removeDirectory isolate cd $savewd -} -result ./~test -test fileName-20.9 {globbing for special chars} -setup { - makeFile {} test ~ - set d [makeDirectory isolate] - set savewd [pwd] - cd $d -} -body { - glob -nocomplain -directory ~ test -} -cleanup { - cd $savewd - removeDirectory isolate - removeFile test ~ -} -result ~/test +} -result ~test test fileName-20.10 {globbing for special chars} -setup { - set s [makeDirectory sub ~] + set s [makeDirectory sub [file home]] makeFile {} fileName-20.10 $s set d [makeDirectory isolate] set savewd [pwd] cd $d } -body { - glob -nocomplain -directory ~ -join * fileName-20.10 + glob -nocomplain -directory [file home] -join * fileName-20.10 } -cleanup { cd $savewd removeDirectory isolate removeFile fileName-20.10 $s - removeDirectory sub ~ -} -result ~/sub/fileName-20.10 + removeDirectory sub [file home] +} -result [file home]/sub/fileName-20.10 # cleanup catch {file delete -force C:/globTest} diff --git a/tests/fileSystem.test b/tests/fileSystem.test index 2bbf981..5e98c39 100644 --- a/tests/fileSystem.test +++ b/tests/fileSystem.test @@ -267,15 +267,14 @@ file delete -force [file join dir.dir dirinside.link] removeFile [file join dir.dir inside.file] removeDirectory [file join dir.dir dirinside.dir] removeDirectory dir.dir -test filesystem-1.30 {normalisation of nonexistent user} -body { +test filesystem-1.30 { + normalisation of nonexistent user - verify no tilde expansion +} -body { file normalize ~noonewiththisname -} -returnCodes error -result {user "noonewiththisname" doesn't exist} +} -result [file join [pwd] ~noonewiththisname] test filesystem-1.30.1 {normalisation of existing user} -body { - catch {file normalize ~$::tcl_platform(user)} -} -result {0} -test filesystem-1.30.2 {normalisation of nonexistent user specified as user@domain} -body { - file normalize ~nonexistentuser@nonexistentdomain -} -returnCodes error -result {user "nonexistentuser@nonexistentdomain" doesn't exist} + file normalize ~$::tcl_platform(user) +} -result [file join [pwd] ~$::tcl_platform(user)] test filesystem-1.31 {link normalisation: link near filesystem root} {testsetplatform} { testsetplatform unix file normalize /foo/../bar @@ -473,7 +472,10 @@ test filesystem-4.3 {testfilesystem} -constraints testfilesystem -body { return $filesystemReport } -match glob -result {*{matchindirectory *}*} -test filesystem-5.1 {cache and ~} -constraints testfilesystem -setup { +# This test is meaningless if there is no tilde expansion +test filesystem-5.1 {cache and ~} -constraints { + testfilesystem tildeexpansion +} -setup { set orig $::env(HOME) } -body { set ::env(HOME) /foo/bar/blah @@ -939,7 +941,7 @@ test filesystem-9.7 {path objects and glob and file tail and tilde} -setup { cd [tcltest::temporaryDirectory] file delete -force tilde cd $origdir -} -result {0 1 {user "testNotExist" doesn't exist} ~testNotExist 0 1 {user "testNotExist" doesn't exist} 1 {user "testNotExist" doesn't exist}} +} -result {1 0 ~testNotExist ~testNotExist 1 0 ~testNotExist 0 ~testNotExist} test filesystem-9.8 {path objects and glob and file tail and tilde} -setup { set res {} set origdir [pwd] @@ -957,7 +959,7 @@ test filesystem-9.8 {path objects and glob and file tail and tilde} -setup { cd [tcltest::temporaryDirectory] file delete -force tilde cd $origdir -} -result {~testNotExist ~testNotExist 1 {user "testNotExist" doesn't exist} 1 {user "testNotExist" doesn't exist}} +} -result {~testNotExist ~testNotExist 0 ~testNotExist 0 ~testNotExist} test filesystem-9.9 {path objects and glob and file tail and tilde} -setup { set res {} set origdir [pwd] @@ -975,7 +977,7 @@ test filesystem-9.9 {path objects and glob and file tail and tilde} -setup { cd [tcltest::temporaryDirectory] file delete -force tilde cd $origdir -} -result {0 0 0 0 1} +} -result {0 1 0 1 1} # ---------------------------------------------------------------------- diff --git a/tests/format.test b/tests/format.test index c5053e8..c47774a 100644 --- a/tests/format.test +++ b/tests/format.test @@ -83,13 +83,13 @@ test format-1.12 {integer formatting} { } {101 0 0b101 10000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000} test format-1.13 {integer formatting} { format "%#0d %#0d %#0d %#0d %#0d" 0 6 34 16923 -12 -1 -} {0 0d6 0d34 0d16923 -0d12} +} {0 6 34 16923 -12} test format-1.14 {integer formatting} { format "%#05d %#020d %#020d %#020d %#020d" 0 6 34 16923 -12 -1 -} {00000 0d000000000000000006 0d000000000000000034 0d000000000000016923 -0d00000000000000012} +} {00000 00000000000000000006 00000000000000000034 00000000000000016923 -0000000000000000012} test format-1.15 {integer formatting} { format "%-#05d %-#020d %-#020d %-#020d %-#020d" 0 6 34 16923 -12 -1 -} {00000 0d000000000000000006 0d000000000000000034 0d000000000000016923 -0d00000000000000012} +} {00000 00000000000000000006 00000000000000000034 00000000000000016923 -0000000000000000012} test format-2.1 {string formatting} { diff --git a/tests/get.test b/tests/get.test index 079166e..eb26484 100644 --- a/tests/get.test +++ b/tests/get.test @@ -97,17 +97,17 @@ test get-3.2 {Tcl_GetDouble(FromObj), bad numbers} { } {0 1 0 1 1 {expected floating-point number but got "++1.0"} 1 {expected floating-point number but got "+-1.0"} 1 {expected floating-point number but got "-+1.0"} 0 -1 1 {expected floating-point number but got "--1.0"} 1 {expected floating-point number but got "- +1.0"}} # Bug 7114ac6141 test get-3.3 {tcl_GetInt with iffy numbers} testgetint { - lmap x {0 " 0" "0 " " 0 " " 0xa " " 007 " " 0o10 " " 0b10 "} { + lmap x {0 " 0" "0 " " 0 " " 0xa " " 010 " " 0o10 " " 0b10 "} { catch {testgetint 44 $x} x set x } -} {44 44 44 44 54 51 52 46} +} {44 44 44 44 54 54 52 46} test get-3.4 {Tcl_GetDouble with iffy numbers} testdoubleobj { - lmap x {0 0.0 " .0" ".0 " " 0e0 " "07" "- 0" "-0" "0o12" "0b10"} { + lmap x {0 0.0 " .0" ".0 " " 0e0 " "09" "- 0" "-0" "0o12" "0b10"} { catch {testdoubleobj set 1 $x} x set x } -} {0.0 0.0 0.0 0.0 0.0 7.0 {expected floating-point number but got "- 0"} 0.0 10.0 2.0} +} {0.0 0.0 0.0 0.0 0.0 9.0 {expected floating-point number but got "- 0"} 0.0 10.0 2.0} test get-3.5 {tcl_GetInt with numeric whitespace (i.e. '_')} testgetint { lmap x {0_0 " 1_0" "0_2 " " 3_3 " 14__23__32___4 " 0x_a " 0b1111_1111 " 0_07 " " 0o_1_0 " " 0b_1_0 " " 0_b1_0 " _33 42_ 0_x15 0_o17 0_d19 } { catch {testgetint $x} x diff --git a/tests/http.test b/tests/http.test index 587e6e4..3c2f4d8 100644 --- a/tests/http.test +++ b/tests/http.test @@ -15,7 +15,6 @@ if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } -source [file join [file dirname [info script]] tcltests.tcl] package require http 2.10 @@ -711,7 +710,7 @@ test http-7.3.$ThreadLevel {http::formatQuery} -setup { } -cleanup { http::config -urlencoding $enc } -result {unknown encoding ""} -test http-7.4.$ThreadLevel {http::formatQuery} -constraints deprecated -setup { +test http-7.4.$ThreadLevel {http::formatQuery} -setup { set enc [http::config -urlencoding] } -body { # this would be reverting to http <=2.4 behavior w/o errors @@ -721,7 +720,7 @@ test http-7.4.$ThreadLevel {http::formatQuery} -constraints deprecated -setup { http::mapReply "∈" } -cleanup { http::config -urlencoding $enc -} -result {%3F} +} -errorCode {TCL ENCODING ILLEGALSEQUENCE 0} -result {unexpected character at index 0: 'U+002208'} package require tcl::idna 1.0 diff --git a/tests/indexObj.test b/tests/indexObj.test index f10bd2a..26fb81e 100644 --- a/tests/indexObj.test +++ b/tests/indexObj.test @@ -184,7 +184,7 @@ test indexObj-8.4 {Tcl_GetIntForIndex INT_MAX} testgetintforindex { } 2147483647 test indexObj-8.5 {Tcl_GetIntForIndex INT_MAX+1} testgetintforindex { testgetintforindex 2147483648 0 -} 2147483647 +} 2147483648 test indexObj-8.6 {Tcl_GetIntForIndex end-1} testgetintforindex { testgetintforindex end-1 2147483646 } 2147483645 diff --git a/tests/info.test b/tests/info.test index ef41bdf..40a4746 100644 --- a/tests/info.test +++ b/tests/info.test @@ -20,9 +20,9 @@ if {{::tcltest} ni [namespace children]} { namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands -source [file join [file dirname [info script]] tcltests.tcl] catch [list package require -exact tcl::test [info patchlevel]] testConstraint zlib [llength [info commands zlib]] + # Set up namespaces needed to test operation of "info args", "info body", # "info default", and "info procs" with imported procedures. @@ -101,10 +101,10 @@ test info-2.5 {info body option, returning bytecompiled bodies} -body { # Fix for problem tested for in info-2.5 caused problems when # procedure body had no string rep (i.e. was not yet bytecode) # causing an empty string to be returned [Bug #545644] -test info-2.6 {info body option, returning list bodies} deprecated { +test info-2.6 {info body option, returning list bodies} { proc foo args [list subst bar] - list [string bytelength [info body foo]] \ - [foo; string bytelength [info body foo]] + list [string length [info body foo]] \ + [foo; string length [info body foo]] } {9 9} proc testinfocmdcount {} { diff --git a/tests/interp.test b/tests/interp.test index fa263e2..3aac4de 100644 --- a/tests/interp.test +++ b/tests/interp.test @@ -2414,21 +2414,21 @@ test interp-29.1.4 {interp recursionlimit argument checking} { interp delete moo list $result $msg } {1 {expected integer but got "bar"}} -test interp-29.1.5 {interp recursionlimit argument checking} { +test interp-29.1.5 {interp recursionlimit argument checking} -body { interp create moo set result [catch {interp recursionlimit moo 0} msg] interp delete moo list $result $msg -} {1 {recursion limit must be > 0}} -test interp-29.1.6 {interp recursionlimit argument checking} { +} -match glob -result {1 {recursion limit must be > 0 and < *}} +test interp-29.1.6 {interp recursionlimit argument checking} -body { interp create moo set result [catch {interp recursionlimit moo -1} msg] interp delete moo list $result $msg -} {1 {recursion limit must be > 0}} +} -match glob -result {1 {recursion limit must be > 0 and < *}} test interp-29.1.7 {interp recursionlimit argument checking} { interp create moo - set result [catch {interp recursionlimit moo [expr {wide(1)<<32}]} msg] + set result [catch {interp recursionlimit moo [expr {wide(1)<<64}]} msg] interp delete moo list $result [string range $msg 0 35] } {1 {integer value too large to represent}} @@ -2444,21 +2444,21 @@ test interp-29.1.9 {child recursionlimit argument checking} { interp delete moo list $result $msg } {1 {expected integer but got "foo"}} -test interp-29.1.10 {child recursionlimit argument checking} { +test interp-29.1.10 {child recursionlimit argument checking} -body { interp create moo set result [catch {moo recursionlimit 0} msg] interp delete moo list $result $msg -} {1 {recursion limit must be > 0}} -test interp-29.1.11 {child recursionlimit argument checking} { +} -match glob -result {1 {recursion limit must be > 0 and < *}} +test interp-29.1.11 {child recursionlimit argument checking} -body { interp create moo set result [catch {moo recursionlimit -1} msg] interp delete moo list $result $msg -} {1 {recursion limit must be > 0}} +} -match glob -result {1 {recursion limit must be > 0 and < *}} test interp-29.1.12 {child recursionlimit argument checking} { interp create moo - set result [catch {moo recursionlimit [expr {wide(1)<<32}]} msg] + set result [catch {moo recursionlimit [expr {wide(1)<<64}]} msg] interp delete moo list $result [string range $msg 0 35] } {1 {integer value too large to represent}} diff --git a/tests/io.test b/tests/io.test index c58bbce..9dd37f3 100644 --- a/tests/io.test +++ b/tests/io.test @@ -13,12 +13,12 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -namespace eval ::tcl::test::io { +if {"::tcltest" ni [namespace children]} { + package require tcltest 2.5 +} - if {"::tcltest" ni [namespace children]} { - package require tcltest 2.5 - namespace import -force ::tcltest::* - } +namespace eval ::tcl::test::io { + namespace import ::tcltest::* variable umaskValue variable path @@ -77,7 +77,7 @@ set path(cat) [makeFile { if {$argv != ""} { set f [open [lindex $argv 0]] } - fconfigure $f -encoding binary -translation lf -blocking 0 -eofchar "\x1A \x1A" + fconfigure $f -encoding binary -translation lf -blocking 0 -eofchar \x1A fconfigure stdout -encoding binary -translation lf -buffering none fileevent $f readable "foo $f" proc foo {f} { @@ -517,7 +517,7 @@ test io-6.8 {Tcl_GetsObj: remember if EOF is seen} { puts $f "abcdef\x1Aghijk\nwombat" close $f set f [open $path(test1)] - fconfigure $f -eofchar "\x1A \x1A" + fconfigure $f -eofchar \x1A set x [list [gets $f line] $line [gets $f line] $line] close $f set x @@ -527,7 +527,7 @@ test io-6.9 {Tcl_GetsObj: remember if EOF is seen} { puts $f "abcdefghijk\nwom\x1Abat" close $f set f [open $path(test1)] - fconfigure $f -eofchar "\x1A \x1A" + fconfigure $f -eofchar \x1A set x [list [gets $f line] $line [gets $f line] $line] close $f set x @@ -1036,7 +1036,7 @@ test io-6.52 {Tcl_GetsObj: saw EOF character} {testchannel} { puts -nonewline $f "123456\x1Ak9012345\r" close $f set f [open $path(test1)] - fconfigure $f -eofchar "\x1A \x1A" + fconfigure $f -eofchar \x1A set x [list [gets $f] [testchannel queuedcr $f] [tell $f] [gets $f]] close $f set x @@ -2093,13 +2093,13 @@ test io-20.2 {Tcl_CreateChannel: initial settings} {win} { set x [list [fconfigure $f -eofchar] [fconfigure $f -translation]] close $f set x -} [list [list \x1A ""] {auto crlf}] +} {{} {auto crlf}} test io-20.3 {Tcl_CreateChannel: initial settings} {unix} { set f [open $path(test1) w+] set x [list [fconfigure $f -eofchar] [fconfigure $f -translation]] close $f set x -} {{{} {}} {auto lf}} +} {{} {auto lf}} set path(stdout) [makeFile {} stdout] test io-20.5 {Tcl_CreateChannel: install channel in empty slot} stdio { set f [open $path(script) w] @@ -3382,7 +3382,7 @@ test io-30.16 {Tcl_Write ^Z at end, Tcl_Read auto} { puts -nonewline $f hello\nthere\nand\rhere\n\x1A close $f set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar "\x1A \x1A" + fconfigure $f -translation auto -eofchar \x1A set c [read $f] close $f set c @@ -3394,11 +3394,11 @@ here test io-30.17 {Tcl_Write, implicit ^Z at end, Tcl_Read auto} {win} { file delete $path(test1) set f [open $path(test1) w] - fconfigure $f -translation lf -eofchar "\x1A \x1A" + fconfigure $f -translation lf -eofchar \x1A puts $f hello\nthere\nand\rhere close $f set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar "\x1A \x1A" + fconfigure $f -translation auto -eofchar \x1A set c [read $f] close $f set c @@ -3415,7 +3415,7 @@ test io-30.18 {Tcl_Write, ^Z in middle, Tcl_Read auto} { puts $f $s close $f set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar "\x1A \x1A" + fconfigure $f -translation auto -eofchar \x1A set l "" lappend l [gets $f] lappend l [gets $f] @@ -3435,7 +3435,7 @@ test io-30.19 {Tcl_Write, ^Z no newline in middle, Tcl_Read auto} { puts $f $s close $f set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar "\x1A \x1A" + fconfigure $f -translation auto -eofchar \x1A set l "" lappend l [gets $f] lappend l [gets $f] @@ -3513,7 +3513,7 @@ test io-30.23 {Tcl_Write lf, ^Z in middle, Tcl_Read auto} { puts $f $c close $f set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar "\x1A \x1A" + fconfigure $f -translation auto -eofchar \x1A set c [string length [read $f]] set e [eof $f] close $f @@ -3527,7 +3527,7 @@ test io-30.24 {Tcl_Write lf, ^Z in middle, Tcl_Read lf} { puts $f $c close $f set f [open $path(test1) r] - fconfigure $f -translation lf -eofchar "\x1A \x1A" + fconfigure $f -translation lf -eofchar \x1A set c [string length [read $f]] set e [eof $f] close $f @@ -3541,7 +3541,7 @@ test io-30.25 {Tcl_Write cr, ^Z in middle, Tcl_Read auto} { puts $f $c close $f set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar "\x1A \x1A" + fconfigure $f -translation auto -eofchar \x1A set c [string length [read $f]] set e [eof $f] close $f @@ -3555,7 +3555,7 @@ test io-30.26 {Tcl_Write cr, ^Z in middle, Tcl_Read cr} { puts $f $c close $f set f [open $path(test1) r] - fconfigure $f -translation cr -eofchar "\x1A \x1A" + fconfigure $f -translation cr -eofchar \x1A set c [string length [read $f]] set e [eof $f] close $f @@ -3569,7 +3569,7 @@ test io-30.27 {Tcl_Write crlf, ^Z in middle, Tcl_Read auto} { puts $f $c close $f set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar "\x1A \x1A" + fconfigure $f -translation auto -eofchar \x1A set c [string length [read $f]] set e [eof $f] close $f @@ -3583,7 +3583,7 @@ test io-30.28 {Tcl_Write crlf, ^Z in middle, Tcl_Read crlf} { puts $f $c close $f set f [open $path(test1) r] - fconfigure $f -translation crlf -eofchar "\x1A \x1A" + fconfigure $f -translation crlf -eofchar \x1A set c [string length [read $f]] set e [eof $f] close $f @@ -3916,7 +3916,7 @@ test io-31.18 {Tcl_Write ^Z at end, Tcl_Gets auto} { puts $f $s close $f set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar "\x1A \x1A" + fconfigure $f -translation auto -eofchar \x1A set l "" lappend l [gets $f] lappend l [gets $f] @@ -3931,11 +3931,11 @@ test io-31.18 {Tcl_Write ^Z at end, Tcl_Gets auto} { test io-31.19 {Tcl_Write, implicit ^Z at end, Tcl_Gets auto} { file delete $path(test1) set f [open $path(test1) w] - fconfigure $f -translation lf -eofchar "\x1A \x1A" + fconfigure $f -translation lf -eofchar \x1A puts $f hello\nthere\nand\rhere close $f set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar "\x1A \x1A" + fconfigure $f -translation auto -eofchar \x1A set l "" lappend l [gets $f] lappend l [gets $f] @@ -3955,7 +3955,7 @@ test io-31.20 {Tcl_Write, ^Z in middle, Tcl_Gets auto, eofChar} { puts $f $s close $f set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar "\x1A \x1A" + fconfigure $f -translation auto -eofchar \x1A set l "" lappend l [gets $f] lappend l [gets $f] @@ -3973,7 +3973,7 @@ test io-31.21 {Tcl_Write, no newline ^Z in middle, Tcl_Gets auto, eofChar} { puts $f $s close $f set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar "\x1A \x1A" + fconfigure $f -translation auto -eofchar \x1A set l "" lappend l [gets $f] lappend l [gets $f] @@ -4057,7 +4057,7 @@ test io-31.25 {Tcl_Write lf, ^Z in middle, Tcl_Gets auto} { puts $f $s close $f set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar "\x1A \x1A" + fconfigure $f -translation auto -eofchar \x1A set l "" lappend l [gets $f] lappend l [gets $f] @@ -4075,7 +4075,7 @@ test io-31.26 {Tcl_Write lf, ^Z in middle, Tcl_Gets lf} { puts $f $s close $f set f [open $path(test1) r] - fconfigure $f -translation lf -eofchar "\x1A \x1A" + fconfigure $f -translation lf -eofchar \x1A set l "" lappend l [gets $f] lappend l [gets $f] @@ -4093,7 +4093,7 @@ test io-31.27 {Tcl_Write cr, ^Z in middle, Tcl_Gets auto} { puts $f $s close $f set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar "\x1A \x1A" + fconfigure $f -translation auto -eofchar \x1A set l "" lappend l [gets $f] lappend l [gets $f] @@ -4111,7 +4111,7 @@ test io-31.28 {Tcl_Write cr, ^Z in middle, Tcl_Gets cr} { puts $f $s close $f set f [open $path(test1) r] - fconfigure $f -translation cr -eofchar "\x1A \x1A" + fconfigure $f -translation cr -eofchar \x1A set l "" lappend l [gets $f] lappend l [gets $f] @@ -4129,7 +4129,7 @@ test io-31.29 {Tcl_Write crlf, ^Z in middle, Tcl_Gets auto} { puts $f $s close $f set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar "\x1A \x1A" + fconfigure $f -translation auto -eofchar \x1A set l "" lappend l [gets $f] lappend l [gets $f] @@ -4147,7 +4147,7 @@ test io-31.30 {Tcl_Write crlf, ^Z in middle, Tcl_Gets crlf} { puts $f $s close $f set f [open $path(test1) r] - fconfigure $f -translation crlf -eofchar "\x1A \x1A" + fconfigure $f -translation crlf -eofchar \x1A set l "" lappend l [gets $f] lappend l [gets $f] @@ -5028,87 +5028,87 @@ test io-35.5 {Tcl_Eof, eof detection on nonblocking pipe} stdio { test io-35.6 {Tcl_Eof, eof char, lf write, auto read} { file delete $path(test1) set f [open $path(test1) w] - fconfigure $f -translation lf -eofchar "\x1A \x1A" + fconfigure $f -translation lf -eofchar \x1A puts $f abc\ndef close $f set s [file size $path(test1)] set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar "\x1A \x1A" + fconfigure $f -translation auto -eofchar \x1A set l [string length [read $f]] set e [eof $f] close $f list $s $l $e -} {9 8 1} +} {8 8 1} test io-35.7 {Tcl_Eof, eof char, lf write, lf read} { file delete $path(test1) set f [open $path(test1) w] - fconfigure $f -translation lf -eofchar "\x1A \x1A" + fconfigure $f -translation lf -eofchar \x1A puts $f abc\ndef close $f set s [file size $path(test1)] set f [open $path(test1) r] - fconfigure $f -translation lf -eofchar "\x1A \x1A" + fconfigure $f -translation lf -eofchar \x1A set l [string length [read $f]] set e [eof $f] close $f list $s $l $e -} {9 8 1} +} {8 8 1} test io-35.8 {Tcl_Eof, eof char, cr write, auto read} { file delete $path(test1) set f [open $path(test1) w] - fconfigure $f -translation cr -eofchar "\x1A \x1A" + fconfigure $f -translation cr -eofchar \x1A puts $f abc\ndef close $f set s [file size $path(test1)] set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar "\x1A \x1A" + fconfigure $f -translation auto -eofchar \x1A set l [string length [read $f]] set e [eof $f] close $f list $s $l $e -} {9 8 1} +} {8 8 1} test io-35.9 {Tcl_Eof, eof char, cr write, cr read} { file delete $path(test1) set f [open $path(test1) w] - fconfigure $f -translation cr -eofchar "\x1A \x1A" + fconfigure $f -translation cr -eofchar \x1A puts $f abc\ndef close $f set s [file size $path(test1)] set f [open $path(test1) r] - fconfigure $f -translation cr -eofchar "\x1A \x1A" + fconfigure $f -translation cr -eofchar \x1A set l [string length [read $f]] set e [eof $f] close $f list $s $l $e -} {9 8 1} +} {8 8 1} test io-35.10 {Tcl_Eof, eof char, crlf write, auto read} { file delete $path(test1) set f [open $path(test1) w] - fconfigure $f -translation crlf -eofchar "\x1A \x1A" + fconfigure $f -translation crlf -eofchar \x1A puts $f abc\ndef close $f set s [file size $path(test1)] set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar "\x1A \x1A" + fconfigure $f -translation auto -eofchar \x1A set l [string length [read $f]] set e [eof $f] close $f list $s $l $e -} {11 8 1} +} {10 8 1} test io-35.11 {Tcl_Eof, eof char, crlf write, crlf read} { file delete $path(test1) set f [open $path(test1) w] - fconfigure $f -translation crlf -eofchar "\x1A \x1A" + fconfigure $f -translation crlf -eofchar \x1A puts $f abc\ndef close $f set s [file size $path(test1)] set f [open $path(test1) r] - fconfigure $f -translation crlf -eofchar "\x1A \x1A" + fconfigure $f -translation crlf -eofchar \x1A set l [string length [read $f]] set e [eof $f] close $f list $s $l $e -} {11 8 1} +} {10 8 1} test io-35.12 {Tcl_Eof, eof char in middle, lf write, auto read} { file delete $path(test1) set f [open $path(test1) w] @@ -5118,7 +5118,7 @@ test io-35.12 {Tcl_Eof, eof char in middle, lf write, auto read} { close $f set c [file size $path(test1)] set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar "\x1A \x1A" + fconfigure $f -translation auto -eofchar \x1A set l [string length [read $f]] set e [eof $f] close $f @@ -5133,7 +5133,7 @@ test io-35.13 {Tcl_Eof, eof char in middle, lf write, lf read} { close $f set c [file size $path(test1)] set f [open $path(test1) r] - fconfigure $f -translation lf -eofchar "\x1A \x1A" + fconfigure $f -translation lf -eofchar \x1A set l [string length [read $f]] set e [eof $f] close $f @@ -5148,7 +5148,7 @@ test io-35.14 {Tcl_Eof, eof char in middle, cr write, auto read} { close $f set c [file size $path(test1)] set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar "\x1A \x1A" + fconfigure $f -translation auto -eofchar \x1A set l [string length [read $f]] set e [eof $f] close $f @@ -5163,7 +5163,7 @@ test io-35.15 {Tcl_Eof, eof char in middle, cr write, cr read} { close $f set c [file size $path(test1)] set f [open $path(test1) r] - fconfigure $f -translation cr -eofchar "\x1A \x1A" + fconfigure $f -translation cr -eofchar \x1A set l [string length [read $f]] set e [eof $f] close $f @@ -5178,7 +5178,7 @@ test io-35.16 {Tcl_Eof, eof char in middle, crlf write, auto read} { close $f set c [file size $path(test1)] set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar "\x1A \x1A" + fconfigure $f -translation auto -eofchar \x1A set l [string length [read $f]] set e [eof $f] close $f @@ -5193,7 +5193,7 @@ test io-35.17 {Tcl_Eof, eof char in middle, crlf write, crlf read} { close $f set c [file size $path(test1)] set f [open $path(test1) r] - fconfigure $f -translation crlf -eofchar "\x1A \x1A" + fconfigure $f -translation crlf -eofchar \x1A set l [string length [read $f]] set e [eof $f] close $f @@ -5216,31 +5216,31 @@ test io-35.18 {Tcl_Eof, eof char, cr write, crlf read} -body { test io-35.18a {Tcl_Eof, eof char, cr write, crlf read} -body { file delete $path(test1) set f [open $path(test1) w] - fconfigure $f -translation cr -eofchar "\x1A \x1A" + fconfigure $f -translation cr -eofchar \x1A puts $f abc\ndef close $f set s [file size $path(test1)] set f [open $path(test1) r] - fconfigure $f -translation crlf -eofchar "\x1A \x1A" + fconfigure $f -translation crlf -eofchar \x1A set l [string length [set in [read $f]]] set e [eof $f] close $f list $s $l $e [scan [string index $in end] %c] -} -result {9 8 1 13} +} -result {8 8 1 13} test io-35.18b {Tcl_Eof, eof char, cr write, crlf read} -body { file delete $path(test1) set f [open $path(test1) w] - fconfigure $f -translation cr -eofchar "\x1A \x1A" + fconfigure $f -translation cr -eofchar \x1A puts $f {} close $f set s [file size $path(test1)] set f [open $path(test1) r] - fconfigure $f -translation crlf -eofchar "\x1A \x1A" + fconfigure $f -translation crlf -eofchar \x1A set l [string length [set in [read $f]]] set e [eof $f] close $f list $s $l $e [scan [string index $in end] %c] -} -result {2 1 1 13} +} -result {1 1 1 13} test io-35.18c {Tcl_Eof, eof char, cr write, crlf read} -body { file delete $path(test1) set f [open $path(test1) w] @@ -5264,7 +5264,7 @@ test io-35.19 {Tcl_Eof, eof char in middle, cr write, crlf read} -body { close $f set c [file size $path(test1)] set f [open $path(test1) r] - fconfigure $f -translation crlf -eofchar "\x1A \x1A" + fconfigure $f -translation crlf -eofchar \x1A set l [string length [set in [read $f]]] set e [eof $f] close $f @@ -5279,7 +5279,7 @@ test io-35.20 {Tcl_Eof, eof char in middle, cr write, crlf read} { close $f set c [file size $path(test1)] set f [open $path(test1) r] - fconfigure $f -translation crlf -eofchar "\x1A \x1A" + fconfigure $f -translation crlf -eofchar \x1A set l [string length [set in [read $f]]] set e [eof $f] close $f @@ -5756,30 +5756,30 @@ test io-39.21 {Tcl_SetChannelOption, setting read mode independently} \ close $s2 set modes } {auto crlf} -test io-39.22 {Tcl_SetChannelOption, invariance} {unix} { +test io-39.22 {Tcl_SetChannelOption, invariance} {unix deprecated} { file delete $path(test1) set f1 [open $path(test1) w+] set l "" lappend l [fconfigure $f1 -eofchar] - fconfigure $f1 -eofchar {ON GO} + fconfigure $f1 -eofchar {O {}} lappend l [fconfigure $f1 -eofchar] - fconfigure $f1 -eofchar {D D} + fconfigure $f1 -eofchar D lappend l [fconfigure $f1 -eofchar] close $f1 set l -} {{{} {}} {O G} {D D}} -test io-39.22a {Tcl_SetChannelOption, invariance} { +} {{} O D} +test io-39.22a {Tcl_SetChannelOption, invariance} deprecated { file delete $path(test1) set f1 [open $path(test1) w+] set l [list] - fconfigure $f1 -eofchar {ON GO} + fconfigure $f1 -eofchar {O {}} lappend l [fconfigure $f1 -eofchar] - fconfigure $f1 -eofchar {D D} + fconfigure $f1 -eofchar D lappend l [fconfigure $f1 -eofchar] lappend l [list [catch {fconfigure $f1 -eofchar {1 2 3}} msg] $msg] close $f1 set l -} {{O G} {D D} {1 {bad value for -eofchar: should be a list of zero, one, or two elements}}} +} {O D {1 {bad value for -eofchar: must be non-NUL ASCII character}}} test io-39.23 {Tcl_GetChannelOption, server socket is not readable or writeable, it should still have valid -eofchar and -translation options } { set l [list] @@ -5787,7 +5787,7 @@ test io-39.23 {Tcl_GetChannelOption, server socket is not readable or lappend l [fconfigure $sock -eofchar] [fconfigure $sock -translation] close $sock set l -} {{{}} auto} +} {{} auto} test io-39.24 {Tcl_SetChannelOption, server socket is not readable or writable so we can't change -eofchar or -translation } { set l [list] @@ -5796,7 +5796,7 @@ test io-39.24 {Tcl_SetChannelOption, server socket is not readable or lappend l [fconfigure $sock -eofchar] [fconfigure $sock -translation] close $sock set l -} {{{}} auto} +} {{} auto} test io-40.1 {POSIX open access modes: RDWR} { file delete $path(test3) @@ -5965,7 +5965,7 @@ test io-40.17 {tilde substitution in open} { set x [list [catch {open ~/foo} msg] $msg] set ::env(HOME) $home set x -} {1 {couldn't find HOME environment variable to expand path}} +} {1 {couldn't open "~/foo": no such file or directory}} test io-41.1 {Tcl_FileeventCmd: errors} {fileevent} { list [catch {fileevent foo} msg] $msg @@ -6539,7 +6539,7 @@ test io-48.4 {lf write, testing readability, ^Z termination, auto read mode} {fi set c 0 set l "" set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar "\x1A \x1A" + fconfigure $f -translation auto -eofchar \x1A fileevent $f readable [namespace code [list consume $f]] variable x vwait [namespace which -variable x] @@ -6567,7 +6567,7 @@ test io-48.5 {lf write, testing readability, ^Z in middle, auto read mode} {file set c 0 set l "" set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar "\x1A \x1A" + fconfigure $f -translation auto -eofchar \x1A fileevent $f readable [namespace code [list consume $f]] variable x vwait [namespace which -variable x] @@ -6595,7 +6595,7 @@ test io-48.6 {cr write, testing readability, ^Z termination, auto read mode} {fi set c 0 set l "" set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar "\x1A \x1A" + fconfigure $f -translation auto -eofchar \x1A fileevent $f readable [namespace code [list consume $f]] variable x vwait [namespace which -variable x] @@ -6623,7 +6623,7 @@ test io-48.7 {cr write, testing readability, ^Z in middle, auto read mode} {file set c 0 set l "" set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar "\x1A \x1A" + fconfigure $f -translation auto -eofchar \x1A fileevent $f readable [namespace code [list consume $f]] variable x vwait [namespace which -variable x] @@ -6651,7 +6651,7 @@ test io-48.8 {crlf write, testing readability, ^Z termination, auto read mode} { set c 0 set l "" set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar "\x1A \x1A" + fconfigure $f -translation auto -eofchar \x1A fileevent $f readable [namespace code [list consume $f]] variable x vwait [namespace which -variable x] @@ -6679,7 +6679,7 @@ test io-48.9 {crlf write, testing readability, ^Z in middle, auto read mode} {fi set c 0 set l "" set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar "\x1A \x1A" + fconfigure $f -translation auto -eofchar \x1A fileevent $f readable [namespace code [list consume $f]] variable x vwait [namespace which -variable x] @@ -6707,7 +6707,7 @@ test io-48.10 {lf write, testing readability, ^Z in middle, lf read mode} {filee set c 0 set l "" set f [open $path(test1) r] - fconfigure $f -translation lf -eofchar "\x1A \x1A" + fconfigure $f -translation lf -eofchar \x1A fileevent $f readable [namespace code [list consume $f]] variable x vwait [namespace which -variable x] @@ -6735,7 +6735,7 @@ test io-48.11 {lf write, testing readability, ^Z termination, lf read mode} {fil set c 0 set l "" set f [open $path(test1) r] - fconfigure $f -translation lf -eofchar "\x1A \x1A" + fconfigure $f -translation lf -eofchar \x1A fileevent $f readable [namespace code [list consume $f]] variable x vwait [namespace which -variable x] @@ -6763,7 +6763,7 @@ test io-48.12 {cr write, testing readability, ^Z in middle, cr read mode} {filee set c 0 set l "" set f [open $path(test1) r] - fconfigure $f -translation cr -eofchar "\x1A \x1A" + fconfigure $f -translation cr -eofchar \x1A fileevent $f readable [namespace code [list consume $f]] variable x vwait [namespace which -variable x] @@ -6791,7 +6791,7 @@ test io-48.13 {cr write, testing readability, ^Z termination, cr read mode} {fil set c 0 set l "" set f [open $path(test1) r] - fconfigure $f -translation cr -eofchar "\x1A \x1A" + fconfigure $f -translation cr -eofchar \x1A fileevent $f readable [namespace code [list consume $f]] variable x vwait [namespace which -variable x] @@ -6819,7 +6819,7 @@ test io-48.14 {crlf write, testing readability, ^Z in middle, crlf read mode} {f set c 0 set l "" set f [open $path(test1) r] - fconfigure $f -translation crlf -eofchar "\x1A \x1A" + fconfigure $f -translation crlf -eofchar \x1A fileevent $f readable [namespace code [list consume $f]] variable x vwait [namespace which -variable x] @@ -6847,7 +6847,7 @@ test io-48.15 {crlf write, testing readability, ^Z termi, crlf read mode} {filee set c 0 set l "" set f [open $path(test1) r] - fconfigure $f -translation crlf -eofchar "\x1A \x1A" + fconfigure $f -translation crlf -eofchar \x1A fileevent $f readable [namespace code [list consume $f]] variable x vwait [namespace which -variable x] @@ -8952,10 +8952,7 @@ test io-74.1 {[104f2885bb] improper cache validity check} -setup { removeFile io-74.1 } -returnCodes error -match glob -result {can not find channel named "*"} -# The following tests 75.1 to 75.5 exercise strict or tolerant channel -# encoding. -# TCL 8.7 only offers tolerant channel encoding, what is tested here. -test io-75.1 {multibyte encoding error read results in raw bytes} -constraints deprecated -setup { +test io-75.1 {multibyte encoding error read results in raw bytes (-nocomplainencoding 1)} -setup { set fn [makeFile {} io-75.1] set f [open $fn w+] fconfigure $f -encoding binary @@ -8964,7 +8961,7 @@ test io-75.1 {multibyte encoding error read results in raw bytes} -constraints d puts -nonewline $f "A\xC0\x40" flush $f seek $f 0 - fconfigure $f -encoding utf-8 -buffering none + fconfigure $f -encoding utf-8 -nocomplainencoding 1 -buffering none } -body { set d [read $f] binary scan $d H* hd @@ -8974,10 +8971,10 @@ test io-75.1 {multibyte encoding error read results in raw bytes} -constraints d removeFile io-75.1 } -result "41c040" -test io-75.2 {unrepresentable character write passes and is replaced by ?} -constraints deprecated -setup { +test io-75.2 {unrepresentable character write passes and is replaced by ? (-nocomplainencoding 1)} -setup { set fn [makeFile {} io-75.2] set f [open $fn w+] - fconfigure $f -encoding iso8859-1 + fconfigure $f -encoding iso8859-1 -nocomplainencoding 1 } -body { puts -nonewline $f "A\u2022" flush $f @@ -8991,14 +8988,14 @@ test io-75.2 {unrepresentable character write passes and is replaced by ?} -cons # Incomplete sequence test. # This error may IMHO only be detected with the close. # But the read already returns the incomplete sequence. -test io-75.3 {incomplete multibyte encoding read is ignored} -setup { +test io-75.3 {incomplete multibyte encoding read is ignored (-nocomplainencoding 1)} -setup { set fn [makeFile {} io-75.3] set f [open $fn w+] fconfigure $f -encoding binary puts -nonewline $f "A\xC0" flush $f seek $f 0 - fconfigure $f -encoding utf-8 -buffering none + fconfigure $f -encoding utf-8 -buffering none -nocomplainencoding 1 } -body { set d [read $f] close $f @@ -9010,7 +9007,7 @@ test io-75.3 {incomplete multibyte encoding read is ignored} -setup { # As utf-8 has a special treatment in multi-byte decoding, also test another # one. -test io-75.4 {shiftjis encoding error read results in raw bytes} -setup { +test io-75.4 {shiftjis encoding error read results in raw bytes (-nocomplainencoding 1)} -setup { set fn [makeFile {} io-75.4] set f [open $fn w+] fconfigure $f -encoding binary @@ -9019,8 +9016,8 @@ test io-75.4 {shiftjis encoding error read results in raw bytes} -setup { puts -nonewline $f "A\x81\xFFA" flush $f seek $f 0 - fconfigure $f -encoding shiftjis -buffering none -eofchar "" -translation lf -} -constraints deprecated -body { + fconfigure $f -encoding shiftjis -buffering none -eofchar "" -translation lf -nocomplainencoding 1 +} -body { set d [read $f] binary scan $d H* hd set hd @@ -9029,14 +9026,15 @@ test io-75.4 {shiftjis encoding error read results in raw bytes} -setup { removeFile io-75.4 } -result "4181ff41" -test io-75.5 {invalid utf-8 encoding read is ignored} -setup { +test io-75.5 {incomplete shiftjis encoding read is ignored (-nocomplainencoding 1)} -setup { set fn [makeFile {} io-75.5] set f [open $fn w+] fconfigure $f -encoding binary + # \x81 announces a two byte sequence. puts -nonewline $f "A\x81" flush $f seek $f 0 - fconfigure $f -encoding utf-8 -buffering none -eofchar "" -translation lf + fconfigure $f -encoding utf-8 -buffering none -eofchar "" -translation lf -nocomplainencoding 1 } -body { set d [read $f] close $f @@ -9046,7 +9044,103 @@ test io-75.5 {invalid utf-8 encoding read is ignored} -setup { removeFile io-75.5 } -result "4181" -test io-75.6 {invalid utf-8 encoding read is not ignored (-strictencoding 1)} -setup { +test io-75.6 {multibyte encoding error read results in raw bytes} -setup { + set fn [makeFile {} io-75.6] + set f [open $fn w+] + fconfigure $f -encoding binary + # In UTF-8, a byte 0xCx starts a multibyte sequence and must be followed + # by a byte > 0x7F. This is violated to get an invalid sequence. + puts -nonewline $f "A\xC0\x40" + flush $f + seek $f 0 + fconfigure $f -encoding utf-8 -buffering none -strict 1 +} -body { + set d [read $f] + binary scan $d H* hd + set hd +} -cleanup { + close $f + removeFile io-75.6 +} -result "41" +# The current result cuts at the invalid sequence. IMHO, there should be an +# error thrown or the whole sequence should be returned as byte (compat mode). + +test io-75.7 {unrepresentable character write passes and is replaced by ?} -setup { + set fn [makeFile {} io-75.7] + set f [open $fn w+] + fconfigure $f -encoding iso8859-1 +} -body { + catch {puts -nonewline $f "A\u2022"} msg + flush $f + seek $f 0 + list [read $f] $msg +} -cleanup { + close $f + removeFile io-75.7 +} -match glob -result [list {A} {error writing "*": illegal byte sequence}] + +# Incomplete sequence test. +# This error may IMHO only be detected with the close. +# But the read already returns the incomplete sequence. +test io-75.8 {incomplete multibyte encoding read is ignored} -setup { + set fn [makeFile {} io-75.8] + set f [open $fn w+] + fconfigure $f -encoding binary + puts -nonewline $f "A\xC0" + flush $f + seek $f 0 + fconfigure $f -encoding utf-8 -buffering none +} -body { + set d [read $f] + close $f + binary scan $d H* hd + set hd +} -cleanup { + removeFile io-75.8 +} -result "41c0" +# The current result returns the orphan byte as byte. +# This may be expected due to special utf-8 handling. + +# As utf-8 has a special treatment in multi-byte decoding, also test another +# one. +test io-75.9 {shiftjis encoding error read results in raw bytes} -setup { + set fn [makeFile {} io-75.9] + set f [open $fn w+] + fconfigure $f -encoding binary + # In shiftjis, \x81 starts a two-byte sequence. + # But 2nd byte \xFF is not allowed + puts -nonewline $f "A\x81\xFFA" + flush $f + seek $f 0 + fconfigure $f -encoding shiftjis -buffering none -eofchar "" -translation lf +} -body { + set d [read $f] + binary scan $d H* hd + set hd +} -cleanup { + close $f + removeFile io-75.9 +} -result "41" +# The current result cuts at the invalid sequence. IMHO, there should be an +# error thrown or the whole sequence should be returned as byte (compat mode). + +test io-75.10 {invalid utf-8 encoding read is ignored} -setup { + set fn [makeFile {} io-75.5] + set f [open $fn w+] + fconfigure $f -encoding binary + puts -nonewline $f "A\x81" + flush $f + seek $f 0 + fconfigure $f -encoding utf-8 -buffering none -eofchar "" -translation lf +} -body { + set d [read $f] + close $f + binary scan $d H* hd + set hd +} -cleanup { + removeFile io-75.10 +} -result "4181" +test io-75.11 {invalid utf-8 encoding read is not ignored (-strictencoding 1)} -setup { set fn [makeFile {} io-75.6] set f [open $fn w+] fconfigure $f -encoding binary diff --git a/tests/ioCmd.test b/tests/ioCmd.test index c4edd25..50cdcf5 100644 --- a/tests/ioCmd.test +++ b/tests/ioCmd.test @@ -240,33 +240,33 @@ test iocmd-8.7 {fconfigure command} -setup { file delete $path(test1) } -body { set f1 [open $path(test1) w] - fconfigure $f1 -translation lf -eofchar {} -encoding utf-16 -nocomplainencoding 1 + fconfigure $f1 -translation lf -eofchar {} -encoding utf-16 fconfigure $f1 } -cleanup { catch {close $f1} -} -result {-blocking 1 -buffering full -buffersize 4096 -encoding utf-16 -eofchar {} -nocomplainencoding 1 -strictencoding 0 -translation lf} +} -result {-blocking 1 -buffering full -buffersize 4096 -encoding utf-16 -eofchar {} -nocomplainencoding 0 -strictencoding 0 -translation lf} test iocmd-8.8 {fconfigure command} -setup { file delete $path(test1) set x {} } -body { set f1 [open $path(test1) w] fconfigure $f1 -translation lf -buffering line -buffersize 3030 \ - -eofchar {} -encoding utf-16 -nocomplainencoding 1 + -eofchar {} -encoding utf-16 lappend x [fconfigure $f1 -buffering] lappend x [fconfigure $f1] } -cleanup { catch {close $f1} -} -result {line {-blocking 1 -buffering line -buffersize 3030 -encoding utf-16 -eofchar {} -nocomplainencoding 1 -strictencoding 0 -translation lf}} +} -result {line {-blocking 1 -buffering line -buffersize 3030 -encoding utf-16 -eofchar {} -nocomplainencoding 0 -strictencoding 0 -translation lf}} test iocmd-8.9 {fconfigure command} -setup { file delete $path(test1) } -body { set f1 [open $path(test1) w] fconfigure $f1 -translation binary -buffering none -buffersize 4040 \ - -eofchar {} -encoding binary -nocomplainencoding 1 + -eofchar {} -encoding binary fconfigure $f1 } -cleanup { catch {close $f1} -} -result {-blocking 1 -buffering none -buffersize 4040 -encoding binary -eofchar {} -nocomplainencoding 1 -strictencoding 0 -translation lf} +} -result {-blocking 1 -buffering none -buffersize 4040 -encoding binary -eofchar {} -nocomplainencoding 0 -strictencoding 0 -translation lf} test iocmd-8.10 {fconfigure command} -returnCodes error -body { fconfigure a b } -result {can not find channel named "a"} @@ -368,15 +368,6 @@ test iocmd-8.20 {fconfigure command / win console channel} -constraints {nonPort } -returnCodes error -result [expectedOpts "-blah" {-inputmode}] # TODO: Test parsing of serial channel options (nonPortable, since requires an # open channel to work with). -test iocmd-8.21 {fconfigure command / -nocomplainencoding 0 error} -constraints { - deprecated -} -setup { - # I don't know how else to open the console, but this is non-portable - set console stdin -} -body { - fconfigure $console -nocomplainencoding 0 -} -returnCodes error -result "bad value for -nocomplainencoding: only true allowed" - test iocmd-9.1 {eof command} { list [catch {eof} msg] $msg $::errorCode @@ -500,9 +491,15 @@ test iocmd-12.10 {POSIX open access modes: BINARY} { close $f set result } 5 -test iocmd-12.11 {POSIX open access modes: BINARY} { +test iocmd-12.11 {POSIX open access modes: BINARY} -body { + set f [open $path(test1) {WRONLY BINARY TRUNC}] + puts $f Ɉ ;# throws an exception +} -cleanup { + close $f +} -returnCodes 1 -match glob -result {error writing "*": illegal byte sequence} +test iocmd-12.12 {POSIX open access modes: BINARY} { set f [open $path(test1) {WRONLY BINARY TRUNC}] - puts $f Ɉ ;# gets truncated to H + puts $f H close $f set f [open $path(test1) r] fconfigure $f -translation binary @@ -1371,7 +1368,7 @@ test iocmd-25.1 {chan configure, cgetall, standard options} -match glob -body { close $c rename foo {} set res -} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -nocomplainencoding * -strictencoding 0 -translation {auto *}}} +} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {} -nocomplainencoding 0 -strictencoding 0 -translation {auto *}}} test iocmd-25.2 {chan configure, cgetall, no options} -match glob -body { set res {} proc foo {args} {oninit cget cgetall; onfinal; track; return ""} @@ -1380,7 +1377,7 @@ test iocmd-25.2 {chan configure, cgetall, no options} -match glob -body { close $c rename foo {} set res -} -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -nocomplainencoding * -strictencoding 0 -translation {auto *}}} +} -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {} -nocomplainencoding 0 -strictencoding 0 -translation {auto *}}} test iocmd-25.3 {chan configure, cgetall, regular result} -match glob -body { set res {} proc foo {args} { @@ -1392,7 +1389,7 @@ test iocmd-25.3 {chan configure, cgetall, regular result} -match glob -body { close $c rename foo {} set res -} -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -nocomplainencoding * -strictencoding 0 -translation {auto *} -bar foo -snarf x}} +} -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {} -nocomplainencoding 0 -strictencoding 0 -translation {auto *} -bar foo -snarf x}} test iocmd-25.4 {chan configure, cgetall, bad result, list of uneven length} -match glob -body { set res {} proc foo {args} { @@ -2913,7 +2910,7 @@ test iocmd.tf-25.1 {chan configure, cgetall, standard options} -match glob -body rename foo {} set res } -constraints {testchannel thread} \ - -result {{-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} * -translation {auto *}}} + -result {{-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {} * -translation {auto *}}} test iocmd.tf-25.2 {chan configure, cgetall, no options} -match glob -body { set res {} proc foo {args} {oninit cget cgetall; onfinal; track; return ""} @@ -2926,7 +2923,7 @@ test iocmd.tf-25.2 {chan configure, cgetall, no options} -match glob -body { rename foo {} set res } -constraints {testchannel thread} \ - -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} * -translation {auto *}}} + -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {} * -translation {auto *}}} test iocmd.tf-25.3 {chan configure, cgetall, regular result} -match glob -body { set res {} proc foo {args} { @@ -2942,7 +2939,7 @@ test iocmd.tf-25.3 {chan configure, cgetall, regular result} -match glob -body { rename foo {} set res } -constraints {testchannel thread} \ - -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} * -translation {auto *} -bar foo -snarf x}} + -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {} * -translation {auto *} -bar foo -snarf x}} test iocmd.tf-25.4 {chan configure, cgetall, bad result, list of uneven length} -match glob -body { set res {} proc foo {args} { diff --git a/tests/lindex.test b/tests/lindex.test index ffe0d9e..17a9ed2 100644 --- a/tests/lindex.test +++ b/tests/lindex.test @@ -70,11 +70,11 @@ test lindex-3.4 {integer 3} -constraints testevalex -body { test lindex-3.5 {bad octal} -constraints testevalex -body { set x 0o8 list [catch { testevalex {lindex {a b c} $x} } result] $result -} -match glob -result {1 {*invalid octal number*}} +} -match glob -result {1 {*}} test lindex-3.6 {bad octal} -constraints testevalex -body { set x -0o9 list [catch { testevalex {lindex {a b c} $x} } result] $result -} -match glob -result {1 {*invalid octal number*}} +} -match glob -result {1 {*}} test lindex-3.7 {indexes don't shimmer wide ints} -body { set x [expr {(wide(1)<<31) - 2}] list $x [lindex {1 2 3} $x] [incr x] [incr x] @@ -114,11 +114,11 @@ test lindex-4.5 {index = end-3} testevalex { test lindex-4.6 {bad octal} -constraints testevalex -body { set x end-0o8 list [catch { testevalex {lindex {a b c} $x} } result] $result -} -match glob -result {1 {*invalid octal number*}} +} -match glob -result {1 {*}} test lindex-4.7 {bad octal} -constraints testevalex -body { set x end--0o9 list [catch { testevalex {lindex {a b c} $x} } result] $result -} -match glob -result {1 {*invalid octal number*}} +} -match glob -result {1 {*}} test lindex-4.8 {bad integer, not octal} testevalex { set x end-0a2 list [catch { testevalex {lindex {a b c} $x} } result] $result @@ -274,11 +274,11 @@ test lindex-11.4 {integer 3} { test lindex-11.5 {bad octal} -body { set x 0o8 list [catch { lindex {a b c} $x } result] $result -} -match glob -result {1 {*invalid octal number*}} +} -match glob -result {1 {*}} test lindex-11.6 {bad octal} -body { set x -0o9 list [catch { lindex {a b c} $x } result] $result -} -match glob -result {1 {*invalid octal number*}} +} -match glob -result {1 {*}} # Indices relative to end @@ -320,11 +320,11 @@ test lindex-12.5 {index = end-3} { test lindex-12.6 {bad octal} -body { set x end-0o8 list [catch { lindex {a b c} $x } result] $result -} -match glob -result {1 {*invalid octal number*}} +} -match glob -result {1 {*}} test lindex-12.7 {bad octal} -body { set x end--0o9 list [catch { lindex {a b c} $x } result] $result -} -match glob -result {1 {*invalid octal number*}} +} -match glob -result {1 {*}} test lindex-12.8 {bad integer, not octal} { set x end-0a2 list [catch { lindex {a b c} $x } result] $result diff --git a/tests/listObj.test b/tests/listObj.test index 0f43648..c360fbb 100644 --- a/tests/listObj.test +++ b/tests/listObj.test @@ -206,6 +206,16 @@ test listobj-10.3 {Tcl_ListObjReplace with negative count value} testobj { testlistobj replace 1 1 -1 f testlistobj get 1 } {a f b c d e} +test listobj-10.4 {Tcl_ListObjReplace with UINT_MAX-1 count value} testobj { + testlistobj set 1 a b c d e + testlistobj replace 1 1 0xFFFFFFFE f + testlistobj get 1 +} {a f} +test listobj-10.5 {Tcl_ListObjReplace with SIZE_MAX-1 count value} testobj { + testlistobj set 1 a b c d e + testlistobj replace 1 1 -2 f + testlistobj get 1 +} {a f} test listobj-11.1 {Bug 3598580: Tcl_ListObjReplace refcount management} testobj { testobj bug3598580 diff --git a/tests/load.test b/tests/load.test index 005c451..77a6dec 100644 --- a/tests/load.test +++ b/tests/load.test @@ -25,7 +25,7 @@ if {![info exists ext]} { } # Tests require the existence of one of the DLLs in the dltest directory. set testDir [file join [file dirname [info nameofexecutable]] dltest] -set x [file join $testDir pkga$ext] +set x [file join $testDir tcl9pkga$ext] set dll "[file tail $x]Required" testConstraint $dll [file readable $x] @@ -72,29 +72,29 @@ test load-1.8 {basic errors} -returnCodes error -body { test load-2.1 {basic loading, with guess for package name} \ [list $dll $loaded] { - load -global [file join $testDir pkga$ext] + load -global [file join $testDir tcl9pkga$ext] list [pkga_eq abc def] [lsort [info commands pkga_*]] } {0 {pkga_eq pkga_quote}} interp create -safe child test load-2.2 {loading into a safe interpreter, with package name conversion} \ [list $dll $loaded] { - load -lazy [file join $testDir pkgb$ext] Pkgb child + load -lazy [file join $testDir tcl9pkgb$ext] Pkgb child list [child eval pkgb_sub 44 13] [catch {child eval pkgb_unsafe} msg] $msg \ [catch {pkgb_sub 12 10} msg2] $msg2 } {31 1 {invalid command name "pkgb_unsafe"} 1 {invalid command name "pkgb_sub"}} test load-2.3 {loading with no _Init procedure} -constraints [list $dll $loaded] \ -body { - list [catch {load [file join $testDir pkgc$ext] foo} msg] $msg $errorCode + list [catch {load [file join $testDir tcl9pkgc$ext] Foo} msg] $msg $errorCode } -match glob \ -result [list 1 {cannot find symbol "Foo_Init"*} \ {TCL LOOKUP LOAD_SYMBOL *Foo_Init}] test load-2.4 {loading with no _SafeInit procedure} [list $dll $loaded] { - list [catch {load [file join $testDir pkga$ext] {} child} msg] $msg + list [catch {load [file join $testDir tcl9pkga$ext] {} child} msg] $msg } {1 {can't use library in a safe interpreter: no Pkga_SafeInit procedure}} test load-3.1 {error in _Init procedure, same interpreter} \ [list $dll $loaded] { - list [catch {load [file join $testDir pkge$ext] pkge} msg] \ + list [catch {load [file join $testDir tcl9pkge$ext] Pkge} msg] \ $msg $::errorInfo $::errorCode } {1 {couldn't open "non_existent": no such file or directory} {couldn't open "non_existent": no such file or directory while executing @@ -102,14 +102,14 @@ test load-3.1 {error in _Init procedure, same interpreter} \ invoked from within "if 44 {open non_existent}" invoked from within -"load [file join $testDir pkge$ext] pkge"} {POSIX ENOENT {no such file or directory}}} +"load [file join $testDir tcl9pkge$ext] Pkge"} {POSIX ENOENT {no such file or directory}}} test load-3.2 {error in _Init procedure, child interpreter} \ [list $dll $loaded] { catch {interp delete x} interp create x set ::errorCode foo set ::errorInfo bar - set result [list [catch {load [file join $testDir pkge$ext] pkge x} msg] \ + set result [list [catch {load [file join $testDir tcl9pkge$ext] Pkge x} msg] \ $msg $::errorInfo $::errorCode] interp delete x set result @@ -119,27 +119,27 @@ test load-3.2 {error in _Init procedure, child interpreter} \ invoked from within "if 44 {open non_existent}" invoked from within -"load [file join $testDir pkge$ext] pkge x"} {POSIX ENOENT {no such file or directory}}} +"load [file join $testDir tcl9pkge$ext] Pkge x"} {POSIX ENOENT {no such file or directory}}} test load-4.1 {reloading package into same interpreter} [list $dll $loaded] { - list [catch {load [file join $testDir pkga$ext] pkga} msg] $msg + list [catch {load [file join $testDir tcl9pkga$ext] Pkga} msg] $msg } {0 {}} test load-4.2 {reloading package into same interpreter} -setup { - catch {load [file join $testDir pkga$ext] Pkga} + catch {load [file join $testDir tcl9pkga$ext] Pkga} } -constraints [list $dll $loaded] -returnCodes error -body { - load [file join $testDir pkga$ext] Pkgb -} -result "file \"[file join $testDir pkga$ext]\" is already loaded for prefix \"Pkga\"" + load [file join $testDir tcl9pkga$ext] Pkgb +} -result "file \"[file join $testDir tcl9pkga$ext]\" is already loaded for prefix \"Pkga\"" test load-5.1 {file name not specified and no static package: pick default} -setup { catch {interp delete x} interp create x } -constraints [list $dll $loaded] -body { - load -global [file join $testDir pkga$ext] Pkga + load -global [file join $testDir tcl9pkga$ext] Pkga load {} Pkga x info loaded x } -cleanup { interp delete x -} -result [list [list [file join $testDir pkga$ext] Pkga]] +} -result [list [list [file join $testDir tcl9pkga$ext] Pkga]] # On some platforms, like SunOS 4.1.3, these tests can't be run because # they cause the process to exit. @@ -153,8 +153,8 @@ test load-6.1 {errors loading file} [list $dll $loaded] { test load-7.1 {Tcl_StaticLibrary procedure} [list teststaticlibrary] { set x "not loaded" teststaticlibrary Test 1 0 - load {} test - load {} test child + load {} Test + load {} Test child list [set x] [child eval set x] } {loaded loaded} test load-7.2 {Tcl_StaticLibrary procedure} [list teststaticlibrary] { @@ -168,13 +168,13 @@ test load-7.2 {Tcl_StaticLibrary procedure} [list teststaticlibrary] { test load-7.3 {Tcl_StaticLibrary procedure} [list teststaticlibrary] { set x "not loaded" teststaticlibrary More 0 1 - load {} more + load {} More set x } {not loaded} -catch {load [file join $testDir pkga$ext] Pkga} -catch {load [file join $testDir pkgb$ext] Pkgb} -catch {load [file join $testDir pkge$ext] Pkge} -set currentRealLibraries [list [list [file join $testDir pkge$ext] Pkge] [list [file join $testDir pkgb$ext] Pkgb] [list [file join $testDir pkga$ext] Pkga]] +catch {load [file join $testDir tcl9pkga$ext] Pkga} +catch {load [file join $testDir tcl9pkgb$ext] Pkgb} +catch {load [file join $testDir tcl9pkge$ext] Pkge} +set currentRealLibraries [list [list [file join $testDir tcl9pkge$ext] Pkge] [list [file join $testDir tcl9pkgb$ext] Pkgb] [list [file join $testDir tcl9pkga$ext] Pkga]] test load-7.4 {Tcl_StaticLibrary procedure, redundant calls} -setup { teststaticlibrary Test 1 0 teststaticlibrary Another 0 0 @@ -204,14 +204,14 @@ test load-8.2 {TclGetLoadedLibraries procedure} -constraints {teststaticlibrary_ } -returnCodes error -result {could not find interpreter "gorp"} test load-8.3a {TclGetLoadedLibraries procedure} [list teststaticlibrary_8.x $dll $loaded] { lsort -index 1 [info loaded {}] -} [lsort -index 1 [list {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkga$ext] Pkga] [list [file join $testDir pkgb$ext] Pkgb] {*}$alreadyLoaded]] +} [lsort -index 1 [list {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir tcl9pkga$ext] Pkga] [list [file join $testDir tcl9pkgb$ext] Pkgb] {*}$alreadyLoaded]] test load-8.3b {TclGetLoadedLibraries procedure} [list teststaticlibrary_8.x $dll $loaded] { lsort -index 1 [info loaded child] -} [lsort -index 1 [list {{} Test} [list [file join $testDir pkgb$ext] Pkgb]]] +} [lsort -index 1 [list {{} Test} [list [file join $testDir tcl9pkgb$ext] Pkgb]]] test load-8.4 {TclGetLoadedLibraries procedure} [list teststaticlibrary_8.x $dll $loaded] { - load [file join $testDir pkgb$ext] Pkgb + load [file join $testDir tcl9pkgb$ext] Pkgb list [lsort -index 1 [info loaded {}]] [lsort [info commands pkgb_*]] -} [list [lsort -index 1 [concat [list [list [file join $testDir pkgb$ext] Pkgb] {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkga$ext] Pkga]] $alreadyLoaded]] {pkgb_demo pkgb_sub pkgb_unsafe}] +} [list [lsort -index 1 [concat [list [list [file join $testDir tcl9pkgb$ext] Pkgb] {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir tcl9pkga$ext] Pkga]] $alreadyLoaded]] {pkgb_demo pkgb_sub pkgb_unsafe}] interp delete child test load-9.1 {Tcl_StaticLibrary, load already-loaded package into another interp} -setup { @@ -234,7 +234,7 @@ test load-10.1 {load from vfs} -setup { cd $testDir testsimplefilesystem 1 } -constraints [list $dll $loaded testsimplefilesystem] -body { - list [catch {load simplefs:/pkgd$ext Pkgd} msg] $msg + list [catch {load simplefs:/tcl9pkgd$ext Pkgd} msg] $msg } -result {0 {}} -cleanup { testsimplefilesystem 0 cd $dir @@ -243,7 +243,7 @@ test load-10.1 {load from vfs} -setup { test load-11.1 {Load TclOO extension using Stubs (Bug [f51efe99a7])} \ [list $dll $loaded] { - load [file join $testDir pkgooa$ext] + load [file join $testDir tcl9pkgooa$ext] list [pkgooa_stubsok] [lsort [info commands pkgooa_*]] } {1 pkgooa_stubsok} diff --git a/tests/lrepeat.test b/tests/lrepeat.test index c1c8b02..6734281 100644 --- a/tests/lrepeat.test +++ b/tests/lrepeat.test @@ -61,7 +61,7 @@ test lrepeat-1.7 {Accept zero repetitions (TIP 323)} { } -result {} } -test lrepeat-1.8 {Do not build enormous lists - Bug 2130992} -body { +test lrepeat-1.8 {Do not build enormous lists - Bug 2130992} -constraints knownBug -body { lrepeat 0x10000000 a b c d e f g h } -returnCodes error -match glob -result * diff --git a/tests/lseq.test b/tests/lseq.test index b8ae2e9..3f68da4 100644 --- a/tests/lseq.test +++ b/tests/lseq.test @@ -499,8 +499,7 @@ test lseq-4.4 {lseq corner case} -body { eval $tcmd } -cleanup { unset res -} -result {0 10 1 {max length of a Tcl list exceeded} 1 {max length of a Tcl list exceeded} 0 10 0 2147483638} - +} -result {0 10 0 10 0 9223372036854774991 0 10 0 2147483638} # Ticket 99e834bf33 - lseq, lindex end off by one @@ -542,6 +541,13 @@ test lseq-4.9 {error case lrange} -body { } -returnCodes 1 \ -result {index 7 is out of bounds 0 to 4} +# Panic when using variable value? +test lseq-4.10 {panic using variable index} { + set i 0 + lindex [lseq 10] $i +} {0} + + # cleanup ::tcltest::cleanupTests diff --git a/tests/main.test b/tests/main.test index 4aadd79..2703dc1 100644 --- a/tests/main.test +++ b/tests/main.test @@ -606,7 +606,7 @@ namespace eval ::tcl::test::main { catch {set f [open "|[list [interpreter]]" w+]} catch {chan configure $f -blocking 0} } -body { - type $f "chan configure stdin -eofchar \"\\x1A {}\" + type $f "chan configure stdin -eofchar \\x1A if 1 \{\n\x1A" variable wait chan event $f readable \ diff --git a/tests/mathop.test b/tests/mathop.test index 13a0543..6b56c8b 100644 --- a/tests/mathop.test +++ b/tests/mathop.test @@ -126,10 +126,10 @@ namespace eval ::testmathop { } -result {can't use non-numeric floating-point value "nan" as operand of "+"} test mathop-1.15 {compiled +: errors} -returnCodes error -body { + 0o8 0 - } -result {can't use invalid octal number "0o8" as operand of "+"} + } -result {can't use non-numeric string "0o8" as operand of "+"} test mathop-1.16 {compiled +: errors} -returnCodes error -body { + 0 0o8 - } -result {can't use invalid octal number "0o8" as operand of "+"} + } -result {can't use non-numeric string "0o8" as operand of "+"} test mathop-1.17 {compiled +: errors} -returnCodes error -body { + 0 [error expectedError] } -result expectedError @@ -164,10 +164,10 @@ namespace eval ::testmathop { } -result {can't use non-numeric floating-point value "nan" as operand of "+"} test mathop-1.33 {interpreted +: errors} -returnCodes error -body { $op 0o8 0 - } -result {can't use invalid octal number "0o8" as operand of "+"} + } -result {can't use non-numeric string "0o8" as operand of "+"} test mathop-1.34 {interpreted +: errors} -returnCodes error -body { $op 0 0o8 - } -result {can't use invalid octal number "0o8" as operand of "+"} + } -result {can't use non-numeric string "0o8" as operand of "+"} test mathop-1.35 {interpreted +: errors} -returnCodes error -body { $op 0 [error expectedError] } -result expectedError @@ -201,10 +201,10 @@ namespace eval ::testmathop { } -result {can't use non-numeric floating-point value "nan" as operand of "*"} test mathop-2.15 {compiled *: errors} -returnCodes error -body { * 0o8 0 - } -result {can't use invalid octal number "0o8" as operand of "*"} + } -result {can't use non-numeric string "0o8" as operand of "*"} test mathop-2.16 {compiled *: errors} -returnCodes error -body { * 0 0o8 - } -result {can't use invalid octal number "0o8" as operand of "*"} + } -result {can't use non-numeric string "0o8" as operand of "*"} test mathop-2.17 {compiled *: errors} -returnCodes error -body { * 0 [error expectedError] } -result expectedError @@ -239,10 +239,10 @@ namespace eval ::testmathop { } -result {can't use non-numeric floating-point value "nan" as operand of "*"} test mathop-2.33 {interpreted *: errors} -returnCodes error -body { $op 0o8 0 - } -result {can't use invalid octal number "0o8" as operand of "*"} + } -result {can't use non-numeric string "0o8" as operand of "*"} test mathop-2.34 {interpreted *: errors} -returnCodes error -body { $op 0 0o8 - } -result {can't use invalid octal number "0o8" as operand of "*"} + } -result {can't use non-numeric string "0o8" as operand of "*"} test mathop-2.35 {interpreted *: errors} -returnCodes error -body { $op 0 [error expectedError] } -result expectedError @@ -399,10 +399,10 @@ namespace eval ::testmathop { } -result {can't use non-numeric floating-point value "nan" as operand of "&"} test mathop-6.15 {compiled &: errors} -returnCodes error -body { & 0o8 0 - } -result {can't use invalid octal number "0o8" as operand of "&"} + } -result {can't use non-numeric string "0o8" as operand of "&"} test mathop-6.16 {compiled &: errors} -returnCodes error -body { & 0 0o8 - } -result {can't use invalid octal number "0o8" as operand of "&"} + } -result {can't use non-numeric string "0o8" as operand of "&"} test mathop-6.17 {compiled &: errors} -returnCodes error -body { & 0 [error expectedError] } -result expectedError @@ -441,10 +441,10 @@ namespace eval ::testmathop { } -result {can't use non-numeric floating-point value "nan" as operand of "&"} test mathop-6.33 {interpreted &: errors} -returnCodes error -body { $op 0o8 0 - } -result {can't use invalid octal number "0o8" as operand of "&"} + } -result {can't use non-numeric string "0o8" as operand of "&"} test mathop-6.34 {interpreted &: errors} -returnCodes error -body { $op 0 0o8 - } -result {can't use invalid octal number "0o8" as operand of "&"} + } -result {can't use non-numeric string "0o8" as operand of "&"} test mathop-6.35 {interpreted &: errors} -returnCodes error -body { $op 0 [error expectedError] } -result expectedError @@ -509,10 +509,10 @@ namespace eval ::testmathop { } -result {can't use non-numeric floating-point value "nan" as operand of "|"} test mathop-7.15 {compiled |: errors} -returnCodes error -body { | 0o8 0 - } -result {can't use invalid octal number "0o8" as operand of "|"} + } -result {can't use non-numeric string "0o8" as operand of "|"} test mathop-7.16 {compiled |: errors} -returnCodes error -body { | 0 0o8 - } -result {can't use invalid octal number "0o8" as operand of "|"} + } -result {can't use non-numeric string "0o8" as operand of "|"} test mathop-7.17 {compiled |: errors} -returnCodes error -body { | 0 [error expectedError] } -result expectedError @@ -551,10 +551,10 @@ namespace eval ::testmathop { } -result {can't use non-numeric floating-point value "nan" as operand of "|"} test mathop-7.33 {interpreted |: errors} -returnCodes error -body { $op 0o8 0 - } -result {can't use invalid octal number "0o8" as operand of "|"} + } -result {can't use non-numeric string "0o8" as operand of "|"} test mathop-7.34 {interpreted |: errors} -returnCodes error -body { $op 0 0o8 - } -result {can't use invalid octal number "0o8" as operand of "|"} + } -result {can't use non-numeric string "0o8" as operand of "|"} test mathop-7.35 {interpreted |: errors} -returnCodes error -body { $op 0 [error expectedError] } -result expectedError @@ -619,10 +619,10 @@ namespace eval ::testmathop { } -result {can't use non-numeric floating-point value "nan" as operand of "^"} test mathop-8.15 {compiled ^: errors} -returnCodes error -body { ^ 0o8 0 - } -result {can't use invalid octal number "0o8" as operand of "^"} + } -result {can't use non-numeric string "0o8" as operand of "^"} test mathop-8.16 {compiled ^: errors} -returnCodes error -body { ^ 0 0o8 - } -result {can't use invalid octal number "0o8" as operand of "^"} + } -result {can't use non-numeric string "0o8" as operand of "^"} test mathop-8.17 {compiled ^: errors} -returnCodes error -body { ^ 0 [error expectedError] } -result expectedError @@ -661,10 +661,10 @@ namespace eval ::testmathop { } -result {can't use non-numeric floating-point value "nan" as operand of "^"} test mathop-8.33 {interpreted ^: errors} -returnCodes error -body { $op 0o8 0 - } -result {can't use invalid octal number "0o8" as operand of "^"} + } -result {can't use non-numeric string "0o8" as operand of "^"} test mathop-8.34 {interpreted ^: errors} -returnCodes error -body { $op 0 0o8 - } -result {can't use invalid octal number "0o8" as operand of "^"} + } -result {can't use non-numeric string "0o8" as operand of "^"} test mathop-8.35 {interpreted ^: errors} -returnCodes error -body { $op 0 [error expectedError] } -result expectedError diff --git a/tests/namespace-old.test b/tests/namespace-old.test index 06eedfd..bf73e87 100644 --- a/tests/namespace-old.test +++ b/tests/namespace-old.test @@ -293,12 +293,13 @@ namespace eval test_ns_hier1 { namespace eval test_ns_hier2a {} namespace eval test_ns_hier2b {} } +# TIP 278: secondary lookup disabled for vars, tests disabled with # test namespace-old-5.4 {nested namespaces can access global namespace} { - list [namespace eval test_ns_hier1 {set test_ns_var_global}] \ + list [namespace eval test_ns_hier1 {#set test_ns_var_global}] \ [namespace eval test_ns_hier1 {test_ns_cmd_global}] \ - [namespace eval test_ns_hier1::test_ns_hier2 {set test_ns_var_global}] \ + [namespace eval test_ns_hier1::test_ns_hier2 {#set test_ns_var_global}] \ [namespace eval test_ns_hier1::test_ns_hier2 {test_ns_cmd_global}] -} {{var in ::} {cmd in ::} {var in ::} {cmd in ::}} +} {{} {cmd in ::} {} {cmd in ::}} test namespace-old-5.5 {variables in different namespaces don't conflict} { list [set test_ns_hier1::test_ns_level] \ [set test_ns_hier1::test_ns_hier2::test_ns_level] @@ -468,11 +469,12 @@ test namespace-old-6.11 {commands affect all parent namespaces} { } list [test_ns_cache1::trigger] [test_ns_cache1::test_ns_cache2::trigger] } {{cache2 version} {cache2 version}} +# TIP 278: secondary lookup disabled, catch added, result changed from {global version} test namespace-old-6.12 {define test variables} { variable test_ns_cache_var "global version" set trigger {set test_ns_cache_var} - namespace eval test_ns_cache1 $trigger -} {global version} + list [catch {namespace eval test_ns_cache1 $trigger} msg] $msg +} {1 {can't read "test_ns_cache_var": no such variable}} set trigger {set test_ns_cache_var} test namespace-old-6.13 {one-level check for variable shadowing} { namespace eval test_ns_cache1 { @@ -481,22 +483,24 @@ test namespace-old-6.13 {one-level check for variable shadowing} { namespace eval test_ns_cache1 $trigger } {cache1 version} variable ::test_ns_cache_var "global version" +# TIP 278: secondary lookup disabled, catch added, result changed from {global version} test namespace-old-6.14 {deleting variables changes variable epoch} { namespace eval test_ns_cache1 { variable test_ns_cache_var "cache1 version" } list [namespace eval test_ns_cache1 $trigger] \ [namespace eval test_ns_cache1 {unset test_ns_cache_var}] \ - [namespace eval test_ns_cache1 $trigger] -} {{cache1 version} {} {global version}} + [catch {namespace eval test_ns_cache1 $trigger}] +} {{cache1 version} {} 1} +# TIP 278: secondary lookup disabled, catch added, result changed test namespace-old-6.15 {define test namespaces} { namespace eval test_ns_cache2 { variable test_ns_cache_var "global cache2 version" } set trigger2 {set test_ns_cache2::test_ns_cache_var} - list [namespace eval test_ns_cache1 $trigger2] \ - [namespace eval test_ns_cache1::test_ns_cache2 $trigger] -} {{global cache2 version} {global version}} + catch {list [namespace eval test_ns_cache1 $trigger2] \ + [namespace eval test_ns_cache1::test_ns_cache2 $trigger]} +} 1 set trigger2 {set test_ns_cache2::test_ns_cache_var} test namespace-old-6.16 {public variables affect all parent namespaces} { variable test_ns_cache1::test_ns_cache2::test_ns_cache_var "cache2 version" diff --git a/tests/namespace.test b/tests/namespace.test index c98ad4a..ae233cb 100644 --- a/tests/namespace.test +++ b/tests/namespace.test @@ -48,9 +48,9 @@ test namespace-2.2 {Tcl_GetCurrentNamespace} { set l {} lappend l [namespace current] namespace eval test_ns_1 { - lappend l [namespace current] + lappend ::l [namespace current] namespace eval foo { - lappend l [namespace current] + lappend ::l [namespace current] } } lappend l [namespace current] @@ -710,6 +710,8 @@ test namespace-14.2 {TclGetNamespaceForQualName, invalid absolute names} -setup [catch {namespace children test_ns_777} msg] $msg } } -result {1 {can't read "::test_ns_777::v": no such variable} 1 {namespace "test_ns_777" not found in "::test_ns_1"}} + +# TIP 278: secondary lookup disabled, results changed from {10 20} test namespace-14.3 {TclGetNamespaceForQualName, relative names} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} variable v 10 @@ -721,9 +723,11 @@ test namespace-14.3 {TclGetNamespaceForQualName, relative names} -setup { } } -body { namespace eval test_ns_1 { - list $v $test_ns_2::v + # list $v $test_ns_2::v + list [catch {set v} msg] $msg [catch {set test_ns_2::v} msg] $msg } -} -result {10 20} +} -result {1 {can't read "v": no such variable} 0 20} + test namespace-14.4 {TclGetNamespaceForQualName, relative ns names looked up only in current ns} { namespace eval test_ns_1::test_ns_2 { namespace eval foo {} @@ -784,15 +788,17 @@ test namespace-14.11 {TclGetNamespaceForQualName, extra ::s are significant for proc test_ns_1::test_ns_2:: {args} {return "\{\}: $args"} lappend l [test_ns_1::test_ns_2:: hello] } -result {1 {invalid command name "test_ns_1::test_ns_2::"} {{}: hello}} + +# TIP 278: secondary lookup disabled, added catch, result changed from y test namespace-14.12 {TclGetNamespaceForQualName, extra ::s are significant for vars} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} } -body { namespace eval test_ns_1 { variable {} - set test_ns_1::(x) y + catch {set test_ns_1::(x) y} ::msg } - set test_ns_1::(x) -} -result y + list $::msg [catch {set test_ns_1::(x)} msg] $msg +} -result {{can't set "test_ns_1::(x)": parent namespace doesn't exist} 1 {can't read "test_ns_1::(x)": no such variable}} test namespace-14.13 {TclGetNamespaceForQualName, namespace other than global ns can't have empty name} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} } -returnCodes error -body { @@ -965,13 +971,15 @@ test namespace-17.6 {Tcl_FindNamespaceVar, relative name found} -setup { set x } } -result {777} + +# TIP 278: secondary lookup disabled, catch added, result changed from 314159 test namespace-17.7 {Tcl_FindNamespaceVar, relative name found} { namespace eval test_ns_1 { variable x 777 unset x - set x ;# must be global x now + list [catch {set x} msg] $msg ;# must not be global x now } -} {314159} +} {1 {can't read "x": no such variable}} test namespace-17.8 {Tcl_FindNamespaceVar, relative name not found} -body { namespace eval test_ns_1 { set wuzzat @@ -983,6 +991,8 @@ test namespace-17.9 {Tcl_FindNamespaceVar, relative name and TCL_GLOBAL_ONLY} { } set test_ns_1::a } {hello} + +# TIP 278: secondary lookup disabled, result changed from 1 test namespace-17.10 {Tcl_FindNamespaceVar, interference with cached varNames} -setup { namespace eval test_ns_1 {} } -body { @@ -996,7 +1006,7 @@ test namespace-17.10 {Tcl_FindNamespaceVar, interference with cached varNames} - namespace eval test_ns_1 set a 1 namespace delete test_ns_1 return $a -} -result 1 +} -result 0 catch {unset a} catch {unset x} @@ -1617,6 +1627,8 @@ test namespace-34.6 {NamespaceWhichCmd, -command is default} -setup { [namespace which ::test_ns_2::cmd2] } } -result {::foreach ::test_ns_3::p ::test_ns_3::cmd1 ::test_ns_2::cmd2} + +# TIP 278: secondary lookup disabled, catch added, result changed test namespace-34.7 {NamespaceWhichCmd, variable lookup} -setup { catch {namespace delete {*}[namespace children test_ns_*]} namespace eval test_ns_1 { @@ -1636,12 +1648,12 @@ test namespace-34.7 {NamespaceWhichCmd, variable lookup} -setup { } } -body { namespace eval test_ns_3 { - list [namespace which -variable env] \ + list [catch {namespace which -variable env } msg] $msg \ [namespace which -variable v3] \ [namespace which -variable ::test_ns_2::v2] \ [catch {namespace which -variable ::test_ns_2::noSuchVar} msg] $msg } -} -result {::env ::test_ns_3::v3 ::test_ns_2::v2 0 {}} +} -result {0 {} ::test_ns_3::v3 ::test_ns_2::v2 0 {}} test namespace-35.1 {FreeNsNameInternalRep, resulting ref count > 0} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} diff --git a/tests/obj.test b/tests/obj.test index 64a1d5b..eb85c84 100644 --- a/tests/obj.test +++ b/tests/obj.test @@ -19,16 +19,13 @@ if {"::tcltest" ni [namespace children]} { ::tcltest::loadTestedCommands catch [list package require -exact tcl::test [info patchlevel]] -source [file join [file dirname [info script]] tcltests.tcl] - testConstraint testobj [llength [info commands testobj]] testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}] testConstraint wideIs64bit [expr {wide(0x8000000000000000) < 0}] -test obj-1.1 {Tcl_AppendAllObjTypes, and InitTypeTable, Tcl_RegisterObjType} {testobj deprecated} { +test obj-1.1 {Tcl_AppendAllObjTypes, and InitTypeTable, Tcl_RegisterObjType} testobj { set r 1 foreach {t} { - bytearray bytecode cmdName dict @@ -48,10 +45,10 @@ test obj-2.2 {Tcl_GetObjType and Tcl_ConvertToType} testobj { set result "" lappend result [testobj freeallvars] lappend result [testintobj set 1 12] - lappend result [testobj convert 1 bytearray] + lappend result [testobj convert 1 string] lappend result [testobj type 1] lappend result [testobj refcount 1] -} {{} 12 12 bytearray 3} +} {{} 12 12 string 3} test obj-4.1 {Tcl_NewObj and AllocateFreeObjects} testobj { set result "" diff --git a/tests/parse.test b/tests/parse.test index b0c051b..517d577 100644 --- a/tests/parse.test +++ b/tests/parse.test @@ -376,12 +376,12 @@ test parse-8.8 {Tcl_EvalObjv procedure, async handlers} -constraints { return "new result" } set handler1 [testasync create async1] - set aresult xxx - set acode yyy + set ::aresult xxx + set ::acode yyy } -cleanup { testasync delete } -body { - list [testevalobjv 0 testasync mark $handler1 original 0] $acode $aresult + list [testevalobjv 0 testasync mark $handler1 original 0] $::acode $::aresult } -result {{new result} 0 original} test parse-8.9 {Tcl_EvalObjv procedure, exceptional return} testevalobjv { list [catch {testevalobjv 0 error message} msg] $msg @@ -601,8 +601,8 @@ test parse-12.6 {Tcl_ParseVarName procedure, braced variable name} testparser { testparser {${..[]b}cd} 0 } {- {${..[]b}cd} 1 word {${..[]b}cd} 3 variable {${..[]b}} 1 text {..[]b} 0 text cd 0 {}} test parse-12.7 {Tcl_ParseVarName procedure, braced variable name} testparser { - testparser "\$\{\{\} " 0 -} {- \$\{\{\}\ 1 word \$\{\{\} 2 variable \$\{\{\} 1 text \{ 0 {}} + testparser "\$\{\{\\\\\}\} " 0 +} {- {${{\\}} } 1 word {${{\\}}} 2 variable {${{\\}}} 1 text {{\\}} 0 {}} test parse-12.8 {Tcl_ParseVarName procedure, missing close brace} testparser { list [catch {testparser "$\{abc" 0} msg] $msg $::errorInfo } {1 {missing close-brace for variable name} missing\ close-brace\ for\ variable\ name\n\ \ \ \ (remainder\ of\ script:\ \"\{abc\")\n\ \ \ \ invoked\ from\ within\n\"testparser\ \"\$\\\{abc\"\ 0\"} @@ -797,7 +797,7 @@ test parse-15.16 {CommandComplete procedure} { } 1 test parse-15.17 {CommandComplete procedure} { info complete {a b "c $dd("} -} 0 +} 1 test parse-15.18 {CommandComplete procedure} { info complete {a b "c \"} } 0 diff --git a/tests/parseExpr.test b/tests/parseExpr.test index c70c5e3..b9245ce 100644 --- a/tests/parseExpr.test +++ b/tests/parseExpr.test @@ -919,8 +919,8 @@ test parseExpr-21.43 {error message} -body { in expression \"...8901234567890*\"foobar\$\{abcdefghijklmnopqrstuv...\"" test parseExpr-21.44 {error message} -body { expr {123456789012345678901234567890*"foo$bar(abcdefghijklmnopqrstuvwxyz"} -} -returnCodes error -result {missing ) -in expression "...8901234567890*"foo$bar(abcdefghijklmnopqrstuv..."} +} -returnCodes error -result {invalid character in array index +in expression "...8901234567890*"foo$bar(abcdefghijklmnopqrstu..."} test parseExpr-21.45 {error message} -body { expr {123456789012345678901234567890*"foo$bar([{}abcdefghijklmnopqrstuvwxyz])"} } -returnCodes error -result {extra characters after close-brace diff --git a/tests/pkgMkIndex.test b/tests/pkgMkIndex.test index 25840c6..390154a 100644 --- a/tests/pkgMkIndex.test +++ b/tests/pkgMkIndex.test @@ -553,7 +553,7 @@ removeFile [file join pkg circ3.tcl] # Some tests require the existence of one of the DLLs in the dltest directory set x [file join [file dirname [info nameofexecutable]] dltest \ - pkga[info sharedlibextension]] + tcl9pkga[info sharedlibextension]] set dll "[file tail $x]Required" testConstraint $dll [file exists $x] @@ -575,8 +575,8 @@ test pkgMkIndex-10.1 {package in DLL and script} [list exec $dll] { # it. set cmd [list pkg_mkIndex -lazy $fullPkgPath [file tail $x] pkga.tcl] exec [interpreter] << $cmd - pkgtest::runCreatedIndex {0 {}} -lazy $fullPkgPath pkga[info sharedlibextension] pkga.tcl -} "0 {{pkga:1.0 {tclPkgSetup {pkga[info sharedlibextension] load {pkga_eq pkga_quote}} {pkga.tcl source pkga_neq}}}}" + pkgtest::runCreatedIndex {0 {}} -lazy $fullPkgPath tcl9pkga[info sharedlibextension] pkga.tcl +} "0 {{pkga:1.0 {tclPkgSetup {tcl9pkga[info sharedlibextension] load {pkga_eq pkga_quote}} {pkga.tcl source pkga_neq}}}}" test pkgMkIndex-10.2 {package in DLL hidden by -load} [list exec $dll] { # Do all [load]ing of shared libraries in another process, so we can diff --git a/tests/regexp.test b/tests/regexp.test index 16c775e..b06c163 100644 --- a/tests/regexp.test +++ b/tests/regexp.test @@ -765,14 +765,14 @@ test regexp-19.2 {regsub null replacement} { string equal $result $expected } 1 -test regexp-20.1 {regsub shared object shimmering} -constraints deprecated -body { +test regexp-20.1 {regsub shared object shimmering} -body { # Bug #461322 set a abcdefghijklmnopqurstuvwxyz set b $a set c abcdefghijklmnopqurstuvwxyz0123456789 regsub $a $c $b d - list $d [string length $d] [string bytelength $d] -} -result [list abcdefghijklmnopqurstuvwxyz0123456789 37 37] + list $d [string length $d] +} -result [list abcdefghijklmnopqurstuvwxyz0123456789 37] test regexp-20.2 {regsub shared object shimmering with -about} -body { eval regexp -about abc } -result {0 {}} diff --git a/tests/regexpComp.test b/tests/regexpComp.test index 42f1b3b..6cf95b5 100644 --- a/tests/regexpComp.test +++ b/tests/regexpComp.test @@ -16,8 +16,6 @@ if {"::tcltest" ni [namespace children]} { namespace import -force ::tcltest::* } -source [file join [file dirname [info script]] tcltests.tcl] - # Procedure to evaluate a script within a proc, to test compilation # functionality @@ -793,16 +791,16 @@ test regexpComp-19.1 {regsub null replacement} { } } "\0a\0hel\0a\0lo\0a\0 14" -test regexpComp-20.1 {regsub shared object shimmering} deprecated { +test regexpComp-20.1 {regsub shared object shimmering} { evalInProc { # Bug #461322 set a abcdefghijklmnopqurstuvwxyz set b $a set c abcdefghijklmnopqurstuvwxyz0123456789 regsub $a $c $b d - list $d [string length $d] [string bytelength $d] + list $d [string length $d] } -} [list abcdefghijklmnopqurstuvwxyz0123456789 37 37] +} [list abcdefghijklmnopqurstuvwxyz0123456789 37] test regexpComp-20.2 {regsub shared object shimmering with -about} { evalInProc { eval regexp -about abc diff --git a/tests/result.test b/tests/result.test index 5ae29b2..770e401 100644 --- a/tests/result.test +++ b/tests/result.test @@ -33,7 +33,7 @@ test result-1.2 {Tcl_SaveInterpResult} {testsaveresult} { } {append result} test result-1.3 {Tcl_SaveInterpResult} {testsaveresult} { testsaveresult dynamic {set x 42} 0 -} {dynamic result presentOrFreed} +} {dynamic result freed} test result-1.4 {Tcl_SaveInterpResult} {testsaveresult} { testsaveresult object {set x 42} 0 } {object result same} @@ -45,7 +45,7 @@ test result-1.6 {Tcl_SaveInterpResult} {testsaveresult} { } {42} test result-1.7 {Tcl_SaveInterpResult} {testsaveresult} { testsaveresult dynamic {set x 42} 1 -} {42 presentOrFreed} +} {42 freed} test result-1.8 {Tcl_SaveInterpResult} {testsaveresult} { testsaveresult object {set x 42} 1 } {42 different} diff --git a/tests/safe.test b/tests/safe.test index e5d4d18..a4f8df0 100644 --- a/tests/safe.test +++ b/tests/safe.test @@ -734,10 +734,10 @@ test safe-9.6 {interpConfigure widget like behaviour} -body { safe::interpConfigure $i] } -cleanup { safe::interpDelete $i -} -match glob -result {{-accessPath * -statics 0 -nested 1 -deleteHook {foo bar}}\ - {-accessPath *} {-nested 1} {-statics 0} {-deleteHook {foo bar}}\ - {-accessPath * -statics 1 -nested 1 -deleteHook {foo bar}}\ - {-accessPath * -statics 0 -nested 0 -deleteHook toto}} +} -match glob -result {{-accessPath * -statics 0 -nested 1 -deleteHook {foo bar} -autoPath *}\ + {-accessPath *} {-nested 1} {-statics 0} {-deleteHook {foo bar}}\ + {-accessPath * -statics 1 -nested 1 -deleteHook {foo bar} -autoPath *}\ + {-accessPath * -statics 0 -nested 0 -deleteHook toto -autoPath *}} test safe-9.7 {interpConfigure widget like behaviour (demystified)} -body { # this test shall work, believed equivalent to 9.6 set i [safe::interpCreate \ @@ -759,10 +759,10 @@ test safe-9.7 {interpConfigure widget like behaviour (demystified)} -body { } -cleanup { safe::interpDelete $i unset -nocomplain a b c d e f g i -} -match glob -result {{-accessPath * -statics 0 -nested 1 -deleteHook {foo bar}}\ - {-accessPath *} {-nested 1} {-statics 0} {-deleteHook {foo bar}}\ - {-accessPath * -statics 1 -nested 1 -deleteHook {foo bar}}\ - {-accessPath * -statics 0 -nested 0 -deleteHook toto}} +} -match glob -result {{-accessPath * -statics 0 -nested 1 -deleteHook {foo bar} -autoPath *}\ + {-accessPath *} {-nested 1} {-statics 0} {-deleteHook {foo bar}}\ + {-accessPath * -statics 1 -nested 1 -deleteHook {foo bar} -autoPath *}\ + {-accessPath * -statics 0 -nested 0 -deleteHook toto -autoPath *}} test safe-9.8 {autoloading commands indexed in tclIndex files, Sync Mode on} -setup { set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] if {$SyncExists} { @@ -1951,7 +1951,7 @@ test safe-16.5 {Bug 3529949: defang ~ in paths used by AliasGlob (1)} -setup { safe::interpDelete $i set env(HOME) $savedHOME unset savedHOME -} -result {~} +} -result {$p(:0:)/~} test safe-16.6 {Bug 3529949: defang ~ in paths used by AliasGlob (2)} -setup { set savedHOME $env(HOME) set env(HOME) /foo/bar @@ -1965,7 +1965,7 @@ test safe-16.6 {Bug 3529949: defang ~ in paths used by AliasGlob (2)} -setup { safe::interpDelete $i set env(HOME) $savedHOME unset savedHOME -} -result {~} +} -result {$p(:0:)/foo/bar/~} test safe-16.7 {Bug 3529949: defang ~user in paths used by AliasGlob (1)} -setup { set i [safe::interpCreate] set user $tcl_platform(user) @@ -1974,7 +1974,7 @@ test safe-16.7 {Bug 3529949: defang ~user in paths used by AliasGlob (1)} -setup } -cleanup { safe::interpDelete $i unset user -} -result {~USER} +} -result {$p(:0:)/~USER} test safe-16.8 {Bug 3529949: defang ~user in paths used by AliasGlob (2)} -setup { set i [safe::interpCreate] set user $tcl_platform(user) @@ -1983,7 +1983,7 @@ test safe-16.8 {Bug 3529949: defang ~user in paths used by AliasGlob (2)} -setup } -cleanup { safe::interpDelete $i unset user -} -result {~USER} +} -result {$p(:0:)/foo/bar/~USER} ### 17. Test the use of ::auto_path for loading commands (via tclIndex files) ### and non-module packages (via pkgIndex.tcl files). diff --git a/tests/source.test b/tests/source.test index f5f9f0f..98aaee2 100644 --- a/tests/source.test +++ b/tests/source.test @@ -114,7 +114,7 @@ test source-2.7 {utf-8 with BOM} -setup { puts $out "\uFEFFset y new-y" close $out set y old-y - source -encoding utf-8 $sourcefile + source $sourcefile return $y } -cleanup { removeFile $sourcefile @@ -226,7 +226,7 @@ test source-7.1 {source -encoding test} -setup { close $f } -body { set x unset - source -encoding utf-8 $sourcefile + source $sourcefile set x } -cleanup { removeFile source.file @@ -269,7 +269,7 @@ test source-7.5 {source -encoding: correct operation} -setup { puts $f "proc € {} {return foo}" close $f } -body { - source -encoding utf-8 $sourcefile + source $sourcefile € } -cleanup { removeFile source.file diff --git a/tests/string.test b/tests/string.test index 6623f04..045d466 100644 --- a/tests/string.test +++ b/tests/string.test @@ -33,9 +33,10 @@ proc makeShared {s} {uplevel 1 [list lappend copy $s]; return $s} testConstraint testobj [expr {[info commands testobj] ne {}}] testConstraint testindexobj [expr {[info commands testindexobj] ne {}}] testConstraint testevalex [expr {[info commands testevalex] ne {}}] -testConstraint utf16 [expr {[string length \U010000] == 2}] +testConstraint utf32 [expr {[string length \U010000] == 1}] testConstraint testbytestring [llength [info commands testbytestring]] -testConstraint testutf16string [llength [info commands testutf16string]] +testConstraint utf32 [expr {[testConstraint fullutf] + && [string length [format %c 0x10000]] == 1}] # Used for constraining memory leak tests testConstraint memory [llength [info commands memory]] @@ -77,7 +78,7 @@ if {$noComp} { test string-1.1.$noComp {error conditions} -body { list [catch {run {string gorp a b}} msg] $msg -} -match glob -result {1 {unknown or ambiguous subcommand "gorp": must be *cat, compare, equal, first, index, insert, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}} +} -result {1 {unknown or ambiguous subcommand "gorp": must be cat, compare, equal, first, index, insert, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}} test string-1.2.$noComp {error conditions} { list [catch {run {string}} msg] $msg } {1 {wrong # args: should be "string subcommand ?arg ...?"}} @@ -423,7 +424,7 @@ test string-4.16.$noComp {string first, normal string vs pure unicode string} -b # Representation checks are canaries run {list [representationpoke $s] [representationpoke $m] \ [string first $m $s]} -} -match glob -result {{*string 1} {*string 0} 2} +} -result {{string 1} {string 0} 2} test string-4.17.$noComp {string first, corner case} -body { run {string first a aaa 4294967295} } -result -1 @@ -498,19 +499,19 @@ test string-5.16.$noComp {string index, bytearray object with string obj shimmer } 0 test string-5.17.$noComp {string index, bad integer} -body { list [catch {run {string index "abc" 0o8}} msg] $msg -} -match glob -result {1 {*invalid octal number*}} +} -match glob -result {1 {*}} test string-5.18.$noComp {string index, bad integer} -body { list [catch {run {string index "abc" end-0o0289}} msg] $msg -} -match glob -result {1 {*invalid octal number*}} +} -match glob -result {1 {*}} test string-5.19.$noComp {string index, bytearray object out of bounds} { run {string index [binary format I* {0x50515253 0x52}] -1} } {} test string-5.20.$noComp {string index, bytearray object out of bounds} -body { run {string index [binary format I* {0x50515253 0x52}] 20} } -result {} -test string-5.21.$noComp {string index, surrogates, bug [11ae2be95dac9417]} -constraints utf16 -body { +test string-5.21.$noComp {string index, surrogates, bug [11ae2be95dac9417]} -constraints utf32 -body { run {list [string index a\U100000b 1] [string index a\U100000b 2] [string index a\U100000b 3]} -} -result [list \U100000 {} b] +} -result [list \U100000 b {}] test string-5.22.$noComp {string index} -constraints testbytestring -body { run {list [scan [string index [testbytestring \xFF] 0] %c var] $var} } -result {1 255} @@ -1046,19 +1047,6 @@ test string-7.16.$noComp {string last, start index} { run {string last Üa ÜadÜad end-1} } 3 -test string-8.1.$noComp {string bytelength} deprecated { - list [catch {run {string bytelength}} msg] $msg -} {1 {wrong # args: should be "string bytelength string"}} -test string-8.2.$noComp {string bytelength} deprecated { - list [catch {run {string bytelength a b}} msg] $msg -} {1 {wrong # args: should be "string bytelength string"}} -test string-8.3.$noComp {string bytelength} deprecated { - run {string bytelength "\xC7"} -} 2 -test string-8.4.$noComp {string bytelength} deprecated { - run {string b ""} -} 0 - test string-9.1.$noComp {string length} { list [catch {run {string length}} msg] $msg } {1 {wrong # args: should be "string length string"}} @@ -1525,9 +1513,9 @@ test string-12.22.$noComp {string range, shimmering binary/index} { binary scan $s a* x run {string range $s $s end} } 000000001 -test string-12.23.$noComp {string range, surrogates, bug [11ae2be95dac9417]} utf16 { +test string-12.23.$noComp {string range, surrogates, bug [11ae2be95dac9417]} utf32 { run {list [string range a\U100000b 1 1] [string range a\U100000b 2 2] [string range a\U100000b 3 3]} -} [list \U100000 {} b] +} [list \U100000 b {}] test string-12.24.$noComp {bignum index arithmetic} -setup { proc demo {i j} {string range fubar $i $j} } -cleanup { @@ -1795,10 +1783,10 @@ test string-17.7.$noComp {string totitle, unicode} { test string-17.8.$noComp {string totitle, compiled} { lindex [run {string totitle [list aa bb [list cc]]}] 0 } Aa -test string-17.9.$noComp {string totitle, surrogates, bug [11ae2be95dac9417]} utf16 { +test string-17.9.$noComp {string totitle, surrogates, bug [11ae2be95dac9417]} utf32 { run {list [string totitle a\U118c0c 1 1] [string totitle a\U118c0c 2 2] \ [string totitle a\U118c0c 3 3]} -} [list a\U118a0c a\U118c0C a\U118c0C] +} [list a\U118a0c a\U118c0C a\U118c0c] test string-18.1.$noComp {string trim} { list [catch {run {string trim}} msg] $msg @@ -1852,7 +1840,7 @@ test string-20.1.$noComp {string trimright errors} { } {1 {wrong # args: should be "string trimright string ?chars?"}} test string-20.2.$noComp {string trimright errors} -body { list [catch {run {string trimg a}} msg] $msg -} -match glob -result {1 {unknown or ambiguous subcommand "trimg": must be *cat, compare, equal, first, index, insert, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}} +} -result {1 {unknown or ambiguous subcommand "trimg": must be cat, compare, equal, first, index, insert, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}} test string-20.3.$noComp {string trimright} { run {string trimright " XYZ "} } { XYZ} @@ -1939,9 +1927,9 @@ test string-21.14.$noComp {string wordend, unicode} -body { test string-21.15.$noComp {string wordend, unicode} -body { run {string wordend "\U1D7CA\U1D7CA abc" 0} } -result 2 -test string-21.16.$noComp {string wordend, unicode} -constraints utf16 -body { +test string-21.16.$noComp {string wordend, unicode} -constraints utf32 -body { run {string wordend "\U1D7CA\U1D7CA abc" 10} -} -result 8 +} -result 6 test string-21.17.$noComp {string trim, unicode} { run {string trim "\uD83D\uDE02Hello world!\uD83D\uDE02" \uD83D\uDE02} } "Hello world!" @@ -1961,18 +1949,18 @@ test string-21.22.$noComp {string trimright, unicode} { run {string trimright "\uF602Hello world!\uF602" \uD83D\uDE02} } "\uF602Hello world!\uF602" test string-21.23.$noComp {string trim, unicode} { - run {string trim "\uD83D\uDE02Hello world!\uD83D\uDE02" \uD93D\uDE02} + run {string trim "\uD83D\uDE02Hello world!\uD83D\uDE02" \uD93D} } "\uD83D\uDE02Hello world!\uD83D\uDE02" test string-21.24.$noComp {string trimleft, unicode} { run {string trimleft "\uD83D\uDE02Hello world!\uD83D\uDE02" \uD93D\uDE02} } "\uD83D\uDE02Hello world!\uD83D\uDE02" test string-21.25.$noComp {string trimright, unicode} { - run {string trimright "\uD83D\uDE02Hello world!\uD83D\uDE02" \uD93D\uDE02} + run {string trimright "\uD83D\uDE02Hello world!\uD83D\uDE02" \uD93D} } "\uD83D\uDE02Hello world!\uD83D\uDE02" test string-22.1.$noComp {string wordstart} -body { list [catch {run {string word a}} msg] $msg -} -match glob -result {1 {unknown or ambiguous subcommand "word": must be *cat, compare, equal, first, index, insert, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}} +} -result {1 {unknown or ambiguous subcommand "word": must be cat, compare, equal, first, index, insert, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}} test string-22.2.$noComp {string wordstart} -body { list [catch {run {string wordstart a}} msg] $msg } -result {1 {wrong # args: should be "string wordstart string index"}} @@ -2017,9 +2005,9 @@ test string-22.14.$noComp {string wordstart, invalid UTF-8} -constraints testbyt test string-22.15.$noComp {string wordstart, unicode} -body { run {string wordstart "\U1D7CA\U1D7CA abc" 0} } -result 0 -test string-22.16.$noComp {string wordstart, unicode} -constraints utf16 -body { +test string-22.16.$noComp {string wordstart, unicode} -constraints utf32 -body { run {string wordstart "\U1D7CA\U1D7CA abc" 10} -} -result 5 +} -result 3 test string-23.0.$noComp {string is boolean, Bug 1187123} testindexobj { set x 5 @@ -2131,24 +2119,24 @@ test string-24.15.$noComp {string reverse command - pure bytearray} { binary scan [run {tcl::string::reverse [binary format H* 010203]}] H* x set x } 030201 -test string-24.16.$noComp {string reverse command - surrogates} { +test string-24.16.$noComp {string reverse command - surrogates} utf32 { run {string reverse \u0444bulb\uD83D\uDE02} -} \uD83D\uDE02blub\u0444 -test string-24.17.$noComp {string reverse command - surrogates} { +} \uDE02\uD83Dblub\u0444 +test string-24.17.$noComp {string reverse command - surrogates} utf32 { run {string reverse \uD83D\uDE02hello\uD83D\uDE02} -} \uD83D\uDE02olleh\uD83D\uDE02 -test string-24.18.$noComp {string reverse command - surrogates} { +} \uDE02\uD83Dolleh\uDE02\uD83D +test string-24.18.$noComp {string reverse command - surrogates} utf32 { set s \u0444bulb\uD83D\uDE02 # shim shimmery ... string index $s 0 run {string reverse $s} -} \uD83D\uDE02blub\u0444 -test string-24.19.$noComp {string reverse command - surrogates} { +} \uDE02\uD83Dblub\u0444 +test string-24.19.$noComp {string reverse command - surrogates} utf32 { set s \uD83D\uDE02hello\uD83D\uDE02 # shim shimmery ... string index $s 0 run {string reverse $s} -} \uD83D\uDE02olleh\uD83D\uDE02 +} \uDE02\uD83Dolleh\uDE02\uD83D test string-25.1.$noComp {string is list} { run {string is list {a b c}} @@ -2637,17 +2625,6 @@ test string-32.17.$noComp {string is dict, valid dict packed in invalid dict} { } 0 }; # foreach noComp {0 1} - -test string-bug-b79df322a9 {Tcl_GetUnicode/Tcl_NewUnicodeObj api} -constraints { - testutf16string deprecated -} -body { - # This simple test suffices because the bug has nothing to do with - # the actual encoding conversion. The test was added because these - # functions are no longer called within the Tcl core and thus - # not tested by either `string`, not `encoding` tests. - testutf16string "abcde" -} -result abcde - # cleanup rename MemStress {} diff --git a/tests/stringObj.test b/tests/stringObj.test index 2fd4369..263e7ef 100644 --- a/tests/stringObj.test +++ b/tests/stringObj.test @@ -19,15 +19,13 @@ if {"::tcltest" ni [namespace children]} { ::tcltest::loadTestedCommands catch [list package require -exact tcl::test [info patchlevel]] -source [file join [file dirname [info script]] tcltests.tcl] testConstraint testobj [llength [info commands testobj]] testConstraint testbytestring [llength [info commands testbytestring]] testConstraint testdstring [llength [info commands testdstring]] -testConstraint tip389 [expr {[string length \U010000] == 2}] -testConstraint utf32 [expr {[string length [format %c 0x10000]] == 1}] - -test stringObj-1.1 {string type registration} {testobj deprecated} { +testConstraint utf32 [expr {[string length \U010000] == 1}] + +test stringObj-1.1 {string type registration} testobj { set t [testobj types] set first [string first "string" $t] set result [expr {$first >= 0}] @@ -58,27 +56,27 @@ test stringObj-3.2 {Tcl_SetStringObj, existing non-"empty string" object} testob lappend result [testobj refcount 1] } {{} 512 foo string 2} -test stringObj-4.1 {Tcl_SetObjLength procedure, string gets shorter} {testobj utf32 deprecated} { +test stringObj-4.1 {Tcl_SetObjLength procedure, string gets shorter} testobj { testobj freeallvars teststringobj set 1 test teststringobj setlength 1 3 list [teststringobj length 1] [teststringobj length2 1] \ [teststringobj get 1] -} {3 3 tes} -test stringObj-4.2 {Tcl_SetObjLength procedure, string gets longer} {testobj deprecated} { +} {3 4 tes} +test stringObj-4.2 {Tcl_SetObjLength procedure, string gets longer} testobj { testobj freeallvars teststringobj set 1 abcdef teststringobj setlength 1 10 list [teststringobj length 1] [teststringobj length2 1] } {10 10} -test stringObj-4.3 {Tcl_SetObjLength procedure, string gets longer} {testobj utf32 deprecated} { +test stringObj-4.3 {Tcl_SetObjLength procedure, string gets longer} testobj { testobj freeallvars teststringobj set 1 abcdef teststringobj append 1 xyzq -1 list [teststringobj length 1] [teststringobj length2 1] \ [teststringobj get 1] -} {10 10 abcdefxyzq} -test stringObj-4.4 {Tcl_SetObjLength procedure, "expty string", length 0} {testobj deprecated} { +} {10 20 abcdefxyzq} +test stringObj-4.4 {Tcl_SetObjLength procedure, "expty string", length 0} testobj { testobj freeallvars testobj newobj 1 teststringobj setlength 1 0 @@ -98,7 +96,7 @@ test stringObj-5.2 {Tcl_AppendToObj procedure, length calculation} testobj { teststringobj append 1 123 -1 teststringobj get 1 } {x y bbCC123} -test stringObj-5.3 {Tcl_AppendToObj procedure, reallocating space} {testobj utf32 deprecated} { +test stringObj-5.3 {Tcl_AppendToObj procedure, reallocating space} testobj { testobj freeallvars teststringobj set 1 xyz teststringobj setlength 1 15 @@ -110,7 +108,7 @@ test stringObj-5.3 {Tcl_AppendToObj procedure, reallocating space} {testobj utf3 teststringobj append 1 abcdef -1 lappend result [teststringobj length 1] [teststringobj length2 1] \ [teststringobj get 1] -} {15 15 16 16 xy12345678abcdef} +} {15 15 16 32 xy12345678abcdef} test stringObj-6.1 {Tcl_AppendStringsToObj procedure, type conversion} testobj { testobj freeallvars @@ -136,13 +134,13 @@ test stringObj-6.4 {Tcl_AppendStringsToObj procedure, counting space} testobj { teststringobj appendstrings 1 { 123 } abcdefg list [teststringobj length 1] [teststringobj get 1] } {15 {abc 123 abcdefg}} -test stringObj-6.5 {Tcl_AppendStringsToObj procedure, don't double space if initial string empty} {testobj utf32 deprecated} { +test stringObj-6.5 {Tcl_AppendStringsToObj procedure, don't double space if initial string empty} testobj { testobj freeallvars testobj newobj 1 teststringobj appendstrings 1 123 abcdefg list [teststringobj length 1] [teststringobj length2 1] [teststringobj get 1] -} {10 10 123abcdefg} -test stringObj-6.6 {Tcl_AppendStringsToObj procedure, space reallocation} {testobj deprecated} { +} {10 20 123abcdefg} +test stringObj-6.6 {Tcl_AppendStringsToObj procedure, space reallocation} testobj { testobj freeallvars teststringobj set 1 abc teststringobj setlength 1 10 @@ -151,7 +149,7 @@ test stringObj-6.6 {Tcl_AppendStringsToObj procedure, space reallocation} {testo list [teststringobj length 1] [teststringobj length2 1] \ [teststringobj get 1] } {10 10 ab34567890} -test stringObj-6.7 {Tcl_AppendStringsToObj procedure, space reallocation} {testobj utf32 deprecated} { +test stringObj-6.7 {Tcl_AppendStringsToObj procedure, space reallocation} testobj { testobj freeallvars teststringobj set 1 abc teststringobj setlength 1 10 @@ -159,8 +157,8 @@ test stringObj-6.7 {Tcl_AppendStringsToObj procedure, space reallocation} {testo teststringobj appendstrings 1 34567890x list [teststringobj length 1] [teststringobj length2 1] \ [teststringobj get 1] -} {11 11 ab34567890x} -test stringObj-6.8 {Tcl_AppendStringsToObj procedure, object totally empty} {testobj deprecated} { +} {11 22 ab34567890x} +test stringObj-6.8 {Tcl_AppendStringsToObj procedure, object totally empty} testobj { testobj freeallvars testobj newobj 1 teststringobj appendstrings 1 {} @@ -173,14 +171,14 @@ test stringObj-6.9 {Tcl_AppendStringToObj, pure unicode} testobj { teststringobj get 1 } adcfoobarsoom -test stringObj-7.1 {SetStringFromAny procedure} {testobj utf32 deprecated} { +test stringObj-7.1 {SetStringFromAny procedure} testobj { testobj freeallvars teststringobj set2 1 [list a b] teststringobj append 1 x -1 list [teststringobj length 1] [teststringobj length2 1] \ [teststringobj get 1] -} {4 4 {a bx}} -test stringObj-7.2 {SetStringFromAny procedure, null object} {testobj deprecated} { +} {4 8 {a bx}} +test stringObj-7.2 {SetStringFromAny procedure, null object} testobj { testobj freeallvars testobj newobj 1 teststringobj appendstrings 1 {} @@ -198,7 +196,7 @@ test stringObj-7.4 {SetStringFromAny called with string obj} testobj { [string length $x] [testobj objtype $x] } {6 string 6 string} -test stringObj-8.1 {DupStringInternalRep procedure} {testobj utf32 deprecated} { +test stringObj-8.1 {DupStringInternalRep procedure} testobj { testobj freeallvars teststringobj set 1 {} teststringobj append 1 abcde -1 @@ -207,7 +205,7 @@ test stringObj-8.1 {DupStringInternalRep procedure} {testobj utf32 deprecated} { [teststringobj maxchars 1] [teststringobj get 1] \ [teststringobj length 2] [teststringobj length2 2] \ [teststringobj maxchars 2] [teststringobj get 2] -} {5 5 5 abcde 5 5 5 abcde} +} {5 10 0 abcde 5 5 0 abcde} test stringObj-8.2 {DupUnicodeInternalRep, mixed width chars} testobj { set x abc\xEF\xBF\xAEghi string length $x @@ -456,52 +454,76 @@ test stringObj-15.4 {Tcl_Append*ToObj: self appends} testobj { teststringobj set 1 foo teststringobj appendself 1 3 } foo -test stringObj-15.5 {Tcl_Append*ToObj: self appends} {testobj tip389 deprecated} { +test stringObj-15.5 {Tcl_Append*ToObj: self appends} {testobj utf32} { teststringobj set 1 foo teststringobj appendself2 1 0 } foofoo -test stringObj-15.6 {Tcl_Append*ToObj: self appends} {testobj tip389 deprecated} { +test stringObj-15.6 {Tcl_Append*ToObj: self appends} {testobj utf32} { teststringobj set 1 foo teststringobj appendself2 1 1 } foooo -test stringObj-15.7 {Tcl_Append*ToObj: self appends} {testobj tip389 deprecated} { +test stringObj-15.7 {Tcl_Append*ToObj: self appends} {testobj utf32} { teststringobj set 1 foo teststringobj appendself2 1 2 } fooo -test stringObj-15.8 {Tcl_Append*ToObj: self appends} {testobj tip389 deprecated} { +test stringObj-15.8 {Tcl_Append*ToObj: self appends} {testobj utf32} { teststringobj set 1 foo teststringobj appendself2 1 3 } foo -test stringObj-16.0 {Tcl_GetRange: normal case} {testobj deprecated} { +test stringObj-16.0 {Tcl_GetRange: normal case} testobj { teststringobj set 1 abcde teststringobj range 1 1 3 } bcd -test stringObj-16.1 {Tcl_GetRange: first > end} {testobj deprecated} { +test stringObj-16.1 {Tcl_GetRange: first > end} testobj { teststringobj set 1 abcde teststringobj range 1 10 5 } {} -test stringObj-16.2 {Tcl_GetRange: last > end} {testobj deprecated} { +test stringObj-16.2 {Tcl_GetRange: last > end} testobj { teststringobj set 1 abcde teststringobj range 1 3 13 } de -test stringObj-16.3 {Tcl_GetRange: first = -1} {testobj deprecated} { +test stringObj-16.3 {Tcl_GetRange: first = TCL_INDEX_NONE} testobj { teststringobj set 1 abcde teststringobj range 1 -1 3 } abcd -test stringObj-16.4 {Tcl_GetRange: last = -1} {testobj deprecated} { +test stringObj-16.4 {Tcl_GetRange: last = TCL_INDEX_NONE} testobj { teststringobj set 1 abcde teststringobj range 1 1 -1 } bcde -test stringObj-16.5 {Tcl_GetRange: fist = last = -1} {testobj deprecated} { +test stringObj-16.5 {Tcl_GetRange: first = last = TCL_INDEX_NONE} testobj { teststringobj set 1 abcde teststringobj range 1 -1 -1 } abcde -test stringObj-16.6 {Tcl_GetRange: old anomaly} {testobj deprecated} { +test stringObj-16.6 {Tcl_GetRange: old anomaly} testobj { # Older implementations could return "cde" teststringobj set 1 abcde teststringobj range 1 2 0 } {} +test stringObj-16.7 {Tcl_GetRange: first = UINT_MAX-1} testobj { + teststringobj set 1 abcde + teststringobj range 1 0xFFFFFFFE 3 +} {} +test stringObj-16.8 {Tcl_GetRange: first = SIZE_MAX-1} testobj { + teststringobj set 1 abcde + teststringobj range 1 -2 3 +} {} +test stringObj-16.9 {Tcl_GetRange: last = UINT_MAX-1} testobj { + teststringobj set 1 abcde + teststringobj range 1 1 0xFFFFFFFE +} bcde +test stringObj-16.10 {Tcl_GetRange: last = SIZE_MAX-1} testobj { + teststringobj set 1 abcde + teststringobj range 1 1 -2 +} bcde +test stringObj-16.11 {Tcl_GetRange: first = last = UINT_MAX-1} testobj { + teststringobj set 1 abcde + teststringobj range 1 0xFFFFFFFE 0xFFFFFFFE +} {} +test stringObj-16.12 {Tcl_GetRange: first = last = SIZE_MAX-1} testobj { + teststringobj set 1 abcde + teststringobj range 1 -2 -2 +} {} if {[testConstraint testobj]} { testobj freeallvars diff --git a/tests/tcltest.test b/tests/tcltest.test index a9ce785..6bc5ad1 100644 --- a/tests/tcltest.test +++ b/tests/tcltest.test @@ -544,6 +544,7 @@ set notReadableDir [file join [temporaryDirectory] notreadable] set notWriteableDir [file join [temporaryDirectory] notwriteable] makeDirectory notreadable makeDirectory notwriteable + switch -- $::tcl_platform(platform) { unix { file attributes $notReadableDir -permissions 0o333 diff --git a/tests/unload.test b/tests/unload.test index 24b5e8d..df217be 100644 --- a/tests/unload.test +++ b/tests/unload.test @@ -27,7 +27,7 @@ if {![info exists ext]} { # Tests require the existence of one of the DLLs in the dltest directory. set testDir [file join [file dirname [info nameofexecutable]] dltest] -set x [file join $testDir pkgua$ext] +set x [file join $testDir tcl9pkgua$ext] set dll "[file tail $x]Required" testConstraint $dll [file readable $x] @@ -46,7 +46,7 @@ proc loadIfNotPresent {pkg args} { global testDir ext set loaded [lmap x [info loaded {*}$args] {lindex $x 1}] if {[string totitle $pkg] ni $loaded} { - load [file join $testDir $pkg$ext] + load [file join $testDir tcl9$pkg$ext] } } @@ -83,31 +83,31 @@ test unload-2.1 {basic loading of non-unloadable package, with guess for prefix} } {0 {pkga_eq pkga_quote}} test unload-2.2 {basic loading of unloadable package, with guess for prefix} [list $dll $loaded] { list $pkgua_loaded $pkgua_detached $pkgua_unloaded \ - [load [file join $testDir pkgua$ext]] \ + [load [file join $testDir tcl9pkgua$ext]] \ [pkgua_eq abc def] [lsort [info commands pkgua_*]] \ $pkgua_loaded $pkgua_detached $pkgua_unloaded } {{} {} {} {} 0 {pkgua_eq pkgua_quote} . {} {}} test unload-2.3 {basic unloading of non-unloadable package, with guess for prefix} -setup { loadIfNotPresent pkga } -constraints [list $dll $loaded] -returnCodes error -match glob -body { - unload [file join $testDir pkga$ext] + unload [file join $testDir tcl9pkga$ext] } -result {file "*" cannot be unloaded under a trusted interpreter} test unload-2.4 {basic unloading of unloadable package, with guess for prefix} -setup { loadIfNotPresent pkgua } -constraints [list $dll $loaded] -body { list $pkgua_loaded $pkgua_detached $pkgua_unloaded \ - [unload [file join $testDir pkgua$ext]] \ + [unload [file join $testDir tcl9pkgua$ext]] \ [info commands pkgua_*] \ $pkgua_loaded $pkgua_detached $pkgua_unloaded } -result {. {} {} {} {} . . .} test unload-2.5 {reloading of unloaded package, with guess for prefix} -setup { if {$pkgua_loaded eq ""} { loadIfNotPresent pkgua - unload [file join $testDir pkgua$ext] + unload [file join $testDir tcl9pkgua$ext] } } -constraints [list $dll $loaded] -body { list $pkgua_loaded $pkgua_detached $pkgua_unloaded \ - [load [file join $testDir pkgua$ext]] \ + [load [file join $testDir tcl9pkgua$ext]] \ [pkgua_eq abc def] [lsort [info commands pkgua_*]] \ $pkgua_loaded $pkgua_detached $pkgua_unloaded } -result {. . . {} 0 {pkgua_eq pkgua_quote} .. . .} @@ -115,12 +115,12 @@ test unload-2.6 {basic unloading of re-loaded package, with guess for prefix} -s # Establish expected state if {$pkgua_loaded eq ""} { loadIfNotPresent pkgua - unload [file join $testDir pkgua$ext] - load [file join $testDir pkgua$ext] + unload [file join $testDir tcl9pkgua$ext] + load [file join $testDir tcl9pkgua$ext] } } -constraints [list $dll $loaded] -body { list $pkgua_loaded $pkgua_detached $pkgua_unloaded \ - [unload [file join $testDir pkgua$ext]] \ + [unload [file join $testDir tcl9pkgua$ext]] \ [info commands pkgua_*] \ $pkgua_loaded $pkgua_detached $pkgua_unloaded } -result {.. . . {} {} .. .. ..} @@ -135,14 +135,14 @@ child eval { test unload-3.1 {basic loading of non-unloadable package in a safe interpreter} \ [list $dll $loaded] { catch {rename pkgb_sub {}} - load [file join $testDir pkgb$ext] Pkgb child + load [file join $testDir tcl9pkgb$ext] Pkgb child list [child eval pkgb_sub 44 13] [catch {child eval pkgb_unsafe} msg] $msg \ [catch {pkgb_sub 12 10} msg2] $msg2 } {31 1 {invalid command name "pkgb_unsafe"} 1 {invalid command name "pkgb_sub"}} test unload-3.2 {basic loading of unloadable package in a safe interpreter} \ [list $dll $loaded] { list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \ - [load [file join $testDir pkgua$ext] pkgua child] \ + [load [file join $testDir tcl9pkgua$ext] Pkgua child] \ [child eval pkgua_eq abc def] \ [lsort [child eval info commands pkgua_*]] \ [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] @@ -150,46 +150,46 @@ test unload-3.2 {basic loading of unloadable package in a safe interpreter} \ test unload-3.3 {unloading of a package that has never been loaded from a safe interpreter} -setup { loadIfNotPresent pkga } -constraints [list $dll $loaded] -returnCodes error -match glob -body { - unload [file join $testDir pkga$ext] {} child + unload [file join $testDir tcl9pkga$ext] {} child } -result {file "*" has never been loaded in this interpreter} test unload-3.4 {basic unloading of a non-unloadable package from a safe interpreter, with guess for prefix} -setup { if {[lsearch -index 1 [info loaded child] Pkgb] < 0} { - load [file join $testDir pkgb$ext] Pkgb child + load [file join $testDir tcl9pkgb$ext] Pkgb child } } -constraints [list $dll $loaded] -returnCodes error -match glob -body { - unload [file join $testDir pkgb$ext] {} child + unload [file join $testDir tcl9pkgb$ext] {} child } -result {file "*" cannot be unloaded under a safe interpreter} test unload-3.5 {basic unloading of an unloadable package from a safe interpreter, with guess for prefix} -setup { if {[lsearch -index 1 [info loaded child] Pkgua] < 0} { - load [file join $testDir pkgua$ext] Pkgua child + load [file join $testDir tcl9pkgua$ext] Pkgua child } } -constraints [list $dll $loaded] -body { list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \ - [unload [file join $testDir pkgua$ext] {} child] \ + [unload [file join $testDir tcl9pkgua$ext] {} child] \ [child eval info commands pkgua_*] \ [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] } -result {{. {} {}} {} {} {. . .}} test unload-3.6 {reloading of unloaded package in a safe interpreter, with guess for prefix} -setup { if {[child eval set pkgua_loaded] eq ""} { - load [file join $testDir pkgua$ext] {} child - unload [file join $testDir pkgua$ext] {} child + load [file join $testDir tcl9pkgua$ext] {} child + unload [file join $testDir tcl9pkgua$ext] {} child } } -constraints [list $dll $loaded] -body { list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \ - [load [file join $testDir pkgua$ext] {} child] \ + [load [file join $testDir tcl9pkgua$ext] {} child] \ [child eval pkgua_eq abc def] \ [lsort [child eval info commands pkgua_*]] \ [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] } -result {{. . .} {} 0 {pkgua_eq pkgua_quote} {.. . .}} test unload-3.7 {basic unloading of re-loaded package from a safe interpreter, with prefix conversion} -setup { if {[child eval set pkgua_loaded] eq ""} { - load [file join $testDir pkgua$ext] {} child - unload [file join $testDir pkgua$ext] {} child - load [file join $testDir pkgua$ext] {} child + load [file join $testDir tcl9pkgua$ext] {} child + unload [file join $testDir tcl9pkgua$ext] {} child + load [file join $testDir tcl9pkgua$ext] {} child } } -constraints [list $dll $loaded] -body { list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \ - [unload [file join $testDir pkgua$ext] pKgUa child] \ + [unload [file join $testDir tcl9pkgua$ext] Pkgua child] \ [child eval info commands pkgua_*] \ [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] } -result {{.. . .} {} {} {.. .. ..}} @@ -210,7 +210,7 @@ test unload-4.1 {loading of unloadable package in trusted interpreter, with gues incr load(M) } -constraints [list $dll $loaded] -body { list [list $pkgua_loaded $pkgua_detached $pkgua_unloaded] \ - [load [file join $testDir pkgua$ext]] \ + [load [file join $testDir tcl9pkgua$ext]] \ [pkgua_eq abc def] [lsort [info commands pkgua_*]] \ [list $pkgua_loaded $pkgua_detached $pkgua_unloaded] } -result {{{} {} {}} {} 0 {pkgua_eq pkgua_quote} {. {} {}}} @@ -224,7 +224,7 @@ test unload-4.2 {basic loading of unloadable package in a safe interpreter} -set incr load(C) } -constraints [list $dll $loaded] -body { list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \ - [load [file join $testDir pkgua$ext] pkgua child] \ + [load [file join $testDir tcl9pkgua$ext] Pkgua child] \ [child eval pkgua_eq abc def] \ [lsort [child eval info commands pkgua_*]] \ [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] @@ -234,7 +234,7 @@ test unload-4.3 {basic loading of unloadable package in a second trusted interpr incr load(T) } -constraints [list $dll $loaded] -body { list [child-trusted eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \ - [load [file join $testDir pkgua$ext] pkgua child-trusted] \ + [load [file join $testDir tcl9pkgua$ext] Pkgua child-trusted] \ [child-trusted eval pkgua_eq abc def] \ [lsort [child-trusted eval info commands pkgua_*]] \ [child-trusted eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] @@ -242,45 +242,45 @@ test unload-4.3 {basic loading of unloadable package in a second trusted interpr ## Unload the package from the main trusted interpreter... test unload-4.4 {basic unloading of unloadable package from trusted interpreter, with guess for prefix} -setup { if {!$load(M)} { - load [file join $testDir pkgua$ext] + load [file join $testDir tcl9pkgua$ext] } if {!$load(C)} { - load [file join $testDir pkgua$ext] {} child + load [file join $testDir tcl9pkgua$ext] {} child incr load(C) } if {!$load(T)} { - load [file join $testDir pkgua$ext] {} child-trusted + load [file join $testDir tcl9pkgua$ext] {} child-trusted incr load(T) } } -constraints [list $dll $loaded] -body { list [list $pkgua_loaded $pkgua_detached $pkgua_unloaded] \ - [unload [file join $testDir pkgua$ext]] \ + [unload [file join $testDir tcl9pkgua$ext]] \ [info commands pkgua_*] \ [list $pkgua_loaded $pkgua_detached $pkgua_unloaded] } -result {{. {} {}} {} {} {. . {}}} ## Unload the package from the child safe interpreter... test unload-4.5 {basic unloading of unloadable package from a safe interpreter, with guess for prefix} -setup { if {!$load(C)} { - load [file join $testDir pkgua$ext] {} child + load [file join $testDir tcl9pkgua$ext] {} child } if {!$load(T)} { - load [file join $testDir pkgua$ext] {} child-trusted + load [file join $testDir tcl9pkgua$ext] {} child-trusted incr load(T) } } -constraints [list $dll $loaded] -body { list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \ - [unload [file join $testDir pkgua$ext] {} child] \ + [unload [file join $testDir tcl9pkgua$ext] {} child] \ [child eval info commands pkgua_*] \ [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] } -result {{. {} {}} {} {} {. . {}}} ## Unload the package from the child trusted interpreter... test unload-4.6 {basic unloading of unloadable package from a safe interpreter, with guess for prefix} -setup { if {!$load(T)} { - load [file join $testDir pkgua$ext] {} child-trusted + load [file join $testDir tcl9pkgua$ext] {} child-trusted } } -constraints [list $dll $loaded] -body { list [child-trusted eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \ - [unload [file join $testDir pkgua$ext] {} child-trusted] \ + [unload [file join $testDir tcl9pkgua$ext] {} child-trusted] \ [child-trusted eval info commands pkgua_*] \ [child-trusted eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] } -result {{. {} {}} {} {} {. . .}} @@ -291,10 +291,10 @@ test unload-5.1 {unload a module loaded from vfs} \ set dir [pwd] cd $testDir testsimplefilesystem 1 - load simplefs:/pkgua$ext pkgua + load simplefs:/tcl9pkgua$ext Pkgua } \ -body { - list [catch {unload simplefs:/pkgua$ext} msg] $msg + list [catch {unload simplefs:/tcl9pkgua$ext} msg] $msg } \ -result {0 {}} diff --git a/tests/upvar.test b/tests/upvar.test index c31eaa1..6330fa6 100644 --- a/tests/upvar.test +++ b/tests/upvar.test @@ -207,6 +207,67 @@ test upvar-5.3 {traces involving upvars} { p1 foo bar set x } {{x1 {} u} x1} +test upvar-5.4 {read trace on upvar array element} -body { + proc p1 {a b} { + array set foo {c 22 d 33} + trace add variable foo {read write unset} tproc + p2 + trace remove variable foo {read write unset} tproc + } + proc p2 {} { + upvar foo(c) x1 + set x1 + } + set x --- + p1 foo bar + set x +} -result {{x1 c read} x1} +test upvar-5.5 {write trace on upvar array element} -body { + proc p1 {a b} { + array set foo {c 22 d 33} + trace add variable foo {read write unset} tproc + p2 + trace remove variable foo {read write unset} tproc + } + proc p2 {} { + upvar foo(c) x1 + set x1 22 + } + set x --- + p1 foo bar + set x +} -result {{x1 c write} x1} +test upvar-5.6 {unset trace on upvar array element} -body { + proc p1 {a b} { + array set foo {c 22 d 33} + trace add variable foo {read write unset} tproc + p2 + trace remove variable foo {read write unset} tproc + } + proc p2 {} { + upvar foo(c) x1 + unset x1 + } + set x --- + p1 foo bar + set x +} -result {{x1 c unset} x1} +test upvar-5.7 {trace on non-existent upvar array element} -body { + proc p1 {a b} { + array set foo {} + trace add variable foo {read write unset} tproc + p2 + trace remove variable foo {read write unset} tproc + return [array get foo] + } + proc p2 {} { + upvar foo(hi) x1 + set x1 there + } + set x --- + lappend x [p1 foo bar] + set x +} -result {{x1 hi write} x1 {hi there}} test upvar-6.1 {retargeting an upvar} { proc p1 {} { diff --git a/tests/utf.test b/tests/utf.test index 5a6bbd4..aaad670 100644 --- a/tests/utf.test +++ b/tests/utf.test @@ -16,8 +16,6 @@ if {"::tcltest" ni [namespace children]} { ::tcltest::loadTestedCommands catch [list package require -exact tcl::test [info patchlevel]] -source [file join [file dirname [info script]] tcltests.tcl] - testConstraint ucs2 [expr {[format %c 0x010000] eq "\uFFFD"}] testConstraint fullutf [expr {[format %c 0x010000] ne "\uFFFD"}] testConstraint utf16 [expr {[string length [format %c 0x10000]] == 2}] @@ -80,11 +78,11 @@ test utf-1.11 {Tcl_UniCharToUtf: 3 byte sequence, low surrogate} testbytestring test utf-1.12 {Tcl_UniCharToUtf: 4 byte sequence, high/low surrogate} {pairsTo4bytes testbytestring} { expr {"\uD842\uDC42" eq [testbytestring \xF0\xA0\xA1\x82]} } 1 -test utf-1.13.0 {Tcl_UniCharToUtf: Invalid surrogate} {Uesc ucs2} { +test utf-1.13.0 {Tcl_UniCharToUtf: Invalid surrogate} Uesc { expr {"\UD842" eq "\uD842"} } 1 test utf-1.13.1 {Tcl_UniCharToUtf: Invalid surrogate} {fullutf testbytestring} { - expr {"\UD842" eq [testbytestring \xEF\xBF\xBD]} + expr {"\UD842" eq [testbytestring \xED\xA1\x82]} } 1 test utf-1.14 {Tcl_UniCharToUtf: surrogate pairs from concat} { set lo \uDE02 @@ -193,9 +191,12 @@ test utf-4.10 {Tcl_NumUtfChars: #x00, calc len, overcomplete} {testnumutfchars t test utf-4.11 {Tcl_NumUtfChars: 3 bytes of 4-byte UTF-8 characater} {testnumutfchars testbytestring} { testnumutfchars [testbytestring \xF0\x9F\x92\xA9] end-1 } 3 -test utf-4.12 {Tcl_NumUtfChars: #4-byte UTF-8 character} {testnumutfchars testbytestring deprecated} { +test utf-4.12.0 {Tcl_NumUtfChars: #4-byte UTF-8 character} {testnumutfchars testbytestring ucs2} { testnumutfchars [testbytestring \xF0\x9F\x92\xA9] end } 2 +test utf-4.12.1 {Tcl_NumUtfChars: #4-byte UTF-8 character} {testnumutfchars testbytestring utf32} { + testnumutfchars [testbytestring \xF0\x9F\x92\xA9] end +} 1 test utf-4.13 {Tcl_NumUtfChars: end of string} {testnumutfchars testbytestring} { testnumutfchars foobar[testbytestring \xF2\xC2\xA0] end } 8 @@ -1113,7 +1114,7 @@ test utf-11.6 {Tcl_UtfToUpper beyond U+FFFF} fullutf { test utf-11.7 {Tcl_UtfToUpper beyond U+FFFF} fullutf { string toupper 𐐨 } 𐐀 -test utf-11.8 {Tcl_UtfToUpper low/high surrogate)} { +test utf-11.8 {Tcl_UtfToUpper low/high surrogate)} utf32 { string toupper \uDC24\uD824 } \uDC24\uD824 @@ -1132,7 +1133,7 @@ test utf-12.4 {Tcl_UtfToLower} { test utf-12.5 {Tcl_UtfToLower Georgian (new in Unicode 11)} { string tolower აᲐ } აა -test utf-12.6 {Tcl_UtfToLower low/high surrogate)} { +test utf-12.6 {Tcl_UtfToLower low/high surrogate)} utf32 { string tolower \uDC24\uD824 } \uDC24\uD824 test utf-12.7 {Tcl_UtfToLower beyond U+FFFF} fullutf { @@ -1160,7 +1161,7 @@ test utf-13.5 {Tcl_UtfToTitle Georgian (new in Unicode 11)} { test utf-13.6 {Tcl_UtfToTitle Georgian (new in Unicode 11)} { string totitle Აა } Აა -test utf-13.7 {Tcl_UtfToTitle low/high surrogate)} { +test utf-13.7 {Tcl_UtfToTitle low/high surrogate)} utf32 { string totitle \uDC24\uD824 } \uDC24\uD824 test utf-13.8 {Tcl_UtfToTitle beyond U+FFFF} fullutf { @@ -1229,7 +1230,7 @@ test utf-19.1 {TclUniCharLen} -body { test utf-20.1 {TclUniCharNcmp} utf32 { string compare [string range [format %c 0xFFFF] 0 0] [string range [format %c 0x10000] 0 0] } -1 -test utf-20.2 {[4c591fa487] TclUniCharNcmp/TclUtfNcmp} utf32 { +test utf-20.2 {[4c591fa487] TclUniCharNcmp/TclUtfNcmp} { set one [format %c 0xFFFF] set two [format %c 0x10000] set first [string compare $one $two] diff --git a/tests/util.test b/tests/util.test index c3b9f2d..ec79336 100644 --- a/tests/util.test +++ b/tests/util.test @@ -22,9 +22,6 @@ testConstraint testconcatobj [llength [info commands testconcatobj]] testConstraint testdoubledigits [llength [info commands testdoubledigits]] testConstraint testprint [llength [info commands testprint]] -testConstraint precision [expr {![catch {set saved_precision $::tcl_precision}]}] - - # Big test for correct ordering of data in [expr] proc testIEEE {} { @@ -395,38 +392,6 @@ test util-5.52 {Tcl_StringMatch} { } 0 -test util-6.1 {Tcl_PrintDouble - using tcl_precision} -constraints precision -setup { - set old_precision $::tcl_precision - set ::tcl_precision 12 -} -body { - concat x[expr {1.4}] -} -cleanup { - set ::tcl_precision $old_precision -} -result {x1.4} -test util-6.2 {Tcl_PrintDouble - using tcl_precision} -constraints precision -setup { - set old_precision $::tcl_precision - set ::tcl_precision 12 -} -body { - concat x[expr {1.39999999999}] -} -cleanup { - set ::tcl_precision $old_precision -} -result {x1.39999999999} -test util-6.3 {Tcl_PrintDouble - using tcl_precision} -constraints precision -setup { - set old_precision $::tcl_precision - set ::tcl_precision 12 -} -body { - concat x[expr {1.399999999999}] -} -cleanup { - set ::tcl_precision $old_precision -} -result {x1.4} -test util-6.4 {Tcl_PrintDouble - using tcl_precision} -constraints precision -setup { - set old_precision $::tcl_precision - set ::tcl_precision 5 -} -body { - concat x[expr {1.123412341234}] -} -cleanup { - set tcl_precision $old_precision -} -result {x1.1234} test util-6.5 {Tcl_PrintDouble - make sure there's a decimal point} { concat x[expr {2.0}] } {x2.0} @@ -434,50 +399,6 @@ test util-6.6 {Tcl_PrintDouble - make sure there's a decimal point} { concat x[expr {3.0e98}] } {x3e+98} -test util-7.1 {TclPrecTraceProc - unset callbacks} -constraints precision -setup { - set old_precision $::tcl_precision -} -body { - set tcl_precision 7 - set x $tcl_precision - unset tcl_precision - list $x $tcl_precision -} -cleanup { - set ::tcl_precision $old_precision -} -result {7 7} -test util-7.2 {TclPrecTraceProc - read traces, sharing among interpreters} -constraints precision -setup { - set old_precision $::tcl_precision -} -body { - set tcl_precision 12 - interp create child - set x [child eval set tcl_precision] - child eval {set tcl_precision 6} - interp delete child - list $x $tcl_precision -} -cleanup { - set ::tcl_precision $old_precision -} -result {12 6} -test util-7.3 {TclPrecTraceProc - write traces, safe interpreters} -constraints precision -setup { - set old_precision $::tcl_precision -} -body { - set tcl_precision 12 - interp create -safe child - set x [child eval { - list [catch {set tcl_precision 8} msg] $msg - }] - interp delete child - list $x $tcl_precision -} -cleanup { - set ::tcl_precision $old_precision -} -result {{1 {can't set "tcl_precision": can't modify precision from a safe interpreter}} 12} -test util-7.4 {TclPrecTraceProc - write traces, bogus values} -constraints precision -setup { - set old_precision $::tcl_precision -} -body { - set tcl_precision 12 - list [catch {set tcl_precision abc} msg] $msg $tcl_precision -} -cleanup { - set ::tcl_precision $old_precision -} -result {1 {can't set "tcl_precision": improper value for precision} 12} - # This test always succeeded in the C locale anyway... test util-8.1 {TclNeedSpace - correct utf-8 handling} { # Bug 411825 @@ -2233,1874 +2154,6 @@ test util-15.8 {smallest normal} {*}{ } } -foreach ::tcl_precision {0 12} { - for {set e -312} {$e < -9} {incr e} { - test util-16.1.$::tcl_precision.$e {shortening of numbers} \ - "expr {1.1e$e}" 1.1e$e - } -} -set tcl_precision 0 -for {set e -9} {$e < -4} {incr e} { - test util-16.1.$::tcl_precision.$e {shortening of numbers} \ - "expr {1.1e$e}" 1.1e$e -} -set tcl_precision 12 -for {set e -9} {$e < -4} {incr e} { - test util-16.1.$::tcl_precision.$e {8.4 compatible formatting of doubles} precision \ - "expr {1.1e$e}" 1.1e[format %+03d $e] -} -foreach ::tcl_precision {0 12} { - test util-16.1.$::tcl_precision.-4 {shortening of numbers} \ - {expr {1.1e-4}} \ - 0.00011 - test util-16.1.$::tcl_precision.-3 {shortening of numbers} \ - {expr {1.1e-3}} \ - 0.0011 - test util-16.1.$::tcl_precision.-2 {shortening of numbers} \ - {expr {1.1e-2}} \ - 0.011 - test util-16.1.$::tcl_precision.-1 {shortening of numbers} \ - {expr {1.1e-1}} \ - 0.11 - test util-16.1.$::tcl_precision.0 {shortening of numbers} \ - {expr {1.1}} \ - 1.1 - for {set e 1} {$e < 17} {incr e} { - test util-16.1.$::tcl_precision.$e {shortening of numbers} \ - "expr {11[string repeat 0 [expr {$e-1}]].0}" \ - 11[string repeat 0 [expr {$e-1}]].0 - } - for {set e 17} {$e < 309} {incr e} { - test util-16.1.$::tcl_precision.$e {shortening of numbers} \ - "expr {1.1e$e}" 1.1e+$e - } -} -set tcl_precision 17 -test util-16.1.17.-300 {8.4 compatible formatting of doubles} precision \ - {expr {1e-300}} \ - 1e-300 -test util-16.1.17.-299 {8.4 compatible formatting of doubles} precision \ - {expr {1e-299}} \ - 9.9999999999999999e-300 -test util-16.1.17.-298 {8.4 compatible formatting of doubles} precision \ - {expr {1e-298}} \ - 9.9999999999999991e-299 -test util-16.1.17.-297 {8.4 compatible formatting of doubles} precision \ - {expr {1e-297}} \ - 1e-297 -test util-16.1.17.-296 {8.4 compatible formatting of doubles} precision \ - {expr {1e-296}} \ - 1e-296 -test util-16.1.17.-295 {8.4 compatible formatting of doubles} precision \ - {expr {1e-295}} \ - 1.0000000000000001e-295 -test util-16.1.17.-294 {8.4 compatible formatting of doubles} precision \ - {expr {1e-294}} \ - 1e-294 -test util-16.1.17.-293 {8.4 compatible formatting of doubles} precision \ - {expr {1e-293}} \ - 1.0000000000000001e-293 -test util-16.1.17.-292 {8.4 compatible formatting of doubles} precision \ - {expr {1e-292}} \ - 1.0000000000000001e-292 -test util-16.1.17.-291 {8.4 compatible formatting of doubles} precision \ - {expr {1e-291}} \ - 9.9999999999999996e-292 -test util-16.1.17.-290 {8.4 compatible formatting of doubles} precision \ - {expr {1e-290}} \ - 1.0000000000000001e-290 -test util-16.1.17.-289 {8.4 compatible formatting of doubles} precision \ - {expr {1e-289}} \ - 1e-289 -test util-16.1.17.-288 {8.4 compatible formatting of doubles} precision \ - {expr {1e-288}} \ - 1.0000000000000001e-288 -test util-16.1.17.-287 {8.4 compatible formatting of doubles} precision \ - {expr {1e-287}} \ - 1e-287 -test util-16.1.17.-286 {8.4 compatible formatting of doubles} precision \ - {expr {1e-286}} \ - 1.0000000000000001e-286 -test util-16.1.17.-285 {8.4 compatible formatting of doubles} precision \ - {expr {1e-285}} \ - 1.0000000000000001e-285 -test util-16.1.17.-284 {8.4 compatible formatting of doubles} precision \ - {expr {1e-284}} \ - 1e-284 -test util-16.1.17.-283 {8.4 compatible formatting of doubles} precision \ - {expr {1e-283}} \ - 9.9999999999999995e-284 -test util-16.1.17.-282 {8.4 compatible formatting of doubles} precision \ - {expr {1e-282}} \ - 1e-282 -test util-16.1.17.-281 {8.4 compatible formatting of doubles} precision \ - {expr {1e-281}} \ - 1e-281 -test util-16.1.17.-280 {8.4 compatible formatting of doubles} precision \ - {expr {1e-280}} \ - 9.9999999999999996e-281 -test util-16.1.17.-279 {8.4 compatible formatting of doubles} precision \ - {expr {1e-279}} \ - 1.0000000000000001e-279 -test util-16.1.17.-278 {8.4 compatible formatting of doubles} precision \ - {expr {1e-278}} \ - 9.9999999999999994e-279 -test util-16.1.17.-277 {8.4 compatible formatting of doubles} precision \ - {expr {1e-277}} \ - 9.9999999999999997e-278 -test util-16.1.17.-276 {8.4 compatible formatting of doubles} precision \ - {expr {1e-276}} \ - 1.0000000000000001e-276 -test util-16.1.17.-275 {8.4 compatible formatting of doubles} precision \ - {expr {1e-275}} \ - 9.9999999999999993e-276 -test util-16.1.17.-274 {8.4 compatible formatting of doubles} precision \ - {expr {1e-274}} \ - 9.9999999999999997e-275 -test util-16.1.17.-273 {8.4 compatible formatting of doubles} precision \ - {expr {1e-273}} \ - 1.0000000000000001e-273 -test util-16.1.17.-272 {8.4 compatible formatting of doubles} precision \ - {expr {1e-272}} \ - 9.9999999999999993e-273 -test util-16.1.17.-271 {8.4 compatible formatting of doubles} precision \ - {expr {1e-271}} \ - 9.9999999999999996e-272 -test util-16.1.17.-270 {8.4 compatible formatting of doubles} precision \ - {expr {1e-270}} \ - 1e-270 -test util-16.1.17.-269 {8.4 compatible formatting of doubles} precision \ - {expr {1e-269}} \ - 9.9999999999999996e-270 -test util-16.1.17.-268 {8.4 compatible formatting of doubles} precision \ - {expr {1e-268}} \ - 9.9999999999999996e-269 -test util-16.1.17.-267 {8.4 compatible formatting of doubles} precision \ - {expr {1e-267}} \ - 9.9999999999999998e-268 -test util-16.1.17.-266 {8.4 compatible formatting of doubles} precision \ - {expr {1e-266}} \ - 9.9999999999999998e-267 -test util-16.1.17.-265 {8.4 compatible formatting of doubles} precision \ - {expr {1e-265}} \ - 9.9999999999999998e-266 -test util-16.1.17.-264 {8.4 compatible formatting of doubles} precision \ - {expr {1e-264}} \ - 1e-264 -test util-16.1.17.-263 {8.4 compatible formatting of doubles} precision \ - {expr {1e-263}} \ - 1e-263 -test util-16.1.17.-262 {8.4 compatible formatting of doubles} precision \ - {expr {1e-262}} \ - 1e-262 -test util-16.1.17.-261 {8.4 compatible formatting of doubles} precision \ - {expr {1e-261}} \ - 9.9999999999999998e-262 -test util-16.1.17.-260 {8.4 compatible formatting of doubles} precision \ - {expr {1e-260}} \ - 9.9999999999999996e-261 -test util-16.1.17.-259 {8.4 compatible formatting of doubles} precision \ - {expr {1e-259}} \ - 1.0000000000000001e-259 -test util-16.1.17.-258 {8.4 compatible formatting of doubles} precision \ - {expr {1e-258}} \ - 9.9999999999999995e-259 -test util-16.1.17.-257 {8.4 compatible formatting of doubles} precision \ - {expr {1e-257}} \ - 9.9999999999999998e-258 -test util-16.1.17.-256 {8.4 compatible formatting of doubles} precision \ - {expr {1e-256}} \ - 9.9999999999999998e-257 -test util-16.1.17.-255 {8.4 compatible formatting of doubles} precision \ - {expr {1e-255}} \ - 1e-255 -test util-16.1.17.-254 {8.4 compatible formatting of doubles} precision \ - {expr {1e-254}} \ - 9.9999999999999991e-255 -test util-16.1.17.-253 {8.4 compatible formatting of doubles} precision \ - {expr {1e-253}} \ - 1.0000000000000001e-253 -test util-16.1.17.-252 {8.4 compatible formatting of doubles} precision \ - {expr {1e-252}} \ - 9.9999999999999994e-253 -test util-16.1.17.-251 {8.4 compatible formatting of doubles} precision \ - {expr {1e-251}} \ - 1e-251 -test util-16.1.17.-250 {8.4 compatible formatting of doubles} precision \ - {expr {1e-250}} \ - 1.0000000000000001e-250 -test util-16.1.17.-249 {8.4 compatible formatting of doubles} precision \ - {expr {1e-249}} \ - 1.0000000000000001e-249 -test util-16.1.17.-248 {8.4 compatible formatting of doubles} precision \ - {expr {1e-248}} \ - 9.9999999999999998e-249 -test util-16.1.17.-247 {8.4 compatible formatting of doubles} precision \ - {expr {1e-247}} \ - 1e-247 -test util-16.1.17.-246 {8.4 compatible formatting of doubles} precision \ - {expr {1e-246}} \ - 9.9999999999999996e-247 -test util-16.1.17.-245 {8.4 compatible formatting of doubles} precision \ - {expr {1e-245}} \ - 9.9999999999999993e-246 -test util-16.1.17.-244 {8.4 compatible formatting of doubles} precision \ - {expr {1e-244}} \ - 9.9999999999999993e-245 -test util-16.1.17.-243 {8.4 compatible formatting of doubles} precision \ - {expr {1e-243}} \ - 1e-243 -test util-16.1.17.-242 {8.4 compatible formatting of doubles} precision \ - {expr {1e-242}} \ - 9.9999999999999997e-243 -test util-16.1.17.-241 {8.4 compatible formatting of doubles} precision \ - {expr {1e-241}} \ - 9.9999999999999997e-242 -test util-16.1.17.-240 {8.4 compatible formatting of doubles} precision \ - {expr {1e-240}} \ - 9.9999999999999997e-241 -test util-16.1.17.-239 {8.4 compatible formatting of doubles} precision \ - {expr {1e-239}} \ - 1.0000000000000001e-239 -test util-16.1.17.-238 {8.4 compatible formatting of doubles} precision \ - {expr {1e-238}} \ - 9.9999999999999999e-239 -test util-16.1.17.-237 {8.4 compatible formatting of doubles} precision \ - {expr {1e-237}} \ - 9.9999999999999999e-238 -test util-16.1.17.-236 {8.4 compatible formatting of doubles} precision \ - {expr {1e-236}} \ - 1e-236 -test util-16.1.17.-235 {8.4 compatible formatting of doubles} precision \ - {expr {1e-235}} \ - 9.9999999999999996e-236 -test util-16.1.17.-234 {8.4 compatible formatting of doubles} precision \ - {expr {1e-234}} \ - 9.9999999999999996e-235 -test util-16.1.17.-233 {8.4 compatible formatting of doubles} precision \ - {expr {1e-233}} \ - 9.9999999999999996e-234 -test util-16.1.17.-232 {8.4 compatible formatting of doubles} precision \ - {expr {1e-232}} \ - 1e-232 -test util-16.1.17.-231 {8.4 compatible formatting of doubles} precision \ - {expr {1e-231}} \ - 9.9999999999999999e-232 -test util-16.1.17.-230 {8.4 compatible formatting of doubles} precision \ - {expr {1e-230}} \ - 1e-230 -test util-16.1.17.-229 {8.4 compatible formatting of doubles} precision \ - {expr {1e-229}} \ - 1.0000000000000001e-229 -test util-16.1.17.-228 {8.4 compatible formatting of doubles} precision \ - {expr {1e-228}} \ - 1e-228 -test util-16.1.17.-227 {8.4 compatible formatting of doubles} precision \ - {expr {1e-227}} \ - 9.9999999999999994e-228 -test util-16.1.17.-226 {8.4 compatible formatting of doubles} precision \ - {expr {1e-226}} \ - 9.9999999999999992e-227 -test util-16.1.17.-225 {8.4 compatible formatting of doubles} precision \ - {expr {1e-225}} \ - 9.9999999999999996e-226 -test util-16.1.17.-224 {8.4 compatible formatting of doubles} precision \ - {expr {1e-224}} \ - 1e-224 -test util-16.1.17.-223 {8.4 compatible formatting of doubles} precision \ - {expr {1e-223}} \ - 9.9999999999999997e-224 -test util-16.1.17.-222 {8.4 compatible formatting of doubles} precision \ - {expr {1e-222}} \ - 1e-222 -test util-16.1.17.-221 {8.4 compatible formatting of doubles} precision \ - {expr {1e-221}} \ - 1e-221 -test util-16.1.17.-220 {8.4 compatible formatting of doubles} precision \ - {expr {1e-220}} \ - 9.9999999999999999e-221 -test util-16.1.17.-219 {8.4 compatible formatting of doubles} precision \ - {expr {1e-219}} \ - 1e-219 -test util-16.1.17.-218 {8.4 compatible formatting of doubles} precision \ - {expr {1e-218}} \ - 1e-218 -test util-16.1.17.-217 {8.4 compatible formatting of doubles} precision \ - {expr {1e-217}} \ - 1.0000000000000001e-217 -test util-16.1.17.-216 {8.4 compatible formatting of doubles} precision \ - {expr {1e-216}} \ - 1e-216 -test util-16.1.17.-215 {8.4 compatible formatting of doubles} precision \ - {expr {1e-215}} \ - 1e-215 -test util-16.1.17.-214 {8.4 compatible formatting of doubles} precision \ - {expr {1e-214}} \ - 9.9999999999999991e-215 -test util-16.1.17.-213 {8.4 compatible formatting of doubles} precision \ - {expr {1e-213}} \ - 9.9999999999999995e-214 -test util-16.1.17.-212 {8.4 compatible formatting of doubles} precision \ - {expr {1e-212}} \ - 9.9999999999999995e-213 -test util-16.1.17.-211 {8.4 compatible formatting of doubles} precision \ - {expr {1e-211}} \ - 1.0000000000000001e-211 -test util-16.1.17.-210 {8.4 compatible formatting of doubles} precision \ - {expr {1e-210}} \ - 1e-210 -test util-16.1.17.-209 {8.4 compatible formatting of doubles} precision \ - {expr {1e-209}} \ - 1e-209 -test util-16.1.17.-208 {8.4 compatible formatting of doubles} precision \ - {expr {1e-208}} \ - 1.0000000000000001e-208 -test util-16.1.17.-207 {8.4 compatible formatting of doubles} precision \ - {expr {1e-207}} \ - 9.9999999999999993e-208 -test util-16.1.17.-206 {8.4 compatible formatting of doubles} precision \ - {expr {1e-206}} \ - 1e-206 -test util-16.1.17.-205 {8.4 compatible formatting of doubles} precision \ - {expr {1e-205}} \ - 1e-205 -test util-16.1.17.-204 {8.4 compatible formatting of doubles} precision \ - {expr {1e-204}} \ - 1e-204 -test util-16.1.17.-203 {8.4 compatible formatting of doubles} precision \ - {expr {1e-203}} \ - 1e-203 -test util-16.1.17.-202 {8.4 compatible formatting of doubles} precision \ - {expr {1e-202}} \ - 1e-202 -test util-16.1.17.-201 {8.4 compatible formatting of doubles} precision \ - {expr {1e-201}} \ - 9.9999999999999995e-202 -test util-16.1.17.-200 {8.4 compatible formatting of doubles} precision \ - {expr {1e-200}} \ - 9.9999999999999998e-201 -test util-16.1.17.-199 {8.4 compatible formatting of doubles} precision \ - {expr {1e-199}} \ - 9.9999999999999998e-200 -test util-16.1.17.-198 {8.4 compatible formatting of doubles} precision \ - {expr {1e-198}} \ - 9.9999999999999991e-199 -test util-16.1.17.-197 {8.4 compatible formatting of doubles} precision \ - {expr {1e-197}} \ - 9.9999999999999999e-198 -test util-16.1.17.-196 {8.4 compatible formatting of doubles} precision \ - {expr {1e-196}} \ - 1e-196 -test util-16.1.17.-195 {8.4 compatible formatting of doubles} precision \ - {expr {1e-195}} \ - 1.0000000000000001e-195 -test util-16.1.17.-194 {8.4 compatible formatting of doubles} precision \ - {expr {1e-194}} \ - 1e-194 -test util-16.1.17.-193 {8.4 compatible formatting of doubles} precision \ - {expr {1e-193}} \ - 1e-193 -test util-16.1.17.-192 {8.4 compatible formatting of doubles} precision \ - {expr {1e-192}} \ - 1.0000000000000001e-192 -test util-16.1.17.-191 {8.4 compatible formatting of doubles} precision \ - {expr {1e-191}} \ - 1e-191 -test util-16.1.17.-190 {8.4 compatible formatting of doubles} precision \ - {expr {1e-190}} \ - 1e-190 -test util-16.1.17.-189 {8.4 compatible formatting of doubles} precision \ - {expr {1e-189}} \ - 1.0000000000000001e-189 -test util-16.1.17.-188 {8.4 compatible formatting of doubles} precision \ - {expr {1e-188}} \ - 9.9999999999999995e-189 -test util-16.1.17.-187 {8.4 compatible formatting of doubles} precision \ - {expr {1e-187}} \ - 1e-187 -test util-16.1.17.-186 {8.4 compatible formatting of doubles} precision \ - {expr {1e-186}} \ - 9.9999999999999991e-187 -test util-16.1.17.-185 {8.4 compatible formatting of doubles} precision \ - {expr {1e-185}} \ - 9.9999999999999999e-186 -test util-16.1.17.-184 {8.4 compatible formatting of doubles} precision \ - {expr {1e-184}} \ - 1.0000000000000001e-184 -test util-16.1.17.-183 {8.4 compatible formatting of doubles} precision \ - {expr {1e-183}} \ - 1e-183 -test util-16.1.17.-182 {8.4 compatible formatting of doubles} precision \ - {expr {1e-182}} \ - 1e-182 -test util-16.1.17.-181 {8.4 compatible formatting of doubles} precision \ - {expr {1e-181}} \ - 1e-181 -test util-16.1.17.-180 {8.4 compatible formatting of doubles} precision \ - {expr {1e-180}} \ - 1e-180 -test util-16.1.17.-179 {8.4 compatible formatting of doubles} precision \ - {expr {1e-179}} \ - 1e-179 -test util-16.1.17.-178 {8.4 compatible formatting of doubles} precision \ - {expr {1e-178}} \ - 9.9999999999999995e-179 -test util-16.1.17.-177 {8.4 compatible formatting of doubles} precision \ - {expr {1e-177}} \ - 9.9999999999999995e-178 -test util-16.1.17.-176 {8.4 compatible formatting of doubles} precision \ - {expr {1e-176}} \ - 1e-176 -test util-16.1.17.-175 {8.4 compatible formatting of doubles} precision \ - {expr {1e-175}} \ - 1e-175 -test util-16.1.17.-174 {8.4 compatible formatting of doubles} precision \ - {expr {1e-174}} \ - 1e-174 -test util-16.1.17.-173 {8.4 compatible formatting of doubles} precision \ - {expr {1e-173}} \ - 1e-173 -test util-16.1.17.-172 {8.4 compatible formatting of doubles} precision \ - {expr {1e-172}} \ - 1e-172 -test util-16.1.17.-171 {8.4 compatible formatting of doubles} precision \ - {expr {1e-171}} \ - 9.9999999999999998e-172 -test util-16.1.17.-170 {8.4 compatible formatting of doubles} precision \ - {expr {1e-170}} \ - 9.9999999999999998e-171 -test util-16.1.17.-169 {8.4 compatible formatting of doubles} precision \ - {expr {1e-169}} \ - 1e-169 -test util-16.1.17.-168 {8.4 compatible formatting of doubles} precision \ - {expr {1e-168}} \ - 1e-168 -test util-16.1.17.-167 {8.4 compatible formatting of doubles} precision \ - {expr {1e-167}} \ - 1e-167 -test util-16.1.17.-166 {8.4 compatible formatting of doubles} precision \ - {expr {1e-166}} \ - 1e-166 -test util-16.1.17.-165 {8.4 compatible formatting of doubles} precision \ - {expr {1e-165}} \ - 1e-165 -test util-16.1.17.-164 {8.4 compatible formatting of doubles} precision \ - {expr {1e-164}} \ - 9.9999999999999996e-165 -test util-16.1.17.-163 {8.4 compatible formatting of doubles} precision \ - {expr {1e-163}} \ - 9.9999999999999992e-164 -test util-16.1.17.-162 {8.4 compatible formatting of doubles} precision \ - {expr {1e-162}} \ - 9.9999999999999995e-163 -test util-16.1.17.-161 {8.4 compatible formatting of doubles} precision \ - {expr {1e-161}} \ - 1e-161 -test util-16.1.17.-160 {8.4 compatible formatting of doubles} precision \ - {expr {1e-160}} \ - 9.9999999999999999e-161 -test util-16.1.17.-159 {8.4 compatible formatting of doubles} precision \ - {expr {1e-159}} \ - 9.9999999999999999e-160 -test util-16.1.17.-158 {8.4 compatible formatting of doubles} precision \ - {expr {1e-158}} \ - 1.0000000000000001e-158 -test util-16.1.17.-157 {8.4 compatible formatting of doubles} precision \ - {expr {1e-157}} \ - 9.9999999999999994e-158 -test util-16.1.17.-156 {8.4 compatible formatting of doubles} precision \ - {expr {1e-156}} \ - 1e-156 -test util-16.1.17.-155 {8.4 compatible formatting of doubles} precision \ - {expr {1e-155}} \ - 1e-155 -test util-16.1.17.-154 {8.4 compatible formatting of doubles} precision \ - {expr {1e-154}} \ - 9.9999999999999997e-155 -test util-16.1.17.-153 {8.4 compatible formatting of doubles} precision \ - {expr {1e-153}} \ - 1e-153 -test util-16.1.17.-152 {8.4 compatible formatting of doubles} precision \ - {expr {1e-152}} \ - 1.0000000000000001e-152 -test util-16.1.17.-151 {8.4 compatible formatting of doubles} precision \ - {expr {1e-151}} \ - 9.9999999999999994e-152 -test util-16.1.17.-150 {8.4 compatible formatting of doubles} precision \ - {expr {1e-150}} \ - 1e-150 -test util-16.1.17.-149 {8.4 compatible formatting of doubles} precision \ - {expr {1e-149}} \ - 9.9999999999999998e-150 -test util-16.1.17.-148 {8.4 compatible formatting of doubles} precision \ - {expr {1e-148}} \ - 9.9999999999999994e-149 -test util-16.1.17.-147 {8.4 compatible formatting of doubles} precision \ - {expr {1e-147}} \ - 9.9999999999999997e-148 -test util-16.1.17.-146 {8.4 compatible formatting of doubles} precision \ - {expr {1e-146}} \ - 1e-146 -test util-16.1.17.-145 {8.4 compatible formatting of doubles} precision \ - {expr {1e-145}} \ - 9.9999999999999991e-146 -test util-16.1.17.-144 {8.4 compatible formatting of doubles} precision \ - {expr {1e-144}} \ - 9.9999999999999995e-145 -test util-16.1.17.-143 {8.4 compatible formatting of doubles} precision \ - {expr {1e-143}} \ - 9.9999999999999995e-144 -test util-16.1.17.-142 {8.4 compatible formatting of doubles} precision \ - {expr {1e-142}} \ - 1e-142 -test util-16.1.17.-141 {8.4 compatible formatting of doubles} precision \ - {expr {1e-141}} \ - 1e-141 -test util-16.1.17.-140 {8.4 compatible formatting of doubles} precision \ - {expr {1e-140}} \ - 9.9999999999999998e-141 -test util-16.1.17.-139 {8.4 compatible formatting of doubles} precision \ - {expr {1e-139}} \ - 1e-139 -test util-16.1.17.-138 {8.4 compatible formatting of doubles} precision \ - {expr {1e-138}} \ - 1.0000000000000001e-138 -test util-16.1.17.-137 {8.4 compatible formatting of doubles} precision \ - {expr {1e-137}} \ - 9.9999999999999998e-138 -test util-16.1.17.-136 {8.4 compatible formatting of doubles} precision \ - {expr {1e-136}} \ - 1e-136 -test util-16.1.17.-135 {8.4 compatible formatting of doubles} precision \ - {expr {1e-135}} \ - 1e-135 -test util-16.1.17.-134 {8.4 compatible formatting of doubles} precision \ - {expr {1e-134}} \ - 1e-134 -test util-16.1.17.-133 {8.4 compatible formatting of doubles} precision \ - {expr {1e-133}} \ - 1.0000000000000001e-133 -test util-16.1.17.-132 {8.4 compatible formatting of doubles} precision \ - {expr {1e-132}} \ - 9.9999999999999999e-133 -test util-16.1.17.-131 {8.4 compatible formatting of doubles} precision \ - {expr {1e-131}} \ - 9.9999999999999999e-132 -test util-16.1.17.-130 {8.4 compatible formatting of doubles} precision \ - {expr {1e-130}} \ - 1.0000000000000001e-130 -test util-16.1.17.-129 {8.4 compatible formatting of doubles} precision \ - {expr {1e-129}} \ - 9.9999999999999993e-130 -test util-16.1.17.-128 {8.4 compatible formatting of doubles} precision \ - {expr {1e-128}} \ - 1.0000000000000001e-128 -test util-16.1.17.-127 {8.4 compatible formatting of doubles} precision \ - {expr {1e-127}} \ - 1e-127 -test util-16.1.17.-126 {8.4 compatible formatting of doubles} precision \ - {expr {1e-126}} \ - 9.9999999999999995e-127 -test util-16.1.17.-125 {8.4 compatible formatting of doubles} precision \ - {expr {1e-125}} \ - 1e-125 -test util-16.1.17.-124 {8.4 compatible formatting of doubles} precision \ - {expr {1e-124}} \ - 9.9999999999999993e-125 -test util-16.1.17.-123 {8.4 compatible formatting of doubles} precision \ - {expr {1e-123}} \ - 1.0000000000000001e-123 -test util-16.1.17.-122 {8.4 compatible formatting of doubles} precision \ - {expr {1e-122}} \ - 1.0000000000000001e-122 -test util-16.1.17.-121 {8.4 compatible formatting of doubles} precision \ - {expr {1e-121}} \ - 9.9999999999999998e-122 -test util-16.1.17.-120 {8.4 compatible formatting of doubles} precision \ - {expr {1e-120}} \ - 9.9999999999999998e-121 -test util-16.1.17.-119 {8.4 compatible formatting of doubles} precision \ - {expr {1e-119}} \ - 1e-119 -test util-16.1.17.-118 {8.4 compatible formatting of doubles} precision \ - {expr {1e-118}} \ - 9.9999999999999999e-119 -test util-16.1.17.-117 {8.4 compatible formatting of doubles} precision \ - {expr {1e-117}} \ - 1e-117 -test util-16.1.17.-116 {8.4 compatible formatting of doubles} precision \ - {expr {1e-116}} \ - 9.9999999999999999e-117 -test util-16.1.17.-115 {8.4 compatible formatting of doubles} precision \ - {expr {1e-115}} \ - 1.0000000000000001e-115 -test util-16.1.17.-114 {8.4 compatible formatting of doubles} precision \ - {expr {1e-114}} \ - 1.0000000000000001e-114 -test util-16.1.17.-113 {8.4 compatible formatting of doubles} precision \ - {expr {1e-113}} \ - 9.9999999999999998e-114 -test util-16.1.17.-112 {8.4 compatible formatting of doubles} precision \ - {expr {1e-112}} \ - 9.9999999999999995e-113 -test util-16.1.17.-111 {8.4 compatible formatting of doubles} precision \ - {expr {1e-111}} \ - 1.0000000000000001e-111 -test util-16.1.17.-110 {8.4 compatible formatting of doubles} precision \ - {expr {1e-110}} \ - 1.0000000000000001e-110 -test util-16.1.17.-109 {8.4 compatible formatting of doubles} precision \ - {expr {1e-109}} \ - 9.9999999999999999e-110 -test util-16.1.17.-108 {8.4 compatible formatting of doubles} precision \ - {expr {1e-108}} \ - 1e-108 -test util-16.1.17.-107 {8.4 compatible formatting of doubles} precision \ - {expr {1e-107}} \ - 1e-107 -test util-16.1.17.-106 {8.4 compatible formatting of doubles} precision \ - {expr {1e-106}} \ - 9.9999999999999994e-107 -test util-16.1.17.-105 {8.4 compatible formatting of doubles} precision \ - {expr {1e-105}} \ - 9.9999999999999997e-106 -test util-16.1.17.-104 {8.4 compatible formatting of doubles} precision \ - {expr {1e-104}} \ - 9.9999999999999993e-105 -test util-16.1.17.-103 {8.4 compatible formatting of doubles} precision \ - {expr {1e-103}} \ - 9.9999999999999996e-104 -test util-16.1.17.-102 {8.4 compatible formatting of doubles} precision \ - {expr {1e-102}} \ - 9.9999999999999993e-103 -test util-16.1.17.-101 {8.4 compatible formatting of doubles} precision \ - {expr {1e-101}} \ - 1.0000000000000001e-101 -test util-16.1.17.-100 {8.4 compatible formatting of doubles} precision \ - {expr {1e-100}} \ - 1e-100 -test util-16.1.17.-99 {8.4 compatible formatting of doubles} precision \ - {expr {1e-99}} \ - 1e-99 -test util-16.1.17.-98 {8.4 compatible formatting of doubles} precision \ - {expr {1e-98}} \ - 9.9999999999999994e-99 -test util-16.1.17.-97 {8.4 compatible formatting of doubles} precision \ - {expr {1e-97}} \ - 1e-97 -test util-16.1.17.-96 {8.4 compatible formatting of doubles} precision \ - {expr {1e-96}} \ - 9.9999999999999991e-97 -test util-16.1.17.-95 {8.4 compatible formatting of doubles} precision \ - {expr {1e-95}} \ - 9.9999999999999999e-96 -test util-16.1.17.-94 {8.4 compatible formatting of doubles} precision \ - {expr {1e-94}} \ - 9.9999999999999996e-95 -test util-16.1.17.-93 {8.4 compatible formatting of doubles} precision \ - {expr {1e-93}} \ - 9.999999999999999e-94 -test util-16.1.17.-92 {8.4 compatible formatting of doubles} precision \ - {expr {1e-92}} \ - 9.9999999999999999e-93 -test util-16.1.17.-91 {8.4 compatible formatting of doubles} precision \ - {expr {1e-91}} \ - 1e-91 -test util-16.1.17.-90 {8.4 compatible formatting of doubles} precision \ - {expr {1e-90}} \ - 9.9999999999999999e-91 -test util-16.1.17.-89 {8.4 compatible formatting of doubles} precision \ - {expr {1e-89}} \ - 1e-89 -test util-16.1.17.-88 {8.4 compatible formatting of doubles} precision \ - {expr {1e-88}} \ - 9.9999999999999993e-89 -test util-16.1.17.-87 {8.4 compatible formatting of doubles} precision \ - {expr {1e-87}} \ - 1e-87 -test util-16.1.17.-86 {8.4 compatible formatting of doubles} precision \ - {expr {1e-86}} \ - 1.0000000000000001e-86 -test util-16.1.17.-85 {8.4 compatible formatting of doubles} precision \ - {expr {1e-85}} \ - 9.9999999999999998e-86 -test util-16.1.17.-84 {8.4 compatible formatting of doubles} precision \ - {expr {1e-84}} \ - 1e-84 -test util-16.1.17.-83 {8.4 compatible formatting of doubles} precision \ - {expr {1e-83}} \ - 1e-83 -test util-16.1.17.-82 {8.4 compatible formatting of doubles} precision \ - {expr {1e-82}} \ - 9.9999999999999996e-83 -test util-16.1.17.-81 {8.4 compatible formatting of doubles} precision \ - {expr {1e-81}} \ - 9.9999999999999996e-82 -test util-16.1.17.-80 {8.4 compatible formatting of doubles} precision \ - {expr {1e-80}} \ - 9.9999999999999996e-81 -test util-16.1.17.-79 {8.4 compatible formatting of doubles} precision \ - {expr {1e-79}} \ - 1e-79 -test util-16.1.17.-78 {8.4 compatible formatting of doubles} precision \ - {expr {1e-78}} \ - 1e-78 -test util-16.1.17.-77 {8.4 compatible formatting of doubles} precision \ - {expr {1e-77}} \ - 9.9999999999999993e-78 -test util-16.1.17.-76 {8.4 compatible formatting of doubles} precision \ - {expr {1e-76}} \ - 9.9999999999999993e-77 -test util-16.1.17.-75 {8.4 compatible formatting of doubles} precision \ - {expr {1e-75}} \ - 9.9999999999999996e-76 -test util-16.1.17.-74 {8.4 compatible formatting of doubles} precision \ - {expr {1e-74}} \ - 9.9999999999999996e-75 -test util-16.1.17.-73 {8.4 compatible formatting of doubles} precision \ - {expr {1e-73}} \ - 1e-73 -test util-16.1.17.-72 {8.4 compatible formatting of doubles} precision \ - {expr {1e-72}} \ - 9.9999999999999997e-73 -test util-16.1.17.-71 {8.4 compatible formatting of doubles} precision \ - {expr {1e-71}} \ - 9.9999999999999992e-72 -test util-16.1.17.-70 {8.4 compatible formatting of doubles} precision \ - {expr {1e-70}} \ - 1e-70 -test util-16.1.17.-69 {8.4 compatible formatting of doubles} precision \ - {expr {1e-69}} \ - 9.9999999999999996e-70 -test util-16.1.17.-68 {8.4 compatible formatting of doubles} precision \ - {expr {1e-68}} \ - 1.0000000000000001e-68 -test util-16.1.17.-67 {8.4 compatible formatting of doubles} precision \ - {expr {1e-67}} \ - 9.9999999999999994e-68 -test util-16.1.17.-66 {8.4 compatible formatting of doubles} precision \ - {expr {1e-66}} \ - 9.9999999999999998e-67 -test util-16.1.17.-65 {8.4 compatible formatting of doubles} precision \ - {expr {1e-65}} \ - 9.9999999999999992e-66 -test util-16.1.17.-64 {8.4 compatible formatting of doubles} precision \ - {expr {1e-64}} \ - 9.9999999999999997e-65 -test util-16.1.17.-63 {8.4 compatible formatting of doubles} precision \ - {expr {1e-63}} \ - 1.0000000000000001e-63 -test util-16.1.17.-62 {8.4 compatible formatting of doubles} precision \ - {expr {1e-62}} \ - 1e-62 -test util-16.1.17.-61 {8.4 compatible formatting of doubles} precision \ - {expr {1e-61}} \ - 1e-61 -test util-16.1.17.-60 {8.4 compatible formatting of doubles} precision \ - {expr {1e-60}} \ - 9.9999999999999997e-61 -test util-16.1.17.-59 {8.4 compatible formatting of doubles} precision \ - {expr {1e-59}} \ - 1e-59 -test util-16.1.17.-58 {8.4 compatible formatting of doubles} precision \ - {expr {1e-58}} \ - 1e-58 -test util-16.1.17.-57 {8.4 compatible formatting of doubles} precision \ - {expr {1e-57}} \ - 9.9999999999999995e-58 -test util-16.1.17.-56 {8.4 compatible formatting of doubles} precision \ - {expr {1e-56}} \ - 1e-56 -test util-16.1.17.-55 {8.4 compatible formatting of doubles} precision \ - {expr {1e-55}} \ - 9.9999999999999999e-56 -test util-16.1.17.-54 {8.4 compatible formatting of doubles} precision \ - {expr {1e-54}} \ - 1e-54 -test util-16.1.17.-53 {8.4 compatible formatting of doubles} precision \ - {expr {1e-53}} \ - 1e-53 -test util-16.1.17.-52 {8.4 compatible formatting of doubles} precision \ - {expr {1e-52}} \ - 1e-52 -test util-16.1.17.-51 {8.4 compatible formatting of doubles} precision \ - {expr {1e-51}} \ - 1e-51 -test util-16.1.17.-50 {8.4 compatible formatting of doubles} precision \ - {expr {1e-50}} \ - 1e-50 -test util-16.1.17.-49 {8.4 compatible formatting of doubles} precision \ - {expr {1e-49}} \ - 9.9999999999999994e-50 -test util-16.1.17.-48 {8.4 compatible formatting of doubles} precision \ - {expr {1e-48}} \ - 9.9999999999999997e-49 -test util-16.1.17.-47 {8.4 compatible formatting of doubles} precision \ - {expr {1e-47}} \ - 9.9999999999999997e-48 -test util-16.1.17.-46 {8.4 compatible formatting of doubles} precision \ - {expr {1e-46}} \ - 1e-46 -test util-16.1.17.-45 {8.4 compatible formatting of doubles} precision \ - {expr {1e-45}} \ - 9.9999999999999998e-46 -test util-16.1.17.-44 {8.4 compatible formatting of doubles} precision \ - {expr {1e-44}} \ - 9.9999999999999995e-45 -test util-16.1.17.-43 {8.4 compatible formatting of doubles} precision \ - {expr {1e-43}} \ - 1.0000000000000001e-43 -test util-16.1.17.-42 {8.4 compatible formatting of doubles} precision \ - {expr {1e-42}} \ - 1e-42 -test util-16.1.17.-41 {8.4 compatible formatting of doubles} precision \ - {expr {1e-41}} \ - 1e-41 -test util-16.1.17.-40 {8.4 compatible formatting of doubles} precision \ - {expr {1e-40}} \ - 9.9999999999999993e-41 -test util-16.1.17.-39 {8.4 compatible formatting of doubles} precision \ - {expr {1e-39}} \ - 9.9999999999999993e-40 -test util-16.1.17.-38 {8.4 compatible formatting of doubles} precision \ - {expr {1e-38}} \ - 9.9999999999999996e-39 -test util-16.1.17.-37 {8.4 compatible formatting of doubles} precision \ - {expr {1e-37}} \ - 1.0000000000000001e-37 -test util-16.1.17.-36 {8.4 compatible formatting of doubles} precision \ - {expr {1e-36}} \ - 9.9999999999999994e-37 -test util-16.1.17.-35 {8.4 compatible formatting of doubles} precision \ - {expr {1e-35}} \ - 1e-35 -test util-16.1.17.-34 {8.4 compatible formatting of doubles} precision \ - {expr {1e-34}} \ - 9.9999999999999993e-35 -test util-16.1.17.-33 {8.4 compatible formatting of doubles} precision \ - {expr {1e-33}} \ - 1.0000000000000001e-33 -test util-16.1.17.-32 {8.4 compatible formatting of doubles} precision \ - {expr {1e-32}} \ - 1.0000000000000001e-32 -test util-16.1.17.-31 {8.4 compatible formatting of doubles} precision \ - {expr {1e-31}} \ - 1.0000000000000001e-31 -test util-16.1.17.-30 {8.4 compatible formatting of doubles} precision \ - {expr {1e-30}} \ - 1.0000000000000001e-30 -test util-16.1.17.-29 {8.4 compatible formatting of doubles} precision \ - {expr {1e-29}} \ - 9.9999999999999994e-30 -test util-16.1.17.-28 {8.4 compatible formatting of doubles} precision \ - {expr {1e-28}} \ - 9.9999999999999997e-29 -test util-16.1.17.-27 {8.4 compatible formatting of doubles} precision \ - {expr {1e-27}} \ - 1e-27 -test util-16.1.17.-26 {8.4 compatible formatting of doubles} precision \ - {expr {1e-26}} \ - 1e-26 -test util-16.1.17.-25 {8.4 compatible formatting of doubles} precision \ - {expr {1e-25}} \ - 1e-25 -test util-16.1.17.-24 {8.4 compatible formatting of doubles} precision \ - {expr {1e-24}} \ - 9.9999999999999992e-25 -test util-16.1.17.-23 {8.4 compatible formatting of doubles} precision \ - {expr {1e-23}} \ - 9.9999999999999996e-24 -test util-16.1.17.-22 {8.4 compatible formatting of doubles} precision \ - {expr {1e-22}} \ - 1e-22 -test util-16.1.17.-21 {8.4 compatible formatting of doubles} precision \ - {expr {1e-21}} \ - 9.9999999999999991e-22 -test util-16.1.17.-20 {8.4 compatible formatting of doubles} precision \ - {expr {1e-20}} \ - 9.9999999999999995e-21 -test util-16.1.17.-19 {8.4 compatible formatting of doubles} precision \ - {expr {1e-19}} \ - 9.9999999999999998e-20 -test util-16.1.17.-18 {8.4 compatible formatting of doubles} precision \ - {expr {1e-18}} \ - 1.0000000000000001e-18 -test util-16.1.17.-17 {8.4 compatible formatting of doubles} precision \ - {expr {1e-17}} \ - 1.0000000000000001e-17 -test util-16.1.17.-16 {8.4 compatible formatting of doubles} precision \ - {expr {1e-16}} \ - 9.9999999999999998e-17 -test util-16.1.17.-15 {8.4 compatible formatting of doubles} precision \ - {expr {1e-15}} \ - 1.0000000000000001e-15 -test util-16.1.17.-14 {8.4 compatible formatting of doubles} precision \ - {expr {1e-14}} \ - 1e-14 -test util-16.1.17.-13 {8.4 compatible formatting of doubles} precision \ - {expr {1e-13}} \ - 1e-13 -test util-16.1.17.-12 {8.4 compatible formatting of doubles} precision \ - {expr {1e-12}} \ - 9.9999999999999998e-13 -test util-16.1.17.-11 {8.4 compatible formatting of doubles} precision \ - {expr {1e-11}} \ - 9.9999999999999994e-12 -test util-16.1.17.-10 {8.4 compatible formatting of doubles} precision \ - {expr {1e-10}} \ - 1e-10 -test util-16.1.17.-9 {8.4 compatible formatting of doubles} precision \ - {expr {1e-9}} \ - 1.0000000000000001e-09 -test util-16.1.17.-8 {8.4 compatible formatting of doubles} precision \ - {expr {1e-8}} \ - 1e-08 -test util-16.1.17.-7 {8.4 compatible formatting of doubles} precision \ - {expr {1e-7}} \ - 9.9999999999999995e-08 -test util-16.1.17.-6 {8.4 compatible formatting of doubles} precision \ - {expr {1e-6}} \ - 9.9999999999999995e-07 -test util-16.1.17.-5 {8.4 compatible formatting of doubles} precision \ - {expr {1e-5}} \ - 1.0000000000000001e-05 -test util-16.1.17.-4 {8.4 compatible formatting of doubles} precision \ - {expr {1e-4}} \ - 0.0001 -test util-16.1.17.-3 {8.4 compatible formatting of doubles} precision \ - {expr {1e-3}} \ - 0.001 -test util-16.1.17.-2 {8.4 compatible formatting of doubles} precision \ - {expr {1e-2}} \ - 0.01 -test util-16.1.17.-1 {8.4 compatible formatting of doubles} precision \ - {expr {1e-1}} \ - 0.10000000000000001 -test util-16.1.17.0 {8.4 compatible formatting of doubles} precision \ - {expr {1e0}} \ - 1.0 -test util-16.1.17.1 {8.4 compatible formatting of doubles} precision \ - {expr {1e1}} \ - 10.0 -test util-16.1.17.2 {8.4 compatible formatting of doubles} precision \ - {expr {1e2}} \ - 100.0 -test util-16.1.17.3 {8.4 compatible formatting of doubles} precision \ - {expr {1e3}} \ - 1000.0 -test util-16.1.17.4 {8.4 compatible formatting of doubles} precision \ - {expr {1e4}} \ - 10000.0 -test util-16.1.17.5 {8.4 compatible formatting of doubles} precision \ - {expr {1e5}} \ - 100000.0 -test util-16.1.17.6 {8.4 compatible formatting of doubles} precision \ - {expr {1e6}} \ - 1000000.0 -test util-16.1.17.7 {8.4 compatible formatting of doubles} precision \ - {expr {1e7}} \ - 10000000.0 -test util-16.1.17.8 {8.4 compatible formatting of doubles} precision \ - {expr {1e8}} \ - 100000000.0 -test util-16.1.17.9 {8.4 compatible formatting of doubles} precision \ - {expr {1e9}} \ - 1000000000.0 -test util-16.1.17.10 {8.4 compatible formatting of doubles} precision \ - {expr {1e10}} \ - 10000000000.0 -test util-16.1.17.11 {8.4 compatible formatting of doubles} precision \ - {expr {1e11}} \ - 100000000000.0 -test util-16.1.17.12 {8.4 compatible formatting of doubles} precision \ - {expr {1e12}} \ - 1000000000000.0 -test util-16.1.17.13 {8.4 compatible formatting of doubles} precision \ - {expr {1e13}} \ - 10000000000000.0 -test util-16.1.17.14 {8.4 compatible formatting of doubles} precision \ - {expr {1e14}} \ - 100000000000000.0 -test util-16.1.17.15 {8.4 compatible formatting of doubles} precision \ - {expr {1e15}} \ - 1000000000000000.0 -test util-16.1.17.16 {8.4 compatible formatting of doubles} precision \ - {expr {1e16}} \ - 10000000000000000.0 -test util-16.1.17.17 {8.4 compatible formatting of doubles} precision \ - {expr {1e17}} \ - 1e+17 -test util-16.1.17.18 {8.4 compatible formatting of doubles} precision \ - {expr {1e18}} \ - 1e+18 -test util-16.1.17.19 {8.4 compatible formatting of doubles} precision \ - {expr {1e19}} \ - 1e+19 -test util-16.1.17.20 {8.4 compatible formatting of doubles} precision \ - {expr {1e20}} \ - 1e+20 -test util-16.1.17.21 {8.4 compatible formatting of doubles} precision \ - {expr {1e21}} \ - 1e+21 -test util-16.1.17.22 {8.4 compatible formatting of doubles} precision \ - {expr {1e22}} \ - 1e+22 -test util-16.1.17.23 {8.4 compatible formatting of doubles} precision \ - {expr {1e23}} \ - 9.9999999999999992e+22 -test util-16.1.17.24 {8.4 compatible formatting of doubles} precision \ - {expr {1e24}} \ - 9.9999999999999998e+23 -test util-16.1.17.25 {8.4 compatible formatting of doubles} precision \ - {expr {1e25}} \ - 1.0000000000000001e+25 -test util-16.1.17.26 {8.4 compatible formatting of doubles} precision \ - {expr {1e26}} \ - 1e+26 -test util-16.1.17.27 {8.4 compatible formatting of doubles} precision \ - {expr {1e27}} \ - 1e+27 -test util-16.1.17.28 {8.4 compatible formatting of doubles} precision \ - {expr {1e28}} \ - 9.9999999999999996e+27 -test util-16.1.17.29 {8.4 compatible formatting of doubles} precision \ - {expr {1e29}} \ - 9.9999999999999991e+28 -test util-16.1.17.30 {8.4 compatible formatting of doubles} precision \ - {expr {1e30}} \ - 1e+30 -test util-16.1.17.31 {8.4 compatible formatting of doubles} precision \ - {expr {1e31}} \ - 9.9999999999999996e+30 -test util-16.1.17.32 {8.4 compatible formatting of doubles} precision \ - {expr {1e32}} \ - 1.0000000000000001e+32 -test util-16.1.17.33 {8.4 compatible formatting of doubles} precision \ - {expr {1e33}} \ - 9.9999999999999995e+32 -test util-16.1.17.34 {8.4 compatible formatting of doubles} precision \ - {expr {1e34}} \ - 9.9999999999999995e+33 -test util-16.1.17.35 {8.4 compatible formatting of doubles} precision \ - {expr {1e35}} \ - 9.9999999999999997e+34 -test util-16.1.17.36 {8.4 compatible formatting of doubles} precision \ - {expr {1e36}} \ - 1e+36 -test util-16.1.17.37 {8.4 compatible formatting of doubles} precision \ - {expr {1e37}} \ - 9.9999999999999995e+36 -test util-16.1.17.38 {8.4 compatible formatting of doubles} precision \ - {expr {1e38}} \ - 9.9999999999999998e+37 -test util-16.1.17.39 {8.4 compatible formatting of doubles} precision \ - {expr {1e39}} \ - 9.9999999999999994e+38 -test util-16.1.17.40 {8.4 compatible formatting of doubles} precision \ - {expr {1e40}} \ - 1e+40 -test util-16.1.17.41 {8.4 compatible formatting of doubles} precision \ - {expr {1e41}} \ - 1e+41 -test util-16.1.17.42 {8.4 compatible formatting of doubles} precision \ - {expr {1e42}} \ - 1e+42 -test util-16.1.17.43 {8.4 compatible formatting of doubles} precision \ - {expr {1e43}} \ - 1e+43 -test util-16.1.17.44 {8.4 compatible formatting of doubles} precision \ - {expr {1e44}} \ - 1.0000000000000001e+44 -test util-16.1.17.45 {8.4 compatible formatting of doubles} precision \ - {expr {1e45}} \ - 9.9999999999999993e+44 -test util-16.1.17.46 {8.4 compatible formatting of doubles} precision \ - {expr {1e46}} \ - 9.9999999999999999e+45 -test util-16.1.17.47 {8.4 compatible formatting of doubles} precision \ - {expr {1e47}} \ - 1e+47 -test util-16.1.17.48 {8.4 compatible formatting of doubles} precision \ - {expr {1e48}} \ - 1e+48 -test util-16.1.17.49 {8.4 compatible formatting of doubles} precision \ - {expr {1e49}} \ - 9.9999999999999995e+48 -test util-16.1.17.50 {8.4 compatible formatting of doubles} precision \ - {expr {1e50}} \ - 1.0000000000000001e+50 -test util-16.1.17.51 {8.4 compatible formatting of doubles} precision \ - {expr {1e51}} \ - 9.9999999999999999e+50 -test util-16.1.17.52 {8.4 compatible formatting of doubles} precision \ - {expr {1e52}} \ - 9.9999999999999999e+51 -test util-16.1.17.53 {8.4 compatible formatting of doubles} precision \ - {expr {1e53}} \ - 9.9999999999999999e+52 -test util-16.1.17.54 {8.4 compatible formatting of doubles} precision \ - {expr {1e54}} \ - 1.0000000000000001e+54 -test util-16.1.17.55 {8.4 compatible formatting of doubles} precision \ - {expr {1e55}} \ - 1e+55 -test util-16.1.17.56 {8.4 compatible formatting of doubles} precision \ - {expr {1e56}} \ - 1.0000000000000001e+56 -test util-16.1.17.57 {8.4 compatible formatting of doubles} precision \ - {expr {1e57}} \ - 1e+57 -test util-16.1.17.58 {8.4 compatible formatting of doubles} precision \ - {expr {1e58}} \ - 9.9999999999999994e+57 -test util-16.1.17.59 {8.4 compatible formatting of doubles} precision \ - {expr {1e59}} \ - 9.9999999999999997e+58 -test util-16.1.17.60 {8.4 compatible formatting of doubles} precision \ - {expr {1e60}} \ - 9.9999999999999995e+59 -test util-16.1.17.61 {8.4 compatible formatting of doubles} precision \ - {expr {1e61}} \ - 9.9999999999999995e+60 -test util-16.1.17.62 {8.4 compatible formatting of doubles} precision \ - {expr {1e62}} \ - 1e+62 -test util-16.1.17.63 {8.4 compatible formatting of doubles} precision \ - {expr {1e63}} \ - 1.0000000000000001e+63 -test util-16.1.17.64 {8.4 compatible formatting of doubles} precision \ - {expr {1e64}} \ - 1e+64 -test util-16.1.17.65 {8.4 compatible formatting of doubles} precision \ - {expr {1e65}} \ - 9.9999999999999999e+64 -test util-16.1.17.66 {8.4 compatible formatting of doubles} precision \ - {expr {1e66}} \ - 9.9999999999999995e+65 -test util-16.1.17.67 {8.4 compatible formatting of doubles} precision \ - {expr {1e67}} \ - 9.9999999999999998e+66 -test util-16.1.17.68 {8.4 compatible formatting of doubles} precision \ - {expr {1e68}} \ - 9.9999999999999995e+67 -test util-16.1.17.69 {8.4 compatible formatting of doubles} precision \ - {expr {1e69}} \ - 1.0000000000000001e+69 -test util-16.1.17.70 {8.4 compatible formatting of doubles} precision \ - {expr {1e70}} \ - 1.0000000000000001e+70 -test util-16.1.17.71 {8.4 compatible formatting of doubles} precision \ - {expr {1e71}} \ - 1e+71 -test util-16.1.17.72 {8.4 compatible formatting of doubles} precision \ - {expr {1e72}} \ - 9.9999999999999994e+71 -test util-16.1.17.73 {8.4 compatible formatting of doubles} precision \ - {expr {1e73}} \ - 9.9999999999999998e+72 -test util-16.1.17.74 {8.4 compatible formatting of doubles} precision \ - {expr {1e74}} \ - 9.9999999999999995e+73 -test util-16.1.17.75 {8.4 compatible formatting of doubles} precision \ - {expr {1e75}} \ - 9.9999999999999993e+74 -test util-16.1.17.76 {8.4 compatible formatting of doubles} precision \ - {expr {1e76}} \ - 1e+76 -test util-16.1.17.77 {8.4 compatible formatting of doubles} precision \ - {expr {1e77}} \ - 9.9999999999999998e+76 -test util-16.1.17.78 {8.4 compatible formatting of doubles} precision \ - {expr {1e78}} \ - 1e+78 -test util-16.1.17.79 {8.4 compatible formatting of doubles} precision \ - {expr {1e79}} \ - 9.9999999999999997e+78 -test util-16.1.17.80 {8.4 compatible formatting of doubles} precision \ - {expr {1e80}} \ - 1e+80 -test util-16.1.17.81 {8.4 compatible formatting of doubles} precision \ - {expr {1e81}} \ - 9.9999999999999992e+80 -test util-16.1.17.82 {8.4 compatible formatting of doubles} precision \ - {expr {1e82}} \ - 9.9999999999999996e+81 -test util-16.1.17.83 {8.4 compatible formatting of doubles} precision \ - {expr {1e83}} \ - 1e+83 -test util-16.1.17.84 {8.4 compatible formatting of doubles} precision \ - {expr {1e84}} \ - 1.0000000000000001e+84 -test util-16.1.17.85 {8.4 compatible formatting of doubles} precision \ - {expr {1e85}} \ - 1e+85 -test util-16.1.17.86 {8.4 compatible formatting of doubles} precision \ - {expr {1e86}} \ - 1e+86 -test util-16.1.17.87 {8.4 compatible formatting of doubles} precision \ - {expr {1e87}} \ - 9.9999999999999996e+86 -test util-16.1.17.88 {8.4 compatible formatting of doubles} precision \ - {expr {1e88}} \ - 9.9999999999999996e+87 -test util-16.1.17.89 {8.4 compatible formatting of doubles} precision \ - {expr {1e89}} \ - 9.9999999999999999e+88 -test util-16.1.17.90 {8.4 compatible formatting of doubles} precision \ - {expr {1e90}} \ - 9.9999999999999997e+89 -test util-16.1.17.91 {8.4 compatible formatting of doubles} precision \ - {expr {1e91}} \ - 1.0000000000000001e+91 -test util-16.1.17.92 {8.4 compatible formatting of doubles} precision \ - {expr {1e92}} \ - 1e+92 -test util-16.1.17.93 {8.4 compatible formatting of doubles} precision \ - {expr {1e93}} \ - 1e+93 -test util-16.1.17.94 {8.4 compatible formatting of doubles} precision \ - {expr {1e94}} \ - 1e+94 -test util-16.1.17.95 {8.4 compatible formatting of doubles} precision \ - {expr {1e95}} \ - 1e+95 -test util-16.1.17.96 {8.4 compatible formatting of doubles} precision \ - {expr {1e96}} \ - 1e+96 -test util-16.1.17.97 {8.4 compatible formatting of doubles} precision \ - {expr {1e97}} \ - 1.0000000000000001e+97 -test util-16.1.17.98 {8.4 compatible formatting of doubles} precision \ - {expr {1e98}} \ - 1e+98 -test util-16.1.17.99 {8.4 compatible formatting of doubles} precision \ - {expr {1e99}} \ - 9.9999999999999997e+98 -test util-16.1.17.100 {8.4 compatible formatting of doubles} precision \ - {expr {1e100}} \ - 1e+100 -test util-16.1.17.101 {8.4 compatible formatting of doubles} precision \ - {expr {1e101}} \ - 9.9999999999999998e+100 -test util-16.1.17.102 {8.4 compatible formatting of doubles} precision \ - {expr {1e102}} \ - 9.9999999999999998e+101 -test util-16.1.17.103 {8.4 compatible formatting of doubles} precision \ - {expr {1e103}} \ - 1e+103 -test util-16.1.17.104 {8.4 compatible formatting of doubles} precision \ - {expr {1e104}} \ - 1e+104 -test util-16.1.17.105 {8.4 compatible formatting of doubles} precision \ - {expr {1e105}} \ - 9.9999999999999994e+104 -test util-16.1.17.106 {8.4 compatible formatting of doubles} precision \ - {expr {1e106}} \ - 1.0000000000000001e+106 -test util-16.1.17.107 {8.4 compatible formatting of doubles} precision \ - {expr {1e107}} \ - 9.9999999999999997e+106 -test util-16.1.17.108 {8.4 compatible formatting of doubles} precision \ - {expr {1e108}} \ - 1e+108 -test util-16.1.17.109 {8.4 compatible formatting of doubles} precision \ - {expr {1e109}} \ - 9.9999999999999998e+108 -test util-16.1.17.110 {8.4 compatible formatting of doubles} precision \ - {expr {1e110}} \ - 1e+110 -test util-16.1.17.111 {8.4 compatible formatting of doubles} precision \ - {expr {1e111}} \ - 9.9999999999999996e+110 -test util-16.1.17.112 {8.4 compatible formatting of doubles} precision \ - {expr {1e112}} \ - 9.9999999999999993e+111 -test util-16.1.17.113 {8.4 compatible formatting of doubles} precision \ - {expr {1e113}} \ - 1e+113 -test util-16.1.17.114 {8.4 compatible formatting of doubles} precision \ - {expr {1e114}} \ - 1e+114 -test util-16.1.17.115 {8.4 compatible formatting of doubles} precision \ - {expr {1e115}} \ - 1e+115 -test util-16.1.17.116 {8.4 compatible formatting of doubles} precision \ - {expr {1e116}} \ - 1e+116 -test util-16.1.17.117 {8.4 compatible formatting of doubles} precision \ - {expr {1e117}} \ - 1.0000000000000001e+117 -test util-16.1.17.118 {8.4 compatible formatting of doubles} precision \ - {expr {1e118}} \ - 9.9999999999999997e+117 -test util-16.1.17.119 {8.4 compatible formatting of doubles} precision \ - {expr {1e119}} \ - 9.9999999999999994e+118 -test util-16.1.17.120 {8.4 compatible formatting of doubles} precision \ - {expr {1e120}} \ - 9.9999999999999998e+119 -test util-16.1.17.121 {8.4 compatible formatting of doubles} precision \ - {expr {1e121}} \ - 1e+121 -test util-16.1.17.122 {8.4 compatible formatting of doubles} precision \ - {expr {1e122}} \ - 1e+122 -test util-16.1.17.123 {8.4 compatible formatting of doubles} precision \ - {expr {1e123}} \ - 9.9999999999999998e+122 -test util-16.1.17.124 {8.4 compatible formatting of doubles} precision \ - {expr {1e124}} \ - 9.9999999999999995e+123 -test util-16.1.17.125 {8.4 compatible formatting of doubles} precision \ - {expr {1e125}} \ - 9.9999999999999992e+124 -test util-16.1.17.126 {8.4 compatible formatting of doubles} precision \ - {expr {1e126}} \ - 9.9999999999999992e+125 -test util-16.1.17.127 {8.4 compatible formatting of doubles} precision \ - {expr {1e127}} \ - 9.9999999999999995e+126 -test util-16.1.17.128 {8.4 compatible formatting of doubles} precision \ - {expr {1e128}} \ - 1.0000000000000001e+128 -test util-16.1.17.129 {8.4 compatible formatting of doubles} precision \ - {expr {1e129}} \ - 1e+129 -test util-16.1.17.130 {8.4 compatible formatting of doubles} precision \ - {expr {1e130}} \ - 1.0000000000000001e+130 -test util-16.1.17.131 {8.4 compatible formatting of doubles} precision \ - {expr {1e131}} \ - 9.9999999999999991e+130 -test util-16.1.17.132 {8.4 compatible formatting of doubles} precision \ - {expr {1e132}} \ - 9.9999999999999999e+131 -test util-16.1.17.133 {8.4 compatible formatting of doubles} precision \ - {expr {1e133}} \ - 1e+133 -test util-16.1.17.134 {8.4 compatible formatting of doubles} precision \ - {expr {1e134}} \ - 9.9999999999999992e+133 -test util-16.1.17.135 {8.4 compatible formatting of doubles} precision \ - {expr {1e135}} \ - 9.9999999999999996e+134 -test util-16.1.17.136 {8.4 compatible formatting of doubles} precision \ - {expr {1e136}} \ - 1.0000000000000001e+136 -test util-16.1.17.137 {8.4 compatible formatting of doubles} precision \ - {expr {1e137}} \ - 1e+137 -test util-16.1.17.138 {8.4 compatible formatting of doubles} precision \ - {expr {1e138}} \ - 1e+138 -test util-16.1.17.139 {8.4 compatible formatting of doubles} precision \ - {expr {1e139}} \ - 1e+139 -test util-16.1.17.140 {8.4 compatible formatting of doubles} precision \ - {expr {1e140}} \ - 1.0000000000000001e+140 -test util-16.1.17.141 {8.4 compatible formatting of doubles} precision \ - {expr {1e141}} \ - 1e+141 -test util-16.1.17.142 {8.4 compatible formatting of doubles} precision \ - {expr {1e142}} \ - 1.0000000000000001e+142 -test util-16.1.17.143 {8.4 compatible formatting of doubles} precision \ - {expr {1e143}} \ - 1e+143 -test util-16.1.17.144 {8.4 compatible formatting of doubles} precision \ - {expr {1e144}} \ - 1e+144 -test util-16.1.17.145 {8.4 compatible formatting of doubles} precision \ - {expr {1e145}} \ - 9.9999999999999999e+144 -test util-16.1.17.146 {8.4 compatible formatting of doubles} precision \ - {expr {1e146}} \ - 9.9999999999999993e+145 -test util-16.1.17.147 {8.4 compatible formatting of doubles} precision \ - {expr {1e147}} \ - 9.9999999999999998e+146 -test util-16.1.17.148 {8.4 compatible formatting of doubles} precision \ - {expr {1e148}} \ - 1e+148 -test util-16.1.17.149 {8.4 compatible formatting of doubles} precision \ - {expr {1e149}} \ - 1e+149 -test util-16.1.17.150 {8.4 compatible formatting of doubles} precision \ - {expr {1e150}} \ - 9.9999999999999998e+149 -test util-16.1.17.151 {8.4 compatible formatting of doubles} precision \ - {expr {1e151}} \ - 1e+151 -test util-16.1.17.152 {8.4 compatible formatting of doubles} precision \ - {expr {1e152}} \ - 1e+152 -test util-16.1.17.153 {8.4 compatible formatting of doubles} precision \ - {expr {1e153}} \ - 1e+153 -test util-16.1.17.154 {8.4 compatible formatting of doubles} precision \ - {expr {1e154}} \ - 1e+154 -test util-16.1.17.155 {8.4 compatible formatting of doubles} precision \ - {expr {1e155}} \ - 1e+155 -test util-16.1.17.156 {8.4 compatible formatting of doubles} precision \ - {expr {1e156}} \ - 9.9999999999999998e+155 -test util-16.1.17.157 {8.4 compatible formatting of doubles} precision \ - {expr {1e157}} \ - 9.9999999999999998e+156 -test util-16.1.17.158 {8.4 compatible formatting of doubles} precision \ - {expr {1e158}} \ - 9.9999999999999995e+157 -test util-16.1.17.159 {8.4 compatible formatting of doubles} precision \ - {expr {1e159}} \ - 9.9999999999999993e+158 -test util-16.1.17.160 {8.4 compatible formatting of doubles} precision \ - {expr {1e160}} \ - 1e+160 -test util-16.1.17.161 {8.4 compatible formatting of doubles} precision \ - {expr {1e161}} \ - 1e+161 -test util-16.1.17.162 {8.4 compatible formatting of doubles} precision \ - {expr {1e162}} \ - 9.9999999999999994e+161 -test util-16.1.17.163 {8.4 compatible formatting of doubles} precision \ - {expr {1e163}} \ - 9.9999999999999994e+162 -test util-16.1.17.164 {8.4 compatible formatting of doubles} precision \ - {expr {1e164}} \ - 1e+164 -test util-16.1.17.165 {8.4 compatible formatting of doubles} precision \ - {expr {1e165}} \ - 9.999999999999999e+164 -test util-16.1.17.166 {8.4 compatible formatting of doubles} precision \ - {expr {1e166}} \ - 9.9999999999999994e+165 -test util-16.1.17.167 {8.4 compatible formatting of doubles} precision \ - {expr {1e167}} \ - 1e+167 -test util-16.1.17.168 {8.4 compatible formatting of doubles} precision \ - {expr {1e168}} \ - 9.9999999999999993e+167 -test util-16.1.17.169 {8.4 compatible formatting of doubles} precision \ - {expr {1e169}} \ - 9.9999999999999993e+168 -test util-16.1.17.170 {8.4 compatible formatting of doubles} precision \ - {expr {1e170}} \ - 1e+170 -test util-16.1.17.171 {8.4 compatible formatting of doubles} precision \ - {expr {1e171}} \ - 9.9999999999999995e+170 -test util-16.1.17.172 {8.4 compatible formatting of doubles} precision \ - {expr {1e172}} \ - 1.0000000000000001e+172 -test util-16.1.17.173 {8.4 compatible formatting of doubles} precision \ - {expr {1e173}} \ - 1e+173 -test util-16.1.17.174 {8.4 compatible formatting of doubles} precision \ - {expr {1e174}} \ - 1.0000000000000001e+174 -test util-16.1.17.175 {8.4 compatible formatting of doubles} precision \ - {expr {1e175}} \ - 9.9999999999999994e+174 -test util-16.1.17.176 {8.4 compatible formatting of doubles} precision \ - {expr {1e176}} \ - 1e+176 -test util-16.1.17.177 {8.4 compatible formatting of doubles} precision \ - {expr {1e177}} \ - 1e+177 -test util-16.1.17.178 {8.4 compatible formatting of doubles} precision \ - {expr {1e178}} \ - 1.0000000000000001e+178 -test util-16.1.17.179 {8.4 compatible formatting of doubles} precision \ - {expr {1e179}} \ - 9.9999999999999998e+178 -test util-16.1.17.180 {8.4 compatible formatting of doubles} precision \ - {expr {1e180}} \ - 1e+180 -test util-16.1.17.181 {8.4 compatible formatting of doubles} precision \ - {expr {1e181}} \ - 9.9999999999999992e+180 -test util-16.1.17.182 {8.4 compatible formatting of doubles} precision \ - {expr {1e182}} \ - 1.0000000000000001e+182 -test util-16.1.17.183 {8.4 compatible formatting of doubles} precision \ - {expr {1e183}} \ - 9.9999999999999995e+182 -test util-16.1.17.184 {8.4 compatible formatting of doubles} precision \ - {expr {1e184}} \ - 1e+184 -test util-16.1.17.185 {8.4 compatible formatting of doubles} precision \ - {expr {1e185}} \ - 9.9999999999999998e+184 -test util-16.1.17.186 {8.4 compatible formatting of doubles} precision \ - {expr {1e186}} \ - 9.9999999999999998e+185 -test util-16.1.17.187 {8.4 compatible formatting of doubles} precision \ - {expr {1e187}} \ - 9.9999999999999991e+186 -test util-16.1.17.188 {8.4 compatible formatting of doubles} precision \ - {expr {1e188}} \ - 1e+188 -test util-16.1.17.189 {8.4 compatible formatting of doubles} precision \ - {expr {1e189}} \ - 1e+189 -test util-16.1.17.190 {8.4 compatible formatting of doubles} precision \ - {expr {1e190}} \ - 1.0000000000000001e+190 -test util-16.1.17.191 {8.4 compatible formatting of doubles} precision \ - {expr {1e191}} \ - 1.0000000000000001e+191 -test util-16.1.17.192 {8.4 compatible formatting of doubles} precision \ - {expr {1e192}} \ - 1e+192 -test util-16.1.17.193 {8.4 compatible formatting of doubles} precision \ - {expr {1e193}} \ - 1.0000000000000001e+193 -test util-16.1.17.194 {8.4 compatible formatting of doubles} precision \ - {expr {1e194}} \ - 9.9999999999999994e+193 -test util-16.1.17.195 {8.4 compatible formatting of doubles} precision \ - {expr {1e195}} \ - 9.9999999999999998e+194 -test util-16.1.17.196 {8.4 compatible formatting of doubles} precision \ - {expr {1e196}} \ - 9.9999999999999995e+195 -test util-16.1.17.197 {8.4 compatible formatting of doubles} precision \ - {expr {1e197}} \ - 9.9999999999999995e+196 -test util-16.1.17.198 {8.4 compatible formatting of doubles} precision \ - {expr {1e198}} \ - 1e+198 -test util-16.1.17.199 {8.4 compatible formatting of doubles} precision \ - {expr {1e199}} \ - 1.0000000000000001e+199 -test util-16.1.17.200 {8.4 compatible formatting of doubles} precision \ - {expr {1e200}} \ - 9.9999999999999997e+199 -test util-16.1.17.201 {8.4 compatible formatting of doubles} precision \ - {expr {1e201}} \ - 1e+201 -test util-16.1.17.202 {8.4 compatible formatting of doubles} precision \ - {expr {1e202}} \ - 9.999999999999999e+201 -test util-16.1.17.203 {8.4 compatible formatting of doubles} precision \ - {expr {1e203}} \ - 9.9999999999999999e+202 -test util-16.1.17.204 {8.4 compatible formatting of doubles} precision \ - {expr {1e204}} \ - 9.9999999999999999e+203 -test util-16.1.17.205 {8.4 compatible formatting of doubles} precision \ - {expr {1e205}} \ - 1e+205 -test util-16.1.17.206 {8.4 compatible formatting of doubles} precision \ - {expr {1e206}} \ - 1e+206 -test util-16.1.17.207 {8.4 compatible formatting of doubles} precision \ - {expr {1e207}} \ - 1e+207 -test util-16.1.17.208 {8.4 compatible formatting of doubles} precision \ - {expr {1e208}} \ - 9.9999999999999998e+207 -test util-16.1.17.209 {8.4 compatible formatting of doubles} precision \ - {expr {1e209}} \ - 1.0000000000000001e+209 -test util-16.1.17.210 {8.4 compatible formatting of doubles} precision \ - {expr {1e210}} \ - 9.9999999999999993e+209 -test util-16.1.17.211 {8.4 compatible formatting of doubles} precision \ - {expr {1e211}} \ - 9.9999999999999996e+210 -test util-16.1.17.212 {8.4 compatible formatting of doubles} precision \ - {expr {1e212}} \ - 9.9999999999999991e+211 -test util-16.1.17.213 {8.4 compatible formatting of doubles} precision \ - {expr {1e213}} \ - 9.9999999999999998e+212 -test util-16.1.17.214 {8.4 compatible formatting of doubles} precision \ - {expr {1e214}} \ - 9.9999999999999995e+213 -test util-16.1.17.215 {8.4 compatible formatting of doubles} precision \ - {expr {1e215}} \ - 9.9999999999999991e+214 -test util-16.1.17.216 {8.4 compatible formatting of doubles} precision \ - {expr {1e216}} \ - 1e+216 -test util-16.1.17.217 {8.4 compatible formatting of doubles} precision \ - {expr {1e217}} \ - 9.9999999999999996e+216 -test util-16.1.17.218 {8.4 compatible formatting of doubles} precision \ - {expr {1e218}} \ - 1.0000000000000001e+218 -test util-16.1.17.219 {8.4 compatible formatting of doubles} precision \ - {expr {1e219}} \ - 9.9999999999999997e+218 -test util-16.1.17.220 {8.4 compatible formatting of doubles} precision \ - {expr {1e220}} \ - 1e+220 -test util-16.1.17.221 {8.4 compatible formatting of doubles} precision \ - {expr {1e221}} \ - 1e+221 -test util-16.1.17.222 {8.4 compatible formatting of doubles} precision \ - {expr {1e222}} \ - 1e+222 -test util-16.1.17.223 {8.4 compatible formatting of doubles} precision \ - {expr {1e223}} \ - 1e+223 -test util-16.1.17.224 {8.4 compatible formatting of doubles} precision \ - {expr {1e224}} \ - 9.9999999999999997e+223 -test util-16.1.17.225 {8.4 compatible formatting of doubles} precision \ - {expr {1e225}} \ - 9.9999999999999993e+224 -test util-16.1.17.226 {8.4 compatible formatting of doubles} precision \ - {expr {1e226}} \ - 9.9999999999999996e+225 -test util-16.1.17.227 {8.4 compatible formatting of doubles} precision \ - {expr {1e227}} \ - 1.0000000000000001e+227 -test util-16.1.17.228 {8.4 compatible formatting of doubles} precision \ - {expr {1e228}} \ - 9.9999999999999992e+227 -test util-16.1.17.229 {8.4 compatible formatting of doubles} precision \ - {expr {1e229}} \ - 9.9999999999999999e+228 -test util-16.1.17.230 {8.4 compatible formatting of doubles} precision \ - {expr {1e230}} \ - 1.0000000000000001e+230 -test util-16.1.17.231 {8.4 compatible formatting of doubles} precision \ - {expr {1e231}} \ - 1.0000000000000001e+231 -test util-16.1.17.232 {8.4 compatible formatting of doubles} precision \ - {expr {1e232}} \ - 1.0000000000000001e+232 -test util-16.1.17.233 {8.4 compatible formatting of doubles} precision \ - {expr {1e233}} \ - 9.9999999999999997e+232 -test util-16.1.17.234 {8.4 compatible formatting of doubles} precision \ - {expr {1e234}} \ - 1e+234 -test util-16.1.17.235 {8.4 compatible formatting of doubles} precision \ - {expr {1e235}} \ - 1.0000000000000001e+235 -test util-16.1.17.236 {8.4 compatible formatting of doubles} precision \ - {expr {1e236}} \ - 1.0000000000000001e+236 -test util-16.1.17.237 {8.4 compatible formatting of doubles} precision \ - {expr {1e237}} \ - 9.9999999999999994e+236 -test util-16.1.17.238 {8.4 compatible formatting of doubles} precision \ - {expr {1e238}} \ - 1e+238 -test util-16.1.17.239 {8.4 compatible formatting of doubles} precision \ - {expr {1e239}} \ - 9.9999999999999999e+238 -test util-16.1.17.240 {8.4 compatible formatting of doubles} precision \ - {expr {1e240}} \ - 1e+240 -test util-16.1.17.241 {8.4 compatible formatting of doubles} precision \ - {expr {1e241}} \ - 1.0000000000000001e+241 -test util-16.1.17.242 {8.4 compatible formatting of doubles} precision \ - {expr {1e242}} \ - 1.0000000000000001e+242 -test util-16.1.17.243 {8.4 compatible formatting of doubles} precision \ - {expr {1e243}} \ - 1.0000000000000001e+243 -test util-16.1.17.244 {8.4 compatible formatting of doubles} precision \ - {expr {1e244}} \ - 1.0000000000000001e+244 -test util-16.1.17.245 {8.4 compatible formatting of doubles} precision \ - {expr {1e245}} \ - 1e+245 -test util-16.1.17.246 {8.4 compatible formatting of doubles} precision \ - {expr {1e246}} \ - 1.0000000000000001e+246 -test util-16.1.17.247 {8.4 compatible formatting of doubles} precision \ - {expr {1e247}} \ - 9.9999999999999995e+246 -test util-16.1.17.248 {8.4 compatible formatting of doubles} precision \ - {expr {1e248}} \ - 1e+248 -test util-16.1.17.249 {8.4 compatible formatting of doubles} precision \ - {expr {1e249}} \ - 9.9999999999999992e+248 -test util-16.1.17.250 {8.4 compatible formatting of doubles} precision \ - {expr {1e250}} \ - 9.9999999999999992e+249 -test util-16.1.17.251 {8.4 compatible formatting of doubles} precision \ - {expr {1e251}} \ - 1e+251 -test util-16.1.17.252 {8.4 compatible formatting of doubles} precision \ - {expr {1e252}} \ - 1.0000000000000001e+252 -test util-16.1.17.253 {8.4 compatible formatting of doubles} precision \ - {expr {1e253}} \ - 9.9999999999999994e+252 -test util-16.1.17.254 {8.4 compatible formatting of doubles} precision \ - {expr {1e254}} \ - 9.9999999999999994e+253 -test util-16.1.17.255 {8.4 compatible formatting of doubles} precision \ - {expr {1e255}} \ - 9.9999999999999999e+254 -test util-16.1.17.256 {8.4 compatible formatting of doubles} precision \ - {expr {1e256}} \ - 1e+256 -test util-16.1.17.257 {8.4 compatible formatting of doubles} precision \ - {expr {1e257}} \ - 1e+257 -test util-16.1.17.258 {8.4 compatible formatting of doubles} precision \ - {expr {1e258}} \ - 1.0000000000000001e+258 -test util-16.1.17.259 {8.4 compatible formatting of doubles} precision \ - {expr {1e259}} \ - 9.9999999999999993e+258 -test util-16.1.17.260 {8.4 compatible formatting of doubles} precision \ - {expr {1e260}} \ - 1.0000000000000001e+260 -test util-16.1.17.261 {8.4 compatible formatting of doubles} precision \ - {expr {1e261}} \ - 9.9999999999999993e+260 -test util-16.1.17.262 {8.4 compatible formatting of doubles} precision \ - {expr {1e262}} \ - 1e+262 -test util-16.1.17.263 {8.4 compatible formatting of doubles} precision \ - {expr {1e263}} \ - 1e+263 -test util-16.1.17.264 {8.4 compatible formatting of doubles} precision \ - {expr {1e264}} \ - 1e+264 -test util-16.1.17.265 {8.4 compatible formatting of doubles} precision \ - {expr {1e265}} \ - 1.0000000000000001e+265 -test util-16.1.17.266 {8.4 compatible formatting of doubles} precision \ - {expr {1e266}} \ - 1e+266 -test util-16.1.17.267 {8.4 compatible formatting of doubles} precision \ - {expr {1e267}} \ - 9.9999999999999997e+266 -test util-16.1.17.268 {8.4 compatible formatting of doubles} precision \ - {expr {1e268}} \ - 9.9999999999999997e+267 -test util-16.1.17.269 {8.4 compatible formatting of doubles} precision \ - {expr {1e269}} \ - 1e+269 -test util-16.1.17.270 {8.4 compatible formatting of doubles} precision \ - {expr {1e270}} \ - 1e+270 -test util-16.1.17.271 {8.4 compatible formatting of doubles} precision \ - {expr {1e271}} \ - 9.9999999999999995e+270 -test util-16.1.17.272 {8.4 compatible formatting of doubles} precision \ - {expr {1e272}} \ - 1.0000000000000001e+272 -test util-16.1.17.273 {8.4 compatible formatting of doubles} precision \ - {expr {1e273}} \ - 9.9999999999999995e+272 -test util-16.1.17.274 {8.4 compatible formatting of doubles} precision \ - {expr {1e274}} \ - 9.9999999999999992e+273 -test util-16.1.17.275 {8.4 compatible formatting of doubles} precision \ - {expr {1e275}} \ - 9.9999999999999996e+274 -test util-16.1.17.276 {8.4 compatible formatting of doubles} precision \ - {expr {1e276}} \ - 1.0000000000000001e+276 -test util-16.1.17.277 {8.4 compatible formatting of doubles} precision \ - {expr {1e277}} \ - 1e+277 -test util-16.1.17.278 {8.4 compatible formatting of doubles} precision \ - {expr {1e278}} \ - 9.9999999999999996e+277 -test util-16.1.17.279 {8.4 compatible formatting of doubles} precision \ - {expr {1e279}} \ - 1.0000000000000001e+279 -test util-16.1.17.280 {8.4 compatible formatting of doubles} precision \ - {expr {1e280}} \ - 1e+280 -test util-16.1.17.281 {8.4 compatible formatting of doubles} precision \ - {expr {1e281}} \ - 1e+281 -test util-16.1.17.282 {8.4 compatible formatting of doubles} precision \ - {expr {1e282}} \ - 1e+282 -test util-16.1.17.283 {8.4 compatible formatting of doubles} precision \ - {expr {1e283}} \ - 9.9999999999999996e+282 -test util-16.1.17.284 {8.4 compatible formatting of doubles} precision \ - {expr {1e284}} \ - 1.0000000000000001e+284 -test util-16.1.17.285 {8.4 compatible formatting of doubles} precision \ - {expr {1e285}} \ - 9.9999999999999998e+284 -test util-16.1.17.286 {8.4 compatible formatting of doubles} precision \ - {expr {1e286}} \ - 1e+286 -test util-16.1.17.287 {8.4 compatible formatting of doubles} precision \ - {expr {1e287}} \ - 1.0000000000000001e+287 -test util-16.1.17.288 {8.4 compatible formatting of doubles} precision \ - {expr {1e288}} \ - 1e+288 -test util-16.1.17.289 {8.4 compatible formatting of doubles} precision \ - {expr {1e289}} \ - 1.0000000000000001e+289 -test util-16.1.17.290 {8.4 compatible formatting of doubles} precision \ - {expr {1e290}} \ - 1.0000000000000001e+290 -test util-16.1.17.291 {8.4 compatible formatting of doubles} precision \ - {expr {1e291}} \ - 9.9999999999999996e+290 -test util-16.1.17.292 {8.4 compatible formatting of doubles} precision \ - {expr {1e292}} \ - 1e+292 -test util-16.1.17.293 {8.4 compatible formatting of doubles} precision \ - {expr {1e293}} \ - 9.9999999999999992e+292 -test util-16.1.17.294 {8.4 compatible formatting of doubles} precision \ - {expr {1e294}} \ - 1.0000000000000001e+294 -test util-16.1.17.295 {8.4 compatible formatting of doubles} precision \ - {expr {1e295}} \ - 9.9999999999999998e+294 -test util-16.1.17.296 {8.4 compatible formatting of doubles} precision \ - {expr {1e296}} \ - 9.9999999999999998e+295 -test util-16.1.17.297 {8.4 compatible formatting of doubles} precision \ - {expr {1e297}} \ - 1e+297 -test util-16.1.17.298 {8.4 compatible formatting of doubles} precision \ - {expr {1e298}} \ - 9.9999999999999996e+297 -test util-16.1.17.299 {8.4 compatible formatting of doubles} precision \ - {expr {1e299}} \ - 1.0000000000000001e+299 -test util-16.1.17.300 {8.4 compatible formatting of doubles} precision \ - {expr {1e300}} \ - 1.0000000000000001e+300 -test util-16.1.17.301 {8.4 compatible formatting of doubles} precision \ - {expr {1e301}} \ - 1.0000000000000001e+301 -test util-16.1.17.302 {8.4 compatible formatting of doubles} precision \ - {expr {1e302}} \ - 1.0000000000000001e+302 -test util-16.1.17.303 {8.4 compatible formatting of doubles} precision \ - {expr {1e303}} \ - 1e+303 -test util-16.1.17.304 {8.4 compatible formatting of doubles} precision \ - {expr {1e304}} \ - 9.9999999999999994e+303 -test util-16.1.17.305 {8.4 compatible formatting of doubles} precision \ - {expr {1e305}} \ - 9.9999999999999994e+304 -test util-16.1.17.306 {8.4 compatible formatting of doubles} precision \ - {expr {1e306}} \ - 1e+306 -test util-16.1.17.307 {8.4 compatible formatting of doubles} precision \ - {expr {1e307}} \ - 9.9999999999999999e+306 - test util-17.1 {bankers' rounding [Bug 3349507]} {ieeeFloatingPoint} { set r {} foreach {input} { @@ -4178,10 +2231,6 @@ test util-18.12 {Tcl_ObjPrintf} {testprint} { testprint "%I64d %Id" 65537 } {65537 65537} -if {[catch {set ::tcl_precision $saved_precision}]} { - unset ::tcl_precision -} - # cleanup ::tcltest::cleanupTests return diff --git a/tests/var.test b/tests/var.test index 15edf6e..864bec8 100644 --- a/tests/var.test +++ b/tests/var.test @@ -269,10 +269,11 @@ test var-3.4 {MakeUpvar, my var has TCL_NAMESPACE_ONLY specified} -setup { catch {unset ::test_ns_var::vv} proc p {} { # create namespace var vv linked to global a - testupvar 1 a {} vv namespace + testupvar 2 a {} vv namespace } p } + # Modified: that should create a global var according to the docs! list $test_ns_var::vv [set test_ns_var::vv 123] $a } -result {456 123 123} test var-3.5 {MakeUpvar, no call frame so my var will be in global :: ns} -setup { @@ -464,7 +465,7 @@ test var-7.5 {Tcl_VariableObjCmd, value for last var is optional} -setup { set six 666 namespace eval test_ns_var { variable five 5 six - lappend a $five + lappend ::a $five } lappend a $test_ns_var::five \ [set test_ns_var::six 6] [set test_ns_var::six] $six @@ -491,9 +492,9 @@ test var-7.8 {Tcl_VariableObjCmd, if var already exists and no value is given, l set a "" namespace eval test_ns_var { variable eight 8 - lappend a $eight + lappend ::a $eight variable eight - lappend a $eight + lappend ::a $eight } set a } {8 8} diff --git a/tests/winFile.test b/tests/winFile.test index 0c13a0e..231fb3f 100644 --- a/tests/winFile.test +++ b/tests/winFile.test @@ -28,7 +28,7 @@ testConstraint notWine [expr {![info exists ::env(CI_USING_WINE)]}] test winFile-1.1 {TclpGetUserHome} -constraints {win} -body { glob ~nosuchuser -} -returnCodes error -result {user "nosuchuser" doesn't exist} +} -result {} test winFile-1.2 {TclpGetUserHome} -constraints {win nonPortable} -body { # The administrator account should always exist. glob ~administrator diff --git a/tests/zlib.test b/tests/zlib.test index ebbdd50..1c9514d 100644 --- a/tests/zlib.test +++ b/tests/zlib.test @@ -286,23 +286,23 @@ test zlib-8.5 {transformation and flushing and fileevents: Bug 3525907} -setup { test zlib-8.6 {transformation and fconfigure} -setup { set file [makeFile {} test.z] set fd [open $file wb] -} -constraints {zlib deprecated} -body { +} -constraints zlib -body { list [fconfigure $fd] [zlib push compress $fd; fconfigure $fd] \ [chan pop $fd; fconfigure $fd] } -cleanup { catch {close $fd} removeFile $file -} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -nocomplainencoding 1 -strictencoding 0 -translation lf} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -nocomplainencoding 1 -strictencoding 0 -translation lf -checksum 1 -dictionary {}} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -nocomplainencoding 1 -strictencoding 0 -translation lf}} +} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -nocomplainencoding 0 -strictencoding 0 -translation lf} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -nocomplainencoding 0 -strictencoding 0 -translation lf -checksum 1 -dictionary {}} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -nocomplainencoding 0 -strictencoding 0 -translation lf}} test zlib-8.7 {transformation and fconfigure} -setup { set file [makeFile {} test.gz] set fd [open $file wb] -} -constraints {zlib deprecated} -body { +} -constraints zlib -body { list [fconfigure $fd] [zlib push gzip $fd; fconfigure $fd] \ [chan pop $fd; fconfigure $fd] } -cleanup { catch {close $fd} removeFile $file -} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -nocomplainencoding 1 -strictencoding 0 -translation lf} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -nocomplainencoding 1 -strictencoding 0 -translation lf -checksum 0} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -nocomplainencoding 1 -strictencoding 0 -translation lf}} +} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -nocomplainencoding 0 -strictencoding 0 -translation lf} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -nocomplainencoding 0 -strictencoding 0 -translation lf -checksum 0} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -nocomplainencoding 0 -strictencoding 0 -translation lf}} # Input is headers from fetching SPDY draft # Dictionary is that which is proposed _in_ SPDY draft set spdyHeaders "HTTP/1.0 200 OK\r\nContent-Type: text/html; charset=utf-8\r\nX-Robots-Tag: noarchive\r\nLast-Modified: Tue, 05 Jun 2012 02:43:25 GMT\r\nETag: \"1338864205129|#public|0|en|||0\"\r\nExpires: Tue, 05 Jun 2012 16:17:11 GMT\r\nDate: Tue, 05 Jun 2012 16:17:06 GMT\r\nCache-Control: public, max-age=5\r\nX-Content-Type-Options: nosniff\r\nX-XSS-Protection: 1; mode=block\r\nServer: GSE\r\n" diff --git a/tools/README b/tools/README index a37c2f4..6e5b20e 100644 --- a/tools/README +++ b/tools/README @@ -9,11 +9,6 @@ uniClass.tcl -- Script for generating regexp class tables from the Tcl "string is" classes Generating HTML files. -The tcltk-man2html.tcl script generates a nice set of HTML with -good cross references. Use it like - cd unix - ./configure - make html This script is very picky about the organization of man pages, effectively acting as a style enforcer. The resulting documentation can be found at diff --git a/tools/checkLibraryDoc.tcl b/tools/checkLibraryDoc.tcl index 36d82b2..0ed322c 100644 --- a/tools/checkLibraryDoc.tcl +++ b/tools/checkLibraryDoc.tcl @@ -3,7 +3,7 @@ # This script attempts to determine what APIs exist in the source base that # have not been documented. By grepping through all of the doc/*.3 man # pages, looking for "Pkg_*" (e.g., Tcl_ or Tk_), and comparing this list -# against the list of Pkg_ APIs found in the source (e.g., tcl8.7/*/*.[ch]) +# against the list of Pkg_ APIs found in the source (e.g., tcl9.0/*/*.[ch]) # we create six lists: # 1) APIs in Source not in Docs. # 2) APIs in Docs not in Source. @@ -43,15 +43,12 @@ set StructList { Tcl_Pid \ Tcl_QueuePosition \ Tcl_ResolvedVarInfo \ - Tcl_SavedResult \ Tcl_ThreadDataKey \ Tcl_ThreadId \ Tcl_Time \ Tcl_TimerToken \ Tcl_Token \ Tcl_Trace \ - Tcl_Value \ - Tcl_ValueType \ Tcl_Var \ Tk_3DBorder \ Tk_ArgvInfo \ diff --git a/tools/regexpTestLib.tcl b/tools/regexpTestLib.tcl index 454a4e8..2687e67 100644 --- a/tools/regexpTestLib.tcl +++ b/tools/regexpTestLib.tcl @@ -183,9 +183,9 @@ proc convertTestLine {currentLine len lineNum srcLineNum} { set noBraces 0 if {[regexp {=|>} $flags] == 1} { regsub -all {_} $currentLine {\\ } currentLine - regsub -all {A} $currentLine {\\007} currentLine + regsub -all {A} $currentLine {\\x07} currentLine regsub -all {B} $currentLine {\\b} currentLine - regsub -all {E} $currentLine {\\033} currentLine + regsub -all {E} $currentLine {\\x1B} currentLine regsub -all {F} $currentLine {\\f} currentLine regsub -all {N} $currentLine {\\n} currentLine diff --git a/tools/tcltk-man2html.tcl b/tools/tcltk-man2html.tcl index e6d9375..2cfdb0b 100755 --- a/tools/tcltk-man2html.tcl +++ b/tools/tcltk-man2html.tcl @@ -22,7 +22,7 @@ if {[catch {package require Tcl 8.6-} msg]} { # Copyright © 1995-1997 Roger E. Critchlow Jr # Copyright © 2004-2010 Donal K. Fellows -set ::Version "50/8.7" +set ::Version "50/9.0" set ::CSSFILE "docs.css" ## diff --git a/tools/tsdPerf.c b/tools/tsdPerf.c index 4c96f28..0bcc11b 100644 --- a/tools/tsdPerf.c +++ b/tools/tsdPerf.c @@ -10,7 +10,7 @@ typedef struct { static int -tsdPerfSetObjCmd(ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { +tsdPerfSetObjCmd(void *cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { TsdPerf *perf = Tcl_GetThreadData(&key, sizeof(TsdPerf)); Tcl_WideInt i; @@ -29,7 +29,7 @@ tsdPerfSetObjCmd(ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const } static int -tsdPerfGetObjCmd(ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { +tsdPerfGetObjCmd(void *cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { TsdPerf *perf = Tcl_GetThreadData(&key, sizeof(TsdPerf)); diff --git a/unix/Makefile.in b/unix/Makefile.in index dcaf6e3..6229b4d 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -54,7 +54,7 @@ DLL_INSTALL_DIR = @DLL_INSTALL_DIR@ SCRIPT_INSTALL_DIR = $(INSTALL_ROOT)$(TCL_LIBRARY) # Path name to use when installing Tcl modules. -MODULE_INSTALL_DIR = $(SCRIPT_INSTALL_DIR)/../tcl8 +MODULE_INSTALL_DIR = $(SCRIPT_INSTALL_DIR)/../tcl9 # Directory in which to install the include file tcl.h: INCLUDE_INSTALL_DIR = $(INSTALL_ROOT)$(includedir) @@ -124,7 +124,7 @@ ENV_FLAGS = # To enable memory debugging, call configure with --enable-symbols=mem # Warning: if you enable memory debugging, you must do it *everywhere*, -# including all the code that calls Tcl, and you must use ckalloc and ckfree +# including all the code that calls Tcl, and you must use Tcl_Alloc and Tcl_Free # everywhere instead of malloc and free. TCL_STUB_LIB_FILE = @TCL_STUB_LIB_FILE@ @@ -347,6 +347,8 @@ TOMMATH_OBJS = bn_s_mp_reverse.o bn_s_mp_mul_digs_fast.o \ bn_s_mp_mul_digs.o bn_s_mp_sqr.o bn_s_mp_sub.o STUB_LIB_OBJS = tclStubLib.o \ + tclStubCall.o \ + tclStubLibTbl.o \ tclTomMathStubLib.o \ tclOOStubLib.o \ ${COMPAT_OBJS} @@ -491,6 +493,8 @@ OO_SRCS = \ STUB_SRCS = \ $(GENERIC_DIR)/tclStubLib.c \ + $(GENERIC_DIR)/tclStubCall.c \ + $(GENERIC_DIR)/tclStubLibTbl.c \ $(GENERIC_DIR)/tclTomMathStubLib.c \ $(GENERIC_DIR)/tclOOStubLib.c @@ -1023,7 +1027,7 @@ install-libraries: libraries else true; \ fi; \ done; - @for i in 8.4 8.4/platform 8.5 8.6 8.7; \ + @for i in 9.0 9.0/platform; \ do \ if [ ! -d "$(MODULE_INSTALL_DIR)/$$i" ] ; then \ echo "Making directory $(MODULE_INSTALL_DIR)/$$i"; \ @@ -1043,23 +1047,23 @@ install-libraries: libraries done @echo "Installing package http 2.10b1 as a Tcl Module" @$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl \ - "$(MODULE_INSTALL_DIR)/8.6/http-2.10b1.tm" + "$(MODULE_INSTALL_DIR)/9.0/http-2.10b1.tm" @echo "Installing package opt0.4 files to $(SCRIPT_INSTALL_DIR)/opt0.4/" @for i in $(TOP_DIR)/library/opt/*.tcl; do \ $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)/opt0.4"; \ done @echo "Installing package msgcat 1.7.1 as a Tcl Module" @$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl \ - "$(MODULE_INSTALL_DIR)/8.7/msgcat-1.7.1.tm" + "$(MODULE_INSTALL_DIR)/9.0/msgcat-1.7.1.tm" @echo "Installing package tcltest 2.5.5 as a Tcl Module" @$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl \ - "$(MODULE_INSTALL_DIR)/8.5/tcltest-2.5.5.tm" + "$(MODULE_INSTALL_DIR)/9.0/tcltest-2.5.5.tm" @echo "Installing package platform 1.0.19 as a Tcl Module" @$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl \ - "$(MODULE_INSTALL_DIR)/8.4/platform-1.0.19.tm" + "$(MODULE_INSTALL_DIR)/9.0/platform-1.0.19.tm" @echo "Installing package platform::shell 1.1.4 as a Tcl Module" @$(INSTALL_DATA) $(TOP_DIR)/library/platform/shell.tcl \ - "$(MODULE_INSTALL_DIR)/8.4/platform/shell-1.1.4.tm" + "$(MODULE_INSTALL_DIR)/9.0/platform/shell-1.1.4.tm" @echo "Installing encoding files to $(SCRIPT_INSTALL_DIR)/encoding/" @for i in $(TOP_DIR)/library/encoding/*.enc; do \ $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)/encoding"; \ @@ -1919,6 +1923,16 @@ Zzutil.o: $(ZLIB_DIR)/zutil.c tclStubLib.o: $(GENERIC_DIR)/tclStubLib.c $(CC) -c $(STUB_CC_SWITCHES) -DSTATIC_BUILD @CFLAGS_NOLTO@ $(GENERIC_DIR)/tclStubLib.c +tclStubCall.o: $(GENERIC_DIR)/tclStubCall.c + $(CC) -c $(STUB_CC_SWITCHES) -DSTATIC_BUILD \ + -DCFG_RUNTIME_DLLFILE="\"$(TCL_LIB_FILE)\"" \ + -DCFG_RUNTIME_LIBDIR="\"$(libdir)\"" \ + -DCFG_RUNTIME_BINDIR="\"$(bindir)\"" \ + $(GENERIC_DIR)/tclStubCall.c + +tclStubLibTbl.o: $(GENERIC_DIR)/tclStubLibTbl.c + $(CC) -c $(STUB_CC_SWITCHES) -DSTATIC_BUILD $(GENERIC_DIR)/tclStubLibTbl.c + tclTomMathStubLib.o: $(GENERIC_DIR)/tclTomMathStubLib.c $(CC) -c $(STUB_CC_SWITCHES) @CFLAGS_NOLTO@ $(GENERIC_DIR)/tclTomMathStubLib.c @@ -2228,6 +2242,8 @@ DISTROOT = /tmp/dist DISTNAME = tcl${VERSION}${PATCH_LEVEL} ZIPNAME = tcl${MAJOR_VERSION}${MINOR_VERSION}${PATCH_LEVEL}-src.zip DISTDIR = $(DISTROOT)/$(DISTNAME) +DIST_INSTALL_DATA = CPPROG='cp -p' $(INSTALL) -m 644 +DIST_INSTALL_SCRIPT = CPPROG='cp -p' $(INSTALL) -m 755 BUILTIN_PACKAGE_LIST = cookiejar http opt msgcat registry dde tcltest platform $(UNIX_DIR)/configure: $(UNIX_DIR)/configure.ac $(UNIX_DIR)/tcl.m4 \ @@ -2253,121 +2269,126 @@ $(TOP_DIR)/manifest.uuid: dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(UNIX_DIR)/tcl.pc.in genstubs \ $(MAC_OSX_DIR)/configure $(TOP_DIR)/manifest.uuid dist-packages ${NATIVE_TCLSH} rm -rf $(DISTDIR) - mkdir -p $(DISTDIR)/unix - cp -p $(TOP_DIR)/manifest.uuid $(DISTDIR) - cp -p $(UNIX_DIR)/*.[ch] $(DISTDIR)/unix - cp -p $(UNIX_DIR)/Makefile.in $(DISTDIR)/unix - chmod 664 $(DISTDIR)/unix/Makefile.in - cp -p $(UNIX_DIR)/configure $(UNIX_DIR)/configure.ac \ + $(INSTALL_DATA_DIR) $(DISTDIR)/unix + $(DIST_INSTALL_DATA) $(TOP_DIR)/manifest.uuid $(DISTDIR) + $(DIST_INSTALL_DATA) $(UNIX_DIR)/*.[ch] $(DISTDIR)/unix + $(DIST_INSTALL_DATA) $(UNIX_DIR)/Makefile.in $(DISTDIR)/unix + $(DIST_INSTALL_DATA) $(UNIX_DIR)/configure.ac \ $(UNIX_DIR)/tcl.m4 $(UNIX_DIR)/aclocal.m4 \ $(UNIX_DIR)/tclConfig.sh.in $(UNIX_DIR)/tclooConfig.sh \ $(UNIX_DIR)/install-sh \ - $(UNIX_DIR)/README $(UNIX_DIR)/ldAix $(UNIX_DIR)/tcl.spec \ + $(UNIX_DIR)/README $(UNIX_DIR)/tcl.spec \ $(UNIX_DIR)/installManPage $(UNIX_DIR)/tclConfig.h.in \ $(UNIX_DIR)/tcl.pc.in $(DISTDIR)/unix - chmod 775 $(DISTDIR)/unix/configure - chmod 775 $(DISTDIR)/unix/ldAix - @mkdir $(DISTDIR)/generic - cp -p $(GENERIC_DIR)/*.[cdh] $(DISTDIR)/generic - cp -p $(GENERIC_DIR)/*.decls $(DISTDIR)/generic - cp -p $(GENERIC_DIR)/README $(DISTDIR)/generic - cp -p $(GENERIC_DIR)/tclGetDate.y $(DISTDIR)/generic - cp -p $(TOP_DIR)/changes $(TOP_DIR)/ChangeLog $(TOP_DIR)/README.md \ + $(DIST_INSTALL_SCRIPT) $(UNIX_DIR)/configure $(UNIX_DIR)/ldAix $(DISTDIR)/unix + $(INSTALL_DATA_DIR) $(DISTDIR)/generic + $(DIST_INSTALL_DATA) $(GENERIC_DIR)/*.[cdh] $(DISTDIR)/generic + $(DIST_INSTALL_DATA) $(GENERIC_DIR)/*.decls $(DISTDIR)/generic + $(DIST_INSTALL_DATA) $(GENERIC_DIR)/README $(DISTDIR)/generic + $(DIST_INSTALL_DATA) $(GENERIC_DIR)/tclGetDate.y $(DISTDIR)/generic + $(DIST_INSTALL_DATA) $(TOP_DIR)/changes $(TOP_DIR)/ChangeLog $(TOP_DIR)/README.md \ $(TOP_DIR)/ChangeLog.[12]??? $(TOP_DIR)/license.terms \ $(DISTDIR) - @mkdir $(DISTDIR)/library - cp -p $(TOP_DIR)/license.terms $(TOP_DIR)/library/*.tcl \ + $(INSTALL_DATA_DIR) $(DISTDIR)/library + $(DIST_INSTALL_DATA) $(TOP_DIR)/license.terms $(TOP_DIR)/library/*.tcl \ $(TOP_DIR)/library/manifest.txt \ $(TOP_DIR)/library/tclIndex $(DISTDIR)/library @for i in $(BUILTIN_PACKAGE_LIST); do \ - mkdir $(DISTDIR)/library/$$i;\ - cp -p $(TOP_DIR)/library/$$i/*.tcl $(DISTDIR)/library/$$i; \ + $(INSTALL_DATA_DIR) $(DISTDIR)/library/$$i;\ + $(DIST_INSTALL_DATA) $(TOP_DIR)/library/$$i/*.tcl $(DISTDIR)/library/$$i; \ done - cp -p $(TOP_DIR)/library/cookiejar/*.dat.gz $(DISTDIR)/library/cookiejar - @mkdir $(DISTDIR)/library/encoding - cp -p $(TOP_DIR)/library/encoding/*.enc $(DISTDIR)/library/encoding - @mkdir $(DISTDIR)/library/msgs - cp -p $(TOP_DIR)/library/msgs/*.msg $(DISTDIR)/library/msgs + $(DIST_INSTALL_DATA) $(TOP_DIR)/library/cookiejar/*.dat.gz $(DISTDIR)/library/cookiejar + $(INSTALL_DATA_DIR) $(DISTDIR)/library/encoding + $(DIST_INSTALL_DATA) $(TOP_DIR)/library/encoding/*.enc $(DISTDIR)/library/encoding + $(INSTALL_DATA_DIR) $(DISTDIR)/library/msgs + $(DIST_INSTALL_DATA) $(TOP_DIR)/library/msgs/*.msg $(DISTDIR)/library/msgs @echo cp -r $(TOP_DIR)/library/tzdata $(DISTDIR)/library/tzdata @( cd $(TOP_DIR); find library/tzdata -type f -print ) \ | ( cd $(TOP_DIR) ; xargs tar cf - ) \ | ( cd $(DISTDIR) ; tar xfp - ) - @mkdir $(DISTDIR)/doc - cp -p $(TOP_DIR)/license.terms $(TOP_DIR)/doc/*.[13n] \ + $(INSTALL_DATA_DIR) $(DISTDIR)/doc + $(DIST_INSTALL_DATA) $(TOP_DIR)/license.terms $(TOP_DIR)/doc/*.[13n] \ $(TOP_DIR)/doc/man.macros $(DISTDIR)/doc - @mkdir $(DISTDIR)/compat - cp -p $(TOP_DIR)/license.terms $(COMPAT_DIR)/*.[ch] \ + $(INSTALL_DATA_DIR) $(DISTDIR)/compat + $(DIST_INSTALL_DATA) $(TOP_DIR)/license.terms $(COMPAT_DIR)/*.[ch] \ $(COMPAT_DIR)/README $(DISTDIR)/compat - @mkdir $(DISTDIR)/compat/zlib + $(INSTALL_DATA_DIR) $(DISTDIR)/compat/zlib @echo cp -r $(COMPAT_DIR)/zlib $(DISTDIR)/compat/zlib @( cd $(COMPAT_DIR)/zlib; find . -type f -print ) \ | ( cd $(COMPAT_DIR)/zlib ; xargs tar cf - ) \ | ( cd $(DISTDIR)/compat/zlib ; tar xfp - ) - @mkdir $(DISTDIR)/libtommath + $(INSTALL_DATA_DIR) $(DISTDIR)/libtommath @echo cp -r $(TOP_DIR)/libtommath $(DISTDIR)/libtommath @( cd $(TOP_DIR)/libtommath; find . -type f -print ) \ | ( cd $(TOP_DIR)/libtommath ; xargs tar cf - ) \ | ( cd $(DISTDIR)/libtommath ; tar xfp - ) - @mkdir $(DISTDIR)/tests - cp -p $(TOP_DIR)/license.terms $(DISTDIR)/tests - cp -p $(TOP_DIR)/tests/*.test $(TOP_DIR)/tests/README \ + $(INSTALL_DATA_DIR) $(DISTDIR)/tests + $(DIST_INSTALL_DATA) $(TOP_DIR)/license.terms $(DISTDIR)/tests + $(DIST_INSTALL_DATA) $(TOP_DIR)/tests/*.test $(TOP_DIR)/tests/README \ $(TOP_DIR)/tests/httpd $(TOP_DIR)/tests/*.tcl \ $(TOP_DIR)/tests/auto-files.zip $(DISTDIR)/tests @mkdir $(DISTDIR)/tests/auto0 for i in auto1 auto2 ; \ do \ - mkdir $(DISTDIR)/tests/auto0/$$i ;\ - cp -p $(TOP_DIR)/tests/auto0/$$i/tclIndex $(TOP_DIR)/tests/auto0/$$i/*.tcl \ + $(INSTALL_DATA_DIR) $(DISTDIR)/tests/auto0/$$i ;\ + $(DIST_INSTALL_DATA) $(TOP_DIR)/tests/auto0/$$i/tclIndex $(TOP_DIR)/tests/auto0/$$i/*.tcl \ $(DISTDIR)/tests/auto0/$$i; \ done; for i in modules modules/mod1 modules/mod2 ; \ do \ - mkdir $(DISTDIR)/tests/auto0/$$i ;\ - cp -p $(TOP_DIR)/tests/auto0/$$i/*.tm \ + $(INSTALL_DATA_DIR) $(DISTDIR)/tests/auto0/$$i ;\ + $(DIST_INSTALL_DATA) $(TOP_DIR)/tests/auto0/$$i/*.tm \ $(DISTDIR)/tests/auto0/$$i; \ done; - @mkdir $(DISTDIR)/win - cp -p $(TOP_DIR)/win/Makefile.in $(DISTDIR)/win - cp -p $(TOP_DIR)/win/configure.ac $(TOP_DIR)/win/configure \ + $(INSTALL_DATA_DIR) $(DISTDIR)/win + $(DIST_INSTALL_DATA) $(TOP_DIR)/win/Makefile.in $(DISTDIR)/win + $(DIST_INSTALL_DATA) $(TOP_DIR)/win/configure.ac \ $(TOP_DIR)/win/tclConfig.sh.in $(TOP_DIR)/win/tclooConfig.sh \ $(TOP_DIR)/win/tcl.m4 $(TOP_DIR)/win/aclocal.m4 \ $(TOP_DIR)/win/tclsh.exe.manifest.in $(TOP_DIR)/win/tclUuid.h.in \ $(TOP_DIR)/win/gitmanifest.in $(TOP_DIR)/win/svnmanifest.in \ $(TOP_DIR)/win/x86_64-w64-mingw32-nmakehlp.exe $(DISTDIR)/win chmod 775 $(DISTDIR)/win/x86_64-w64-mingw32-nmakehlp.exe - cp -p $(TOP_DIR)/win/*.[ch] $(TOP_DIR)/win/*.ico $(TOP_DIR)/win/*.rc \ + $(DIST_INSTALL_SCRIPT) $(TOP_DIR)/win/configure $(DISTDIR)/win + $(DIST_INSTALL_DATA) $(TOP_DIR)/win/*.[ch] $(TOP_DIR)/win/*.ico $(TOP_DIR)/win/*.rc \ $(DISTDIR)/win - cp -p $(TOP_DIR)/win/*.bat $(DISTDIR)/win - cp -p $(TOP_DIR)/win/*.vc $(DISTDIR)/win - cp -p $(TOP_DIR)/win/tcl.ds* $(DISTDIR)/win - cp -p $(TOP_DIR)/win/README $(DISTDIR)/win - cp -p $(TOP_DIR)/license.terms $(DISTDIR)/win - @mkdir $(DISTDIR)/macosx - cp -p $(MAC_OSX_DIR)/GNUmakefile $(MAC_OSX_DIR)/README \ + $(DIST_INSTALL_DATA) $(TOP_DIR)/win/*.bat $(DISTDIR)/win + $(DIST_INSTALL_DATA) $(TOP_DIR)/win/*.vc $(DISTDIR)/win + $(DIST_INSTALL_DATA) $(TOP_DIR)/win/tcl.ds* $(DISTDIR)/win + $(DIST_INSTALL_DATA) $(TOP_DIR)/win/README $(DISTDIR)/win + $(DIST_INSTALL_DATA) $(TOP_DIR)/license.terms $(DISTDIR)/win + $(INSTALL_DATA_DIR) $(DISTDIR)/macosx + $(DIST_INSTALL_DATA) $(MAC_OSX_DIR)/GNUmakefile $(MAC_OSX_DIR)/README \ $(MAC_OSX_DIR)/*.c $(MAC_OSX_DIR)/*.in \ $(MAC_OSX_DIR)/*.ac $(MAC_OSX_DIR)/*.xcconfig \ - $(MAC_OSX_DIR)/configure $(DISTDIR)/macosx - cp -p $(TOP_DIR)/license.terms $(DISTDIR)/macosx - @mkdir $(DISTDIR)/macosx/Tcl.xcodeproj - cp -p $(MAC_OSX_DIR)/Tcl.xcodeproj/project.pbxproj \ + $(DISTDIR)/macosx + $(DIST_INSTALL_SCRIPT) $(MAC_OSX_DIR)/configure $(DISTDIR)/macosx + $(DIST_INSTALL_DATA) $(TOP_DIR)/license.terms $(DISTDIR)/macosx + $(INSTALL_DATA_DIR) $(DISTDIR)/macosx/Tcl.xcodeproj + $(DIST_INSTALL_DATA) $(MAC_OSX_DIR)/Tcl.xcodeproj/project.pbxproj \ $(MAC_OSX_DIR)/Tcl.xcodeproj/default.pbxuser \ $(DISTDIR)/macosx/Tcl.xcodeproj - @mkdir $(DISTDIR)/unix/dltest - cp -p $(UNIX_DIR)/dltest/*.c $(UNIX_DIR)/dltest/Makefile.in \ + $(INSTALL_DATA_DIR) $(DISTDIR)/unix/dltest + $(DIST_INSTALL_DATA) $(UNIX_DIR)/dltest/*.c $(UNIX_DIR)/dltest/Makefile.in \ $(UNIX_DIR)/dltest/README $(DISTDIR)/unix/dltest - @mkdir $(DISTDIR)/tools - cp -p $(TOOL_DIR)/README $(TOOL_DIR)/*.c $(TOOL_DIR)/*.svg \ + $(INSTALL_DATA_DIR) $(DISTDIR)/tools + $(DIST_INSTALL_DATA) $(TOOL_DIR)/README $(TOOL_DIR)/*.c $(TOOL_DIR)/*.svg \ $(TOOL_DIR)/*.tcl $(TOOL_DIR)/*.bmp \ $(TOOL_DIR)/valgrind_suppress $(DISTDIR)/tools - @mkdir $(DISTDIR)/pkgs - cp -p $(TOP_DIR)/pkgs/README $(DISTDIR)/pkgs - cp -p $(TOP_DIR)/pkgs/package.list.txt $(DISTDIR)/pkgs + chmod 755 $(DISTDIR)/tools/checkLibraryDoc.tcl \ + $(DISTDIR)/tools/findBadExternals.tcl \ + $(DISTDIR)/tools/loadICU.tcl \ + $(DISTDIR)/tools/makeTestCases.tcl $(DISTDIR)/tools/tclZIC.tcl \ + $(DISTDIR)/tools/tcltk-man2html.tcl + $(INSTALL_DATA_DIR) $(DISTDIR)/pkgs + $(DIST_INSTALL_DATA) $(TOP_DIR)/pkgs/README $(DISTDIR)/pkgs + $(DIST_INSTALL_DATA) $(TOP_DIR)/pkgs/package.list.txt $(DISTDIR)/pkgs for i in `ls $(DISTROOT)/pkgs/*.tar.gz 2> /dev/null`; do \ tar -C $(DISTDIR)/pkgs -xzf "$$i"; \ done - cp -p $(TOP_DIR)/.travis.yml $(DISTDIR) - mkdir -p $(DISTDIR)/.github/workflows - cp -p $(TOP_DIR)/.github/workflows/*.yml $(DISTDIR)/.github/workflows + $(DIST_INSTALL_DATA) $(TOP_DIR)/.travis.yml $(DISTDIR) + $(INSTALL_DATA_DIR) $(DISTDIR)/.github/workflows + $(DIST_INSTALL_DATA) $(TOP_DIR)/.github/workflows/*.yml $(DISTDIR)/.github/workflows alldist: dist rm -f $(DISTROOT)/$(DISTNAME)-src.tar.gz $(DISTROOT)/$(ZIPNAME) @@ -2379,7 +2400,7 @@ alldist: dist #-------------------------------------------------------------------------- # This target creates the HTML folder for Tcl & Tk and places it in # DISTDIR/html. It uses the tcltk-man2html.tcl tool from the Tcl group's tool -# workspace. It depends on the Tcl & Tk being in directories called tcl8.* & +# workspace. It depends on the Tcl & Tk being in directories called tcl9.* & # tk8.* up two directories from the TOOL_DIR. # # Note that for platforms where this is important, it is more common to use a diff --git a/unix/configure b/unix/configure index 3d24f28..ca94150 100755 --- a/unix/configure +++ b/unix/configure @@ -1,6 +1,6 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles. -# Generated by GNU Autoconf 2.71 for tcl 8.7. +# Generated by GNU Autoconf 2.71 for tcl 9.0. # # # Copyright (C) 1992-1996, 1998-2017, 2020-2021 Free Software Foundation, @@ -608,8 +608,8 @@ MAKEFLAGS= # Identity of this package. PACKAGE_NAME='tcl' PACKAGE_TARNAME='tcl' -PACKAGE_VERSION='8.7' -PACKAGE_STRING='tcl 8.7' +PACKAGE_VERSION='9.0' +PACKAGE_STRING='tcl 9.0' PACKAGE_BUGREPORT='' PACKAGE_URL='' @@ -1372,7 +1372,7 @@ if test "$ac_init_help" = "long"; then # Omit some internal or obsolete options to make the list less imposing. # This message is too long to be a string in the A/UX 3.1 sh. cat <<_ACEOF -\`configure' configures tcl 8.7 to adapt to many kinds of systems. +\`configure' configures tcl 9.0 to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... @@ -1434,7 +1434,7 @@ fi if test -n "$ac_init_help"; then case $ac_init_help in - short | recursive ) echo "Configuration of tcl 8.7:";; + short | recursive ) echo "Configuration of tcl 9.0:";; esac cat <<\_ACEOF @@ -1551,7 +1551,7 @@ fi test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF -tcl configure 8.7 +tcl configure 9.0 generated by GNU Autoconf 2.71 Copyright (C) 2021 Free Software Foundation, Inc. @@ -2019,7 +2019,7 @@ cat >config.log <<_ACEOF This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. -It was created by tcl $as_me 8.7, which was +It was created by tcl $as_me 9.0, which was generated by GNU Autoconf 2.71. Invocation command line was $ $0$ac_configure_args_raw @@ -2681,10 +2681,10 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu -TCL_VERSION=8.7 -TCL_MAJOR_VERSION=8 -TCL_MINOR_VERSION=7 -TCL_PATCH_LEVEL="a6" +TCL_VERSION=9.0 +TCL_MAJOR_VERSION=9 +TCL_MINOR_VERSION=0 +TCL_PATCH_LEVEL="a4" VERSION=${TCL_VERSION} EXTRA_INSTALL_BINARIES=${EXTRA_INSTALL_BINARIES:-"@:"} @@ -10426,9 +10426,6 @@ fi printf "%s\n" "#define USE_VFORK 1" >>confdefs.h -printf "%s\n" "#define TCL_DEFAULT_ENCODING \"utf-8\"" >>confdefs.h - - printf "%s\n" "#define TCL_LOAD_FROM_MEMORY 1" >>confdefs.h @@ -11240,15 +11237,11 @@ fi # Replace ${VERSION} with contents of ${TCL_VERSION} # double-eval to account for TCL_TRIM_DOTS. # -eval "TCL_STUB_LIB_FILE=libtclstub${TCL_UNSHARED_LIB_SUFFIX}" +eval "TCL_STUB_LIB_FILE=libtclstub.a" eval "TCL_STUB_LIB_FILE=\"${TCL_STUB_LIB_FILE}\"" eval "TCL_STUB_LIB_DIR=\"${libdir}\"" -if test "${TCL_LIB_VERSIONS_OK}" = "ok"; then - TCL_STUB_LIB_FLAG="-ltclstub${TCL_VERSION}" -else - TCL_STUB_LIB_FLAG="-ltclstub`echo ${TCL_VERSION} | tr -d .`" -fi +TCL_STUB_LIB_FLAG="-ltclstub" TCL_BUILD_STUB_LIB_SPEC="-L`pwd | sed -e 's/ /\\\\ /g'` ${TCL_STUB_LIB_FLAG}" TCL_STUB_LIB_SPEC="-L${TCL_STUB_LIB_DIR} ${TCL_STUB_LIB_FLAG}" @@ -11848,7 +11841,7 @@ cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log=" -This file was extended by tcl $as_me 8.7, which was +This file was extended by tcl $as_me 9.0, which was generated by GNU Autoconf 2.71. Invocation command line was CONFIG_FILES = $CONFIG_FILES @@ -11907,7 +11900,7 @@ ac_cs_config_escaped=`printf "%s\n" "$ac_cs_config" | sed "s/^ //; s/'/'\\\\\\\\ cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_cs_config='$ac_cs_config_escaped' ac_cs_version="\\ -tcl config.status 8.7 +tcl config.status 9.0 configured by $0, generated by GNU Autoconf 2.71, with options \\"\$ac_cs_config\\" diff --git a/unix/configure.ac b/unix/configure.ac index 7acb5ce..29933bd 100644 --- a/unix/configure.ac +++ b/unix/configure.ac @@ -3,7 +3,7 @@ dnl This file is an input file used by the GNU "autoconf" program to dnl generate the file "configure", which is run during Tcl installation dnl to configure the system for the local environment. -AC_INIT([tcl],[8.7]) +AC_INIT([tcl],[9.0]) AC_PREREQ([2.69]) dnl This is only used when included from macosx/configure.ac @@ -23,10 +23,10 @@ m4_ifdef([SC_USE_CONFIG_HEADERS], [ #endif /* _TCLCONFIG */]) ]) -TCL_VERSION=8.7 -TCL_MAJOR_VERSION=8 -TCL_MINOR_VERSION=7 -TCL_PATCH_LEVEL="a6" +TCL_VERSION=9.0 +TCL_MAJOR_VERSION=9 +TCL_MINOR_VERSION=0 +TCL_PATCH_LEVEL="a4" VERSION=${TCL_VERSION} EXTRA_INSTALL_BINARIES=${EXTRA_INSTALL_BINARIES:-"@:"} @@ -574,8 +574,6 @@ if test "`uname -s`" = "Darwin" ; then AC_CHECK_FUNCS(OSSpinLockLock) fi AC_DEFINE(USE_VFORK, 1, [Should we use vfork() instead of fork()?]) - AC_DEFINE(TCL_DEFAULT_ENCODING, "utf-8", - [Are we to override what our default encoding is?]) AC_DEFINE(TCL_LOAD_FROM_MEMORY, 1, [Can this platform load code from memory?]) AC_DEFINE(TCL_WIDE_CLICKS, 1, @@ -934,15 +932,11 @@ fi # Replace ${VERSION} with contents of ${TCL_VERSION} # double-eval to account for TCL_TRIM_DOTS. # -eval "TCL_STUB_LIB_FILE=libtclstub${TCL_UNSHARED_LIB_SUFFIX}" +eval "TCL_STUB_LIB_FILE=libtclstub.a" eval "TCL_STUB_LIB_FILE=\"${TCL_STUB_LIB_FILE}\"" eval "TCL_STUB_LIB_DIR=\"${libdir}\"" -if test "${TCL_LIB_VERSIONS_OK}" = "ok"; then - TCL_STUB_LIB_FLAG="-ltclstub${TCL_VERSION}" -else - TCL_STUB_LIB_FLAG="-ltclstub`echo ${TCL_VERSION} | tr -d .`" -fi +TCL_STUB_LIB_FLAG="-ltclstub" TCL_BUILD_STUB_LIB_SPEC="-L`pwd | sed -e 's/ /\\\\ /g'` ${TCL_STUB_LIB_FLAG}" TCL_STUB_LIB_SPEC="-L${TCL_STUB_LIB_DIR} ${TCL_STUB_LIB_FLAG}" diff --git a/unix/dltest/Makefile.in b/unix/dltest/Makefile.in index 500bf97..19b7d84 100644 --- a/unix/dltest/Makefile.in +++ b/unix/dltest/Makefile.in @@ -25,13 +25,23 @@ LDFLAGS = @LDFLAGS_DEFAULT@ @LDFLAGS@ CC_SWITCHES = $(CFLAGS) -I${SRC_DIR}/../../generic -DTCL_MEM_DEBUG \ ${SHLIB_CFLAGS} -DUSE_TCL_STUBS ${AC_FLAGS} -all: pkga${SHLIB_SUFFIX} pkgb${SHLIB_SUFFIX} pkgc${SHLIB_SUFFIX} pkgd${SHLIB_SUFFIX} pkge${SHLIB_SUFFIX} pkgua${SHLIB_SUFFIX} pkgooa${SHLIB_SUFFIX} +all: embtest tcl9pkga${SHLIB_SUFFIX} tcl9pkgb${SHLIB_SUFFIX} tcl9pkgc${SHLIB_SUFFIX} \ + tcl9pkgd${SHLIB_SUFFIX} tcl9pkge${SHLIB_SUFFIX} tcl9pkgua${SHLIB_SUFFIX} tcl9pkgooa${SHLIB_SUFFIX} \ + pkga${SHLIB_SUFFIX} pkgb${SHLIB_SUFFIX} pkgc${SHLIB_SUFFIX} @if test -n "$(DLTEST_SUFFIX)"; then $(MAKE) dltest_suffix; fi @touch ../dltest.marker -dltest_suffix: pkga${DLTEST_SUFFIX} pkgb${DLTEST_SUFFIX} pkgc${DLTEST_SUFFIX} pkgd${DLTEST_SUFFIX} pkge${DLTEST_SUFFIX} pkgua${DLTEST_SUFFIX} pkgooa${DLTEST_SUFFIX} +dltest_suffix: tcl9pkga${DLTEST_SUFFIX} tcl9pkgb${DLTEST_SUFFIX} tcl9pkgc${DLTEST_SUFFIX} \ + tcl9pkgd${DLTEST_SUFFIX} tcl9pkge${DLTEST_SUFFIX} tcl9pkgua${DLTEST_SUFFIX} tcl9pkgooa${DLTEST_SUFFIX} \ + pkga${DLTEST_SUFFIX} pkgb${DLTEST_SUFFIX} pkgc${DLTEST_SUFFIX} @touch ../dltest.marker +embtest.o: $(SRC_DIR)/embtest.c + $(CC) -c $(CC_SWITCHES) $(SRC_DIR)/embtest.c + +pkgπ.o: $(SRC_DIR)/pkgπ.c + $(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgπ.c + pkga.o: $(SRC_DIR)/pkga.c $(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkga.c @@ -41,6 +51,15 @@ pkgb.o: $(SRC_DIR)/pkgb.c pkgc.o: $(SRC_DIR)/pkgc.c $(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgc.c +tcl8pkga.o: $(SRC_DIR)/pkga.c + $(CC) -o $@ -c $(CC_SWITCHES) -DTCL_MAJOR_VERSION=8 $(SRC_DIR)/pkga.c + +tcl8pkgb.o: $(SRC_DIR)/pkgb.c + $(CC) -o $@ -c $(CC_SWITCHES) -DTCL_MAJOR_VERSION=8 $(SRC_DIR)/pkgb.c + +tcl8pkgc.o: $(SRC_DIR)/pkgc.c + $(CC) -o $@ -c $(CC_SWITCHES) -DTCL_MAJOR_VERSION=8 $(SRC_DIR)/pkgc.c + pkgd.o: $(SRC_DIR)/pkgd.c $(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgd.c @@ -53,50 +72,77 @@ pkgua.o: $(SRC_DIR)/pkgua.c pkgooa.o: $(SRC_DIR)/pkgooa.c $(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgooa.c -pkga${SHLIB_SUFFIX}: pkga.o - ${SHLIB_LD} -o pkga${SHLIB_SUFFIX} pkga.o ${SHLIB_LD_LIBS} +embtest: embtest.o + $(CC) -o $@ embtest.o ${SHLIB_LD_LIBS} + +tcl9pkgπ${SHLIB_SUFFIX}: pkgπ.o + ${SHLIB_LD} -o $@ pkgπ.o ${SHLIB_LD_LIBS} + +tcl9pkga${SHLIB_SUFFIX}: pkga.o + ${SHLIB_LD} -o $@ pkga.o ${SHLIB_LD_LIBS} + +tcl9pkgb${SHLIB_SUFFIX}: pkgb.o + ${SHLIB_LD} -o $@ pkgb.o ${SHLIB_LD_LIBS} + +tcl9pkgc${SHLIB_SUFFIX}: pkgc.o + ${SHLIB_LD} -o $@ pkgc.o ${SHLIB_LD_LIBS} + +pkga${SHLIB_SUFFIX}: tcl8pkga.o + ${SHLIB_LD} -o $@ tcl8pkga.o ${SHLIB_LD_LIBS} + +pkgb${SHLIB_SUFFIX}: tcl8pkgb.o + ${SHLIB_LD} -o $@ tcl8pkgb.o ${SHLIB_LD_LIBS} + +pkgc${SHLIB_SUFFIX}: tcl8pkgc.o + ${SHLIB_LD} -o $@ tcl8pkgc.o ${SHLIB_LD_LIBS} + +tcl9pkgd${SHLIB_SUFFIX}: pkgd.o + ${SHLIB_LD} -o $@ pkgd.o ${SHLIB_LD_LIBS} + +tcl9pkge${SHLIB_SUFFIX}: pkge.o + ${SHLIB_LD} -o $@ pkge.o ${SHLIB_LD_LIBS} -pkgb${SHLIB_SUFFIX}: pkgb.o - ${SHLIB_LD} -o pkgb${SHLIB_SUFFIX} pkgb.o ${SHLIB_LD_LIBS} +tcl9pkgua${SHLIB_SUFFIX}: pkgua.o + ${SHLIB_LD} -o $@ pkgua.o ${SHLIB_LD_LIBS} -pkgc${SHLIB_SUFFIX}: pkgc.o - ${SHLIB_LD} -o pkgc${SHLIB_SUFFIX} pkgc.o ${SHLIB_LD_LIBS} +tcl9pkgooa${SHLIB_SUFFIX}: pkgooa.o + ${SHLIB_LD} -o $@ pkgooa.o ${SHLIB_LD_LIBS} -pkgd${SHLIB_SUFFIX}: pkgd.o - ${SHLIB_LD} -o pkgd${SHLIB_SUFFIX} pkgd.o ${SHLIB_LD_LIBS} +tcl9pkgπ${DLTEST_SUFFIX}: pkgπ.o + ${DLTEST_LD} -o $@ pkgπ.o ${SHLIB_LD_LIBS} -pkge${SHLIB_SUFFIX}: pkge.o - ${SHLIB_LD} -o pkge${SHLIB_SUFFIX} pkge.o ${SHLIB_LD_LIBS} +tcl9pkga${DLTEST_SUFFIX}: pkga.o + ${DLTEST_LD} -o $@ pkga.o ${SHLIB_LD_LIBS} -pkgua${SHLIB_SUFFIX}: pkgua.o - ${SHLIB_LD} -o pkgua${SHLIB_SUFFIX} pkgua.o ${SHLIB_LD_LIBS} +tcl9pkgb${DLTEST_SUFFIX}: pkgb.o + ${DLTEST_LD} -o $@ pkgb.o ${SHLIB_LD_LIBS} -pkgooa${SHLIB_SUFFIX}: pkgooa.o - ${SHLIB_LD} -o pkgooa${SHLIB_SUFFIX} pkgooa.o ${SHLIB_LD_LIBS} +tcl9pkgc${DLTEST_SUFFIX}: pkgc.o + ${DLTEST_LD} -o $@ pkgc.o ${SHLIB_LD_LIBS} -pkga${DLTEST_SUFFIX}: pkga.o - ${DLTEST_LD} -o pkga${DLTEST_SUFFIX} pkga.o ${SHLIB_LD_LIBS} +pkga${DLTEST_SUFFIX}: tcl8pkga.o + ${DLTEST_LD} -o $@ tcl8pkga.o ${SHLIB_LD_LIBS} -pkgb${DLTEST_SUFFIX}: pkgb.o - ${DLTEST_LD} -o pkgb${DLTEST_SUFFIX} pkgb.o ${SHLIB_LD_LIBS} +pkgb${DLTEST_SUFFIX}: tcl8pkgb.o + ${DLTEST_LD} -o $@ tcl8pkgb.o ${SHLIB_LD_LIBS} -pkgc${DLTEST_SUFFIX}: pkgc.o - ${DLTEST_LD} -o pkgc${DLTEST_SUFFIX} pkgc.o ${SHLIB_LD_LIBS} +pkgc${DLTEST_SUFFIX}: tcl8pkgc.o + ${DLTEST_LD} -o $@ tcl8pkgc.o ${SHLIB_LD_LIBS} -pkgd${DLTEST_SUFFIX}: pkgd.o - ${DLTEST_LD} -o pkgd${DLTEST_SUFFIX} pkgd.o ${SHLIB_LD_LIBS} +tcl9pkgd${DLTEST_SUFFIX}: pkgd.o + ${DLTEST_LD} -o $@ pkgd.o ${SHLIB_LD_LIBS} -pkge${DLTEST_SUFFIX}: pkge.o - ${DLTEST_LD} -o pkge${DLTEST_SUFFIX} pkge.o ${SHLIB_LD_LIBS} +tcl9pkge${DLTEST_SUFFIX}: pkge.o + ${DLTEST_LD} -o $@ pkge.o ${SHLIB_LD_LIBS} -pkgua${DLTEST_SUFFIX}: pkgua.o - ${DLTEST_LD} -o pkgua${DLTEST_SUFFIX} pkgua.o ${SHLIB_LD_LIBS} +tcl9pkgua${DLTEST_SUFFIX}: pkgua.o + ${DLTEST_LD} -o $@ pkgua.o ${SHLIB_LD_LIBS} -pkgooa${DLTEST_SUFFIX}: pkgooa.o - ${DLTEST_LD} -o pkgooa${DLTEST_SUFFIX} pkgooa.o ${SHLIB_LD_LIBS} +tcl9pkgooa${DLTEST_SUFFIX}: pkgooa.o + ${DLTEST_LD} -o $@ pkgooa.o ${SHLIB_LD_LIBS} clean: - rm -f *.o lib.exp ../dltest.marker + rm -f embtest *.o lib.exp ../dltest.marker @if test "$(SHLIB_SUFFIX)" != ""; then \ echo "rm -f *${SHLIB_SUFFIX}" ; \ rm -f *${SHLIB_SUFFIX} ; \ diff --git a/unix/dltest/embtest.c b/unix/dltest/embtest.c new file mode 100644 index 0000000..1111268 --- /dev/null +++ b/unix/dltest/embtest.c @@ -0,0 +1,36 @@ +#include "tcl.h" +#include <stdio.h> + +MODULE_SCOPE const TclStubs *tclStubsPtr; + +int main(int argc, char **argv) { + const char *version; + int exitcode = 0; + + if (tclStubsPtr != NULL) { + printf("ERROR: stub table is already initialized"); + exitcode = 1; + } + tclStubsPtr = NULL; + version = Tcl_SetPanicProc(Tcl_ConsolePanic); + if (tclStubsPtr == NULL) { + printf("ERROR: Tcl_SetPanicProc does not initialize the stub table\n"); + exitcode = 1; + } + tclStubsPtr = NULL; + version = Tcl_InitSubsystems(); + if (tclStubsPtr == NULL) { + printf("ERROR: Tcl_InitSubsystems does not initialize the stub table\n"); + exitcode = 1; + } + tclStubsPtr = NULL; + version = Tcl_FindExecutable(argv[0]); + if (tclStubsPtr == NULL) { + printf("ERROR: Tcl_FindExecutable does not initialize the stub table\n"); + exitcode = 1; + } + if (!exitcode) { + printf("All OK!\n"); + } + return exitcode; +} diff --git a/unix/dltest/pkgb.c b/unix/dltest/pkgb.c index e9645a4..651c132 100644 --- a/unix/dltest/pkgb.c +++ b/unix/dltest/pkgb.c @@ -31,10 +31,6 @@ *---------------------------------------------------------------------- */ -#ifndef Tcl_GetErrorLine -# define Tcl_GetErrorLine(interp) ((interp)->errorLine) -#endif - static int Pkgb_SubObjCmd( void *dummy, /* Not used. */ diff --git a/unix/dltest/pkgπ.c b/unix/dltest/pkgπ.c new file mode 100644 index 0000000..dc01fbd --- /dev/null +++ b/unix/dltest/pkgπ.c @@ -0,0 +1,88 @@ +/* + * pkgπ.c -- + * + * This file contains a simple Tcl package "pkgπ" that is intended for + * testing the Tcl dynamic loading facilities. + * + * Copyright © 1995 Sun Microsystems, Inc. + * + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#undef STATIC_BUILD +#include "tcl.h" + +/* + *---------------------------------------------------------------------- + * + * Pkga_EqObjCmd -- + * + * This procedure is invoked to process the "pkga_eq" Tcl command. It + * expects two arguments and returns 1 if they are the same, 0 if they + * are different. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +static int +Pkg\u03C0_\u03A0ObjCmd( + void *dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + int result; + const char *str1, *str2; + int len1, len2; + (void)dummy; + + if (objc != 1) { + Tcl_WrongNumArgs(interp, 1, objv, ""); + return TCL_ERROR; + } + + Tcl_SetObjResult(interp, Tcl_NewDoubleObj(3.14159)); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * Pkgπ_Init -- + * + * This is a package initialization procedure, which is called by Tcl + * when this package is to be added to an interpreter. + * + * Results: + * None. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +DLLEXPORT int +Pkg\u03C0_Init( + Tcl_Interp *interp) /* Interpreter in which the package is to be + * made available. */ +{ + int code; + + if (Tcl_InitStubs(interp, "9.0", 0) == NULL) { + return TCL_ERROR; + } + code = Tcl_PkgProvide(interp, "pkgπ", "1.0"); + if (code != TCL_OK) { + return code; + } + Tcl_CreateObjCommand(interp, "π", Pkg\u03C0_\u03A0ObjCmd, NULL, NULL); + return TCL_OK; +} diff --git a/unix/tcl.m4 b/unix/tcl.m4 index 3730343..dcabb94 100644 --- a/unix/tcl.m4 +++ b/unix/tcl.m4 @@ -93,11 +93,11 @@ AC_DEFUN([SC_PATH_TCLCONFIG], [ `ls -d /usr/local/lib 2>/dev/null` \ `ls -d /usr/contrib/lib 2>/dev/null` \ `ls -d /usr/pkg/lib 2>/dev/null` \ - `ls -d /usr/lib/tcl8.7 2>/dev/null` \ + `ls -d /usr/lib/tcl9.0 2>/dev/null` \ `ls -d /usr/lib 2>/dev/null` \ `ls -d /usr/lib64 2>/dev/null` \ - `ls -d /usr/local/lib/tcl8.7 2>/dev/null` \ - `ls -d /usr/local/lib/tcl/tcl8.7 2>/dev/null` \ + `ls -d /usr/local/lib/tcl9.0 2>/dev/null` \ + `ls -d /usr/local/lib/tcl/tcl9.0 2>/dev/null` \ ; do if test -f "$i/tclConfig.sh" ; then ac_cv_c_tclconfig="`(cd $i; pwd)`" diff --git a/unix/tcl.spec b/unix/tcl.spec index 3956126..f2d4bd5 100644 --- a/unix/tcl.spec +++ b/unix/tcl.spec @@ -4,7 +4,7 @@ Name: tcl Summary: Tcl scripting language development environment -Version: 8.7a6 +Version: 9.0a4 Release: 2 License: BSD Group: Development/Languages diff --git a/unix/tclConfig.h.in b/unix/tclConfig.h.in index 1acc55d..aaaa1be 100644 --- a/unix/tclConfig.h.in +++ b/unix/tclConfig.h.in @@ -417,9 +417,6 @@ /* Are bytecode statistics enabled? */ #undef TCL_COMPILE_STATS -/* Are we to override what our default encoding is? */ -#undef TCL_DEFAULT_ENCODING - /* Is Tcl built as a framework? */ #undef TCL_FRAMEWORK diff --git a/unix/tclConfig.sh.in b/unix/tclConfig.sh.in index f2ac768..30d0bda 100644 --- a/unix/tclConfig.sh.in +++ b/unix/tclConfig.sh.in @@ -21,11 +21,6 @@ TCL_CC='@CC@' # -D flags for use with the C compiler. TCL_DEFS='@DEFS@' -# TCL_DBGX used to be used to distinguish debug vs. non-debug builds. -# This was a righteous pain so the core doesn't do that any more. -# DEPRECATED, will be removed in Tcl 9! -TCL_DBGX='' - # Default flags used in an optimized and debuggable build, respectively. TCL_CFLAGS_DEBUG='@CFLAGS_DEBUG@' TCL_CFLAGS_OPTIMIZE='@CFLAGS_OPTIMIZE@' diff --git a/unix/tclEpollNotfy.c b/unix/tclEpollNotfy.c index 649c21b..659e659 100644 --- a/unix/tclEpollNotfy.c +++ b/unix/tclEpollNotfy.c @@ -42,7 +42,7 @@ typedef struct FileHandler { * for this file. */ Tcl_FileProc *proc; /* Function to call, in the style of * Tcl_CreateFileHandler. */ - ClientData clientData; /* Argument to pass to proc. */ + void *clientData; /* Argument to pass to proc. */ struct FileHandler *nextPtr;/* Next in list of all files we care about. */ LIST_ENTRY(FileHandler) readyNode; /* Next/previous in list of FileHandlers asso- @@ -150,7 +150,7 @@ static int PlatformEventsWait(struct epoll_event *events, *---------------------------------------------------------------------- */ -ClientData +void * TclpInitNotifier(void) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -208,7 +208,7 @@ PlatformEventsControl( } if (isNew) { newPedPtr = (struct PlatformEventData *) - ckalloc(sizeof(struct PlatformEventData)); + Tcl_Alloc(sizeof(struct PlatformEventData)); newPedPtr->filePtr = filePtr; newPedPtr->tsdPtr = tsdPtr; filePtr->pedPtr = newPedPtr; @@ -275,7 +275,7 @@ PlatformEventsControl( void TclpFinalizeNotifier( - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -295,14 +295,14 @@ TclpFinalizeNotifier( tsdPtr->triggerPipe[1] = -1; } #endif /* HAVE_EVENTFD */ - ckfree(tsdPtr->triggerFilePtr->pedPtr); - ckfree(tsdPtr->triggerFilePtr); + Tcl_Free(tsdPtr->triggerFilePtr->pedPtr); + Tcl_Free(tsdPtr->triggerFilePtr); if (tsdPtr->eventsFd > 0) { close(tsdPtr->eventsFd); tsdPtr->eventsFd = 0; } if (tsdPtr->readyEvents) { - ckfree(tsdPtr->readyEvents); + Tcl_Free(tsdPtr->readyEvents); tsdPtr->maxReadyEvents = 0; } pthread_mutex_unlock(&tsdPtr->notifierMutex); @@ -347,7 +347,7 @@ PlatformEventsInit(void) if (errno) { Tcl_Panic("Tcl_InitNotifier: %s", "could not create mutex"); } - filePtr = (FileHandler *) ckalloc(sizeof(FileHandler)); + filePtr = (FileHandler *) Tcl_Alloc(sizeof(FileHandler)); #ifdef HAVE_EVENTFD tsdPtr->triggerEventFd = eventfd(0, EFD_CLOEXEC | EFD_NONBLOCK); if (tsdPtr->triggerEventFd <= 0) { @@ -368,7 +368,7 @@ PlatformEventsInit(void) PlatformEventsControl(filePtr, tsdPtr, EPOLL_CTL_ADD, 1); if (!tsdPtr->readyEvents) { tsdPtr->maxReadyEvents = 512; - tsdPtr->readyEvents = (struct epoll_event *) ckalloc( + tsdPtr->readyEvents = (struct epoll_event *) Tcl_Alloc( tsdPtr->maxReadyEvents * sizeof(tsdPtr->readyEvents[0])); } LIST_INIT(&tsdPtr->firstReadyFileHandlerPtr); @@ -513,14 +513,14 @@ TclpCreateFileHandler( * called. */ Tcl_FileProc *proc, /* Function to call for each selected * event. */ - ClientData clientData) /* Arbitrary data to pass to proc. */ + void *clientData) /* Arbitrary data to pass to proc. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); FileHandler *filePtr = LookUpFileHandler(tsdPtr, fd, NULL); int isNew = (filePtr == NULL); if (isNew) { - filePtr = (FileHandler *) ckalloc(sizeof(FileHandler)); + filePtr = (FileHandler *) Tcl_Alloc(sizeof(FileHandler)); filePtr->fd = fd; filePtr->readyMask = 0; filePtr->nextPtr = tsdPtr->firstFileHandlerPtr; @@ -577,7 +577,7 @@ TclpDeleteFileHandler( PlatformEventsControl(filePtr, tsdPtr, EPOLL_CTL_DEL, 0); if (filePtr->pedPtr) { - ckfree(filePtr->pedPtr); + Tcl_Free(filePtr->pedPtr); } /* @@ -589,7 +589,7 @@ TclpDeleteFileHandler( } else { prevPtr->nextPtr = filePtr->nextPtr; } - ckfree(filePtr); + Tcl_Free(filePtr); } /* @@ -683,7 +683,7 @@ TclpWaitForEvent( if (filePtr->readyMask == 0) { FileHandlerEvent *fileEvPtr = (FileHandlerEvent *) - ckalloc(sizeof(FileHandlerEvent)); + Tcl_Alloc(sizeof(FileHandlerEvent)); fileEvPtr->header.proc = FileHandlerEventProc; fileEvPtr->fd = filePtr->fd; @@ -759,7 +759,7 @@ TclpWaitForEvent( if (filePtr->readyMask == 0) { FileHandlerEvent *fileEvPtr = (FileHandlerEvent *) - ckalloc(sizeof(FileHandlerEvent)); + Tcl_Alloc(sizeof(FileHandlerEvent)); fileEvPtr->header.proc = FileHandlerEventProc; fileEvPtr->fd = filePtr->fd; @@ -791,7 +791,7 @@ int TclAsyncNotifier( int sigNumber, /* Signal number. */ Tcl_ThreadId threadId, /* Target thread. */ - ClientData clientData, /* Notifier data. */ + void *clientData, /* Notifier data. */ int *flagPtr, /* Flag to mark. */ int value) /* Value of mark. */ { diff --git a/unix/tclKqueueNotfy.c b/unix/tclKqueueNotfy.c index 2f495bd..487af9c 100644 --- a/unix/tclKqueueNotfy.c +++ b/unix/tclKqueueNotfy.c @@ -40,7 +40,7 @@ typedef struct FileHandler { * for this file. */ Tcl_FileProc *proc; /* Function to call, in the style of * Tcl_CreateFileHandler. */ - ClientData clientData; /* Argument to pass to proc. */ + void *clientData; /* Argument to pass to proc. */ struct FileHandler *nextPtr;/* Next in list of all files we care about. */ LIST_ENTRY(FileHandler) readyNode; /* Next/previous in list of FileHandlers asso- @@ -167,7 +167,7 @@ PlatformEventsControl( if (isNew) { newPedPtr = (struct PlatformEventData *) - ckalloc(sizeof(struct PlatformEventData)); + Tcl_Alloc(sizeof(struct PlatformEventData)); newPedPtr->filePtr = filePtr; newPedPtr->tsdPtr = tsdPtr; filePtr->pedPtr = newPedPtr; @@ -274,7 +274,7 @@ PlatformEventsControl( void TclpFinalizeNotifier( - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -292,7 +292,7 @@ TclpFinalizeNotifier( tsdPtr->eventsFd = 0; } if (tsdPtr->readyEvents) { - ckfree(tsdPtr->readyEvents); + Tcl_Free(tsdPtr->readyEvents); tsdPtr->maxReadyEvents = 0; } pthread_mutex_unlock(&tsdPtr->notifierMutex); @@ -330,7 +330,7 @@ TclpFinalizeNotifier( *---------------------------------------------------------------------- */ -ClientData +void * TclpInitNotifier(void) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -359,13 +359,13 @@ TclpInitNotifier(void) } else if (fcntl(tsdPtr->eventsFd, F_SETFD, FD_CLOEXEC) == -1) { Tcl_Panic("fcntl: %s", strerror(errno)); } - filePtr = (FileHandler *) ckalloc(sizeof(FileHandler)); + filePtr = (FileHandler *) Tcl_Alloc(sizeof(FileHandler)); filePtr->fd = tsdPtr->triggerPipe[0]; filePtr->mask = TCL_READABLE; PlatformEventsControl(filePtr, tsdPtr, EV_ADD, 1); if (!tsdPtr->readyEvents) { tsdPtr->maxReadyEvents = 512; - tsdPtr->readyEvents = (struct kevent *) ckalloc( + tsdPtr->readyEvents = (struct kevent *) Tcl_Alloc( tsdPtr->maxReadyEvents * sizeof(tsdPtr->readyEvents[0])); } LIST_INIT(&tsdPtr->firstReadyFileHandlerPtr); @@ -518,14 +518,14 @@ TclpCreateFileHandler( * called. */ Tcl_FileProc *proc, /* Function to call for each selected * event. */ - ClientData clientData) /* Arbitrary data to pass to proc. */ + void *clientData) /* Arbitrary data to pass to proc. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); FileHandler *filePtr = LookUpFileHandler(tsdPtr, fd, NULL); int isNew = (filePtr == NULL); if (isNew) { - filePtr = (FileHandler *) ckalloc(sizeof(FileHandler)); + filePtr = (FileHandler *) Tcl_Alloc(sizeof(FileHandler)); filePtr->fd = fd; filePtr->readyMask = 0; filePtr->nextPtr = tsdPtr->firstFileHandlerPtr; @@ -581,7 +581,7 @@ TclpDeleteFileHandler( PlatformEventsControl(filePtr, tsdPtr, EV_DELETE, 0); if (filePtr->pedPtr) { - ckfree(filePtr->pedPtr); + Tcl_Free(filePtr->pedPtr); } /* @@ -593,7 +593,7 @@ TclpDeleteFileHandler( } else { prevPtr->nextPtr = filePtr->nextPtr; } - ckfree(filePtr); + Tcl_Free(filePtr); } /* @@ -695,7 +695,7 @@ TclpWaitForEvent( if (filePtr->readyMask == 0) { FileHandlerEvent *fileEvPtr = (FileHandlerEvent *) - ckalloc(sizeof(FileHandlerEvent)); + Tcl_Alloc(sizeof(FileHandlerEvent)); fileEvPtr->header.proc = FileHandlerEventProc; fileEvPtr->fd = filePtr->fd; @@ -755,7 +755,7 @@ TclpWaitForEvent( if (filePtr->readyMask == 0) { FileHandlerEvent *fileEvPtr = (FileHandlerEvent *) - ckalloc(sizeof(FileHandlerEvent)); + Tcl_Alloc(sizeof(FileHandlerEvent)); fileEvPtr->header.proc = FileHandlerEventProc; fileEvPtr->fd = filePtr->fd; @@ -787,7 +787,7 @@ int TclAsyncNotifier( int sigNumber, /* Signal number. */ Tcl_ThreadId threadId, /* Target thread. */ - ClientData clientData, /* Notifier data. */ + void *clientData, /* Notifier data. */ int *flagPtr, /* Flag to mark. */ int value) /* Value of mark. */ { diff --git a/unix/tclLoadDl.c b/unix/tclLoadDl.c index 5c19ea3..dd6c50e 100644 --- a/unix/tclLoadDl.c +++ b/unix/tclLoadDl.c @@ -106,7 +106,7 @@ TclpDlopen( */ Tcl_DString ds; - const char *fileName = Tcl_GetString(pathPtr); + const char *fileName = TclGetString(pathPtr); native = Tcl_UtfToExternalDString(NULL, fileName, TCL_INDEX_NONE, &ds); /* @@ -127,11 +127,11 @@ TclpDlopen( if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't load file \"%s\": %s", - Tcl_GetString(pathPtr), errorStr)); + TclGetString(pathPtr), errorStr)); } return TCL_ERROR; } - newHandle = (Tcl_LoadHandle)ckalloc(sizeof(*newHandle)); + newHandle = (Tcl_LoadHandle)Tcl_Alloc(sizeof(*newHandle)); newHandle->clientData = handle; newHandle->findSymbolProcPtr = &FindSymbol; newHandle->unloadFileProcPtr = &UnloadFile; @@ -191,7 +191,7 @@ FindSymbol( #ifdef __cplusplus if (proc == NULL) { char buf[32]; - sprintf(buf, "%d", Tcl_DStringLength(&ds)); + sprintf(buf, "%d", (int)Tcl_DStringLength(&ds)); Tcl_DStringInit(&newName); TclDStringAppendLiteral(&newName, "__Z"); Tcl_DStringAppend(&newName, buf, TCL_INDEX_NONE); @@ -256,7 +256,7 @@ UnloadFile( void *handle = loadHandle->clientData; dlclose(handle); - ckfree(loadHandle); + Tcl_Free(loadHandle); } /* diff --git a/unix/tclLoadDyld.c b/unix/tclLoadDyld.c index 854d4bd..cc3512d 100644 --- a/unix/tclLoadDyld.c +++ b/unix/tclLoadDyld.c @@ -106,7 +106,7 @@ static const char * DyldOFIErrorMsg( int err) { - switch(err) { + switch (err) { case NSObjectFileImageSuccess: return NULL; case NSObjectFileImageFailure: @@ -184,7 +184,7 @@ TclpDlopen( */ nativePath = (const char *)Tcl_FSGetNativePath(pathPtr); - nativeFileName = Tcl_UtfToExternalDString(NULL, Tcl_GetString(pathPtr), + nativeFileName = Tcl_UtfToExternalDString(NULL, TclGetString(pathPtr), TCL_INDEX_NONE, &ds); #if TCL_DYLD_USE_DLFCN @@ -258,7 +258,7 @@ TclpDlopen( module = NSLinkModule(dyldObjFileImage, nativePath, nsflags); NSDestroyObjectFileImage(dyldObjFileImage); if (module) { - modulePtr = (Tcl_DyldModuleHandle *)ckalloc(sizeof(Tcl_DyldModuleHandle)); + modulePtr = (Tcl_DyldModuleHandle *)Tcl_Alloc(sizeof(Tcl_DyldModuleHandle)); modulePtr->module = module; modulePtr->nextPtr = NULL; } else { @@ -278,13 +278,13 @@ TclpDlopen( || dyldLibHeader || modulePtr #endif /* TCL_DYLD_USE_NSMODULE */ ) { - dyldLoadHandle = (Tcl_DyldLoadHandle *)ckalloc(sizeof(Tcl_DyldLoadHandle)); + dyldLoadHandle = (Tcl_DyldLoadHandle *)Tcl_Alloc(sizeof(Tcl_DyldLoadHandle)); dyldLoadHandle->dlHandle = dlHandle; #if TCL_DYLD_USE_NSMODULE || defined(TCL_LOAD_FROM_MEMORY) dyldLoadHandle->dyldLibHeader = dyldLibHeader; dyldLoadHandle->modulePtr = modulePtr; #endif /* TCL_DYLD_USE_NSMODULE || TCL_LOAD_FROM_MEMORY */ - newHandle = (Tcl_LoadHandle)ckalloc(sizeof(*newHandle)); + newHandle = (Tcl_LoadHandle)Tcl_Alloc(sizeof(*newHandle)); newHandle->clientData = dyldLoadHandle; newHandle->findSymbolProcPtr = &FindSymbol; newHandle->unloadFileProcPtr = &UnloadFile; @@ -382,7 +382,7 @@ FindSymbol( modulePtr = modulePtr->nextPtr; } if (modulePtr == NULL) { - modulePtr = (Tcl_DyldModuleHandle *)ckalloc(sizeof(Tcl_DyldModuleHandle)); + modulePtr = (Tcl_DyldModuleHandle *)Tcl_Alloc(sizeof(Tcl_DyldModuleHandle)); modulePtr->module = module; modulePtr->nextPtr = dyldLoadHandle->modulePtr; dyldLoadHandle->modulePtr = modulePtr; @@ -457,12 +457,12 @@ UnloadFile( (void) NSUnLinkModule(modulePtr->module, NSUNLINKMODULE_OPTION_RESET_LAZY_REFERENCES); modulePtr = modulePtr->nextPtr; - ckfree(ptr); + Tcl_Free(ptr); } #endif /* TCL_DYLD_USE_NSMODULE */ } - ckfree(dyldLoadHandle); - ckfree(loadHandle); + Tcl_Free(dyldLoadHandle); + Tcl_Free(loadHandle); } /* @@ -583,7 +583,7 @@ TclpLoadMemory( if ((size_t) codeSize >= sizeof(struct fat_header) + fh_nfat_arch * sizeof(struct fat_arch)) { - void *fatarchs = (char*)buffer + sizeof(struct fat_header); + void *fatarchs = (char *)buffer + sizeof(struct fat_header); const NXArchInfo *arch = NXGetLocalArchInfo(); struct fat_arch *fa; @@ -664,14 +664,14 @@ TclpLoadMemory( * Stash the module reference within the load handle we create and return. */ - modulePtr = (Tcl_DyldModuleHandle *)ckalloc(sizeof(Tcl_DyldModuleHandle)); + modulePtr = (Tcl_DyldModuleHandle *)Tcl_Alloc(sizeof(Tcl_DyldModuleHandle)); modulePtr->module = module; modulePtr->nextPtr = NULL; - dyldLoadHandle = (Tcl_DyldLoadHandle *)ckalloc(sizeof(Tcl_DyldLoadHandle)); + dyldLoadHandle = (Tcl_DyldLoadHandle *)Tcl_Alloc(sizeof(Tcl_DyldLoadHandle)); dyldLoadHandle->dlHandle = NULL; dyldLoadHandle->dyldLibHeader = NULL; dyldLoadHandle->modulePtr = modulePtr; - newHandle = (Tcl_LoadHandle)ckalloc(sizeof(*newHandle)); + newHandle = (Tcl_LoadHandle)Tcl_Alloc(sizeof(*newHandle)); newHandle->clientData = dyldLoadHandle; newHandle->findSymbolProcPtr = &FindSymbol; newHandle->unloadFileProcPtr = &UnloadFile; diff --git a/unix/tclLoadNext.c b/unix/tclLoadNext.c index dc827fc..23de2c5 100644 --- a/unix/tclLoadNext.c +++ b/unix/tclLoadNext.c @@ -61,7 +61,7 @@ TclpDlopen( NXStream *errorStream = NXOpenMemory(0,0,NX_READWRITE); - fileName = Tcl_GetString(pathPtr); + fileName = TclGetString(pathPtr); /* * First try the full path the user gave us. This is particularly @@ -101,7 +101,7 @@ TclpDlopen( } NXCloseMemory(errorStream, NX_FREEBUFFER); - newHandle = (Tcl_LoadHandle) ckalloc(sizeof(*newHandle)); + newHandle = (Tcl_LoadHandle) Tcl_Alloc(sizeof(*newHandle)); newHandle->clientData = INT2PTR(1); newHandle->findSymbolProcPtr = &FindSymbol; newHandle->unloadFileProcPtr = &UnloadFile; @@ -175,7 +175,7 @@ UnloadFile( * TclpDlopen(). The loadHandle is a token * that represents the loaded file. */ { - ckfree(loadHandle); + Tcl_Free(loadHandle); } /* diff --git a/unix/tclLoadOSF.c b/unix/tclLoadOSF.c index 03698fa..852adca 100644 --- a/unix/tclLoadOSF.c +++ b/unix/tclLoadOSF.c @@ -79,7 +79,7 @@ TclpDlopen( Tcl_LoadHandle newHandle; ldr_module_t lm; char *pkg; - char *fileName = Tcl_GetString(pathPtr); + char *fileName = TclGetString(pathPtr); const char *native; /* @@ -128,7 +128,7 @@ TclpDlopen( } else { pkg++; } - newHandle = (Tcl_LoadHandle)ckalloc(sizeof(*newHandle)); + newHandle = (Tcl_LoadHandle)Tcl_Alloc(sizeof(*newHandle)); newHandle->clientData = pkg; newHandle->findSymbolProcPtr = &FindSymbol; newHandle->unloadFileProcPtr = &UnloadFile; @@ -193,7 +193,7 @@ UnloadFile( * TclpDlopen(). The loadHandle is a token * that represents the loaded file. */ { - ckfree(loadHandle); + Tcl_Free(loadHandle); } /* diff --git a/unix/tclLoadShl.c b/unix/tclLoadShl.c index 5cde183..0889c21 100644 --- a/unix/tclLoadShl.c +++ b/unix/tclLoadShl.c @@ -57,7 +57,7 @@ TclpDlopen( shl_t handle; Tcl_LoadHandle newHandle; const char *native; - char *fileName = Tcl_GetString(pathPtr); + char *fileName = TclGetString(pathPtr); /* * The flags below used to be BIND_IMMEDIATE; they were changed at the @@ -97,7 +97,7 @@ TclpDlopen( fileName, Tcl_PosixError(interp))); return TCL_ERROR; } - newHandle = (Tcl_LoadHandle)ckalloc(sizeof(*newHandle)); + newHandle = (Tcl_LoadHandle)Tcl_Alloc(sizeof(*newHandle)); newHandle->clientData = handle; newHandle->findSymbolProcPtr = &FindSymbol; newHandle->unloadFileProcPtr = *unloadProcPtr = &UnloadFile; @@ -182,7 +182,7 @@ UnloadFile( shl_t handle = (shl_t) loadHandle->clientData; shl_unload(handle); - ckfree(loadHandle); + Tcl_Free(loadHandle); } /* diff --git a/unix/tclSelectNotfy.c b/unix/tclSelectNotfy.c index fc77e77..7d14c26 100644 --- a/unix/tclSelectNotfy.c +++ b/unix/tclSelectNotfy.c @@ -486,7 +486,7 @@ TclpCreateFileHandler( FileHandler *filePtr = LookUpFileHandler(tsdPtr, fd, NULL); if (filePtr == NULL) { - filePtr = (FileHandler *) ckalloc(sizeof(FileHandler)); + filePtr = (FileHandler *) Tcl_Alloc(sizeof(FileHandler)); filePtr->fd = fd; filePtr->readyMask = 0; filePtr->nextPtr = tsdPtr->firstFileHandlerPtr; @@ -595,7 +595,7 @@ TclpDeleteFileHandler( } else { prevPtr->nextPtr = filePtr->nextPtr; } - ckfree(filePtr); + Tcl_Free(filePtr); } #if TCL_THREADS && defined(__CYGWIN__) @@ -885,7 +885,7 @@ TclpWaitForEvent( if (filePtr->readyMask == 0) { FileHandlerEvent *fileEvPtr = - (FileHandlerEvent *) ckalloc(sizeof(FileHandlerEvent)); + (FileHandlerEvent *) Tcl_Alloc(sizeof(FileHandlerEvent)); fileEvPtr->header.proc = FileHandlerEventProc; fileEvPtr->fd = filePtr->fd; @@ -921,7 +921,7 @@ int TclAsyncNotifier( int sigNumber, /* Signal number. */ TCL_UNUSED(Tcl_ThreadId), /* Target thread. */ - TCL_UNUSED(ClientData), /* Notifier data. */ + TCL_UNUSED(void *), /* Notifier data. */ int *flagPtr, /* Flag to mark. */ int value) /* Value of mark. */ { @@ -989,7 +989,7 @@ TclAsyncNotifier( #if TCL_THREADS static TCL_NORETURN void NotifierThreadProc( - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { ThreadSpecificData *tsdPtr; fd_set readableMask; diff --git a/unix/tclUnixChan.c b/unix/tclUnixChan.c index 22e9876..c41cdd9 100644 --- a/unix/tclUnixChan.c +++ b/unix/tclUnixChan.c @@ -128,10 +128,6 @@ static int FileInputProc(void *instanceData, char *buf, int toRead, int *errorCode); static int FileOutputProc(void *instanceData, const char *buf, int toWrite, int *errorCode); -#ifndef TCL_NO_DEPRECATED -static int FileSeekProc(void *instanceData, long offset, - int mode, int *errorCode); -#endif static int FileTruncateProc(void *instanceData, long long length); static long long FileWideSeekProc(void *instanceData, @@ -163,14 +159,10 @@ static int TtySetOptionProc(void *instanceData, static const Tcl_ChannelType fileChannelType = { "file", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ - TCL_CLOSE2PROC, /* Close proc. */ + NULL, /* Close proc. */ FileInputProc, /* Input proc. */ FileOutputProc, /* Output proc. */ -#ifndef TCL_NO_DEPRECATED - FileSeekProc, /* Seek proc. */ -#else NULL, -#endif NULL, /* Set option proc. */ NULL, /* Get option proc. */ FileWatchProc, /* Initialize notifier. */ @@ -193,7 +185,7 @@ static const Tcl_ChannelType fileChannelType = { static const Tcl_ChannelType ttyChannelType = { "tty", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ - TCL_CLOSE2PROC, /* Close proc. */ + NULL, /* Close proc. */ FileInputProc, /* Input proc. */ FileOutputProc, /* Output proc. */ NULL, /* Seek proc. */ @@ -283,7 +275,7 @@ FileInputProc( */ do { - bytesRead = read(fsPtr->fd, buf, (size_t) toRead); + bytesRead = read(fsPtr->fd, buf, toRead); } while ((bytesRead < 0) && (errno == EINTR)); if (bytesRead < 0) { @@ -332,7 +324,7 @@ FileOutputProc( return 0; } - written = write(fsPtr->fd, buf, (size_t) toWrite); + written = write(fsPtr->fd, buf, toWrite); if (written >= 0) { return written; } @@ -383,7 +375,7 @@ FileCloseProc( errorCode = errno; } } - ckfree(fsPtr); + Tcl_Free(fsPtr); return errorCode; } @@ -434,67 +426,6 @@ TtyCloseProc( /* *---------------------------------------------------------------------- * - * FileSeekProc -- - * - * This function is called by the generic IO level to move the access - * point in a file based channel. - * - * Results: - * -1 if failed, the new position if successful. An output argument - * contains the POSIX error code if an error occurred, or zero. - * - * Side effects: - * Moves the location at which the channel will be accessed in future - * operations. - * - *---------------------------------------------------------------------- - */ -#ifndef TCL_NO_DEPRECATED -static int -FileSeekProc( - void *instanceData, /* File state. */ - long offset, /* Offset to seek to. */ - int mode, /* Relative to where should we seek? Can be - * one of SEEK_START, SEEK_SET or SEEK_END. */ - int *errorCodePtr) /* To store error code. */ -{ - FileState *fsPtr = (FileState *)instanceData; - long long oldLoc, newLoc; - - /* - * Save our current place in case we need to roll-back the seek. - */ - - oldLoc = TclOSseek(fsPtr->fd, (Tcl_SeekOffset) 0, SEEK_CUR); - if (oldLoc == -1) { - /* - * Bad things are happening. Error out... - */ - - *errorCodePtr = errno; - return -1; - } - - newLoc = TclOSseek(fsPtr->fd, (Tcl_SeekOffset) offset, mode); - - /* - * Check for expressability in our return type, and roll-back otherwise. - */ - - if (newLoc > INT_MAX) { - *errorCodePtr = EOVERFLOW; - TclOSseek(fsPtr->fd, (Tcl_SeekOffset) oldLoc, SEEK_SET); - return -1; - } else { - *errorCodePtr = (newLoc == -1) ? errno : 0; - } - return (int) newLoc; -} -#endif - -/* - *---------------------------------------------------------------------- - * * FileWideSeekProc -- * * This function is called by the generic IO level to move the access @@ -663,9 +594,9 @@ TtySetOptionProc( const char *value) /* New value for option. */ { TtyState *fsPtr = (TtyState *)instanceData; - unsigned int len, vlen; + size_t len, vlen; TtyAttrs tty; - int argc; + size_t argc; const char **argv; struct termios iostate; @@ -748,7 +679,7 @@ TtySetOptionProc( " two elements with each a single 8-bit character", -1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "XCHAR", NULL); } - ckfree(argv); + Tcl_Free(argv); return TCL_ERROR; } @@ -771,7 +702,7 @@ TtySetOptionProc( } iostate.c_cc[VSTOP] = character; } - ckfree(argv); + Tcl_Free(argv); tcsetattr(fsPtr->fileState.fd, TCSADRAIN, &iostate); return TCL_OK; @@ -800,7 +731,8 @@ TtySetOptionProc( if ((len > 4) && (strncmp(optionName, "-ttycontrol", len) == 0)) { #if defined(TIOCMGET) && defined(TIOCMSET) - int i, control, flag; + int control, flag; + size_t i; if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) { return TCL_ERROR; @@ -813,14 +745,14 @@ TtySetOptionProc( Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE", "VALUE", NULL); } - ckfree(argv); + Tcl_Free(argv); return TCL_ERROR; } ioctl(fsPtr->fileState.fd, TIOCMGET, &control); for (i = 0; i < argc-1; i += 2) { if (Tcl_GetBoolean(interp, argv[i+1], &flag) == TCL_ERROR) { - ckfree(argv); + Tcl_Free(argv); return TCL_ERROR; } if (Tcl_UtfNcasecmp(argv[i], "DTR", strlen(argv[i])) == 0) { @@ -844,7 +776,7 @@ TtySetOptionProc( } #else /* TIOCSBRK & TIOCCBRK */ UNSUPPORTED_OPTION("-ttycontrol BREAK"); - ckfree(argv); + Tcl_Free(argv); return TCL_ERROR; #endif /* TIOCSBRK & TIOCCBRK */ } else { @@ -855,13 +787,13 @@ TtySetOptionProc( Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE", "VALUE", NULL); } - ckfree(argv); + Tcl_Free(argv); return TCL_ERROR; } } /* -ttycontrol options loop */ ioctl(fsPtr->fileState.fd, TIOCMSET, &control); - ckfree(argv); + Tcl_Free(argv); return TCL_OK; #else /* TIOCMGET&TIOCMSET */ UNSUPPORTED_OPTION("-ttycontrol"); @@ -1002,7 +934,7 @@ TtyGetOptionProc( Tcl_DString *dsPtr) /* Where to store value(s). */ { TtyState *fsPtr = (TtyState *)instanceData; - unsigned int len; + size_t len; char buf[3*TCL_INTEGER_SPACE + 16]; int valid = 0; /* Flag if valid option parsed. */ struct termios iostate; @@ -1096,11 +1028,11 @@ TtyGetOptionProc( tcgetattr(fsPtr->fileState.fd, &iostate); Tcl_DStringInit(&ds); - Tcl_ExternalToUtfDString(NULL, (char *) &iostate.c_cc[VSTART], 1, &ds); + Tcl_ExternalToUtfDStringEx(NULL, (char *) &iostate.c_cc[VSTART], 1, TCL_ENCODING_NOCOMPLAIN, &ds); Tcl_DStringAppendElement(dsPtr, Tcl_DStringValue(&ds)); TclDStringClear(&ds); - Tcl_ExternalToUtfDString(NULL, (char *) &iostate.c_cc[VSTOP], 1, &ds); + Tcl_ExternalToUtfDStringEx(NULL, (char *) &iostate.c_cc[VSTOP], 1, TCL_ENCODING_NOCOMPLAIN, &ds); Tcl_DStringAppendElement(dsPtr, Tcl_DStringValue(&ds)); Tcl_DStringFree(&ds); } @@ -1730,7 +1662,7 @@ TclpOpenFileChannel( sprintf(channelName, "file%d", fd); } - fsPtr = (TtyState *)ckalloc(sizeof(TtyState)); + fsPtr = (TtyState *)Tcl_Alloc(sizeof(TtyState)); fsPtr->fileState.validMask = channelPermissions | TCL_EXCEPTION; fsPtr->fileState.fd = fd; #ifdef SUPPORTS_TTY @@ -1755,7 +1687,7 @@ TclpOpenFileChannel( if (Tcl_SetChannelOption(interp, fsPtr->fileState.channel, "-translation", translation) != TCL_OK) { - Tcl_Close(NULL, fsPtr->fileState.channel); + Tcl_CloseEx(NULL, fsPtr->fileState.channel, 0); return NULL; } } @@ -1789,32 +1721,37 @@ Tcl_MakeFileChannel( char channelName[16 + TCL_INTEGER_SPACE]; int fd = PTR2INT(handle); const Tcl_ChannelType *channelTypePtr; - struct sockaddr sockaddr; - socklen_t sockaddrLen = sizeof(sockaddr); + struct stat buf; if (mode == 0) { return NULL; } - sockaddr.sa_family = AF_UNSPEC; - #ifdef SUPPORTS_TTY if (isatty(fd)) { channelTypePtr = &ttyChannelType; sprintf(channelName, "serial%d", fd); } else #endif /* SUPPORTS_TTY */ - if ((getsockname(fd, (struct sockaddr *) &sockaddr, &sockaddrLen) == 0) - && (sockaddrLen > 0) - && (sockaddr.sa_family == AF_INET - || sockaddr.sa_family == AF_INET6)) { - return (Tcl_Channel)TclpMakeTcpClientChannelMode(INT2PTR(fd), mode); + if (fstat(fd, &buf) == 0 && S_ISSOCK(buf.st_mode)) { + struct sockaddr sockaddr; + socklen_t sockaddrLen = sizeof(sockaddr); + + sockaddr.sa_family = AF_UNSPEC; + if ((getsockname(fd, (struct sockaddr *)&sockaddr, &sockaddrLen) == 0) + && (sockaddrLen > 0) + && (sockaddr.sa_family == AF_INET + || sockaddr.sa_family == AF_INET6)) { + return (Tcl_Channel)TclpMakeTcpClientChannelMode(INT2PTR(fd), mode); + } + goto normalChannelAfterAll; } else { + normalChannelAfterAll: channelTypePtr = &fileChannelType; sprintf(channelName, "file%d", fd); } - fsPtr = (TtyState *)ckalloc(sizeof(TtyState)); + fsPtr = (TtyState *)Tcl_Alloc(sizeof(TtyState)); fsPtr->fileState.fd = fd; fsPtr->fileState.validMask = mode | TCL_EXCEPTION; fsPtr->fileState.channel = Tcl_CreateChannel(channelTypePtr, channelName, diff --git a/unix/tclUnixCompat.c b/unix/tclUnixCompat.c index 7bd840a..8aff976 100644 --- a/unix/tclUnixCompat.c +++ b/unix/tclUnixCompat.c @@ -8,8 +8,6 @@ */ #include "tclInt.h" -#include <pwd.h> -#include <grp.h> #include <errno.h> #include <string.h> @@ -118,10 +116,10 @@ static int CopyString(const char *src, char *buf, int buflen); #endif #ifdef NEED_PW_CLEANER -static void FreePwBuf(ClientData dummy); +static void FreePwBuf(void *dummy); #endif #ifdef NEED_GR_CLEANER -static void FreeGrBuf(ClientData dummy); +static void FreeGrBuf(void *dummy); #endif #endif /* TCL_THREADS */ @@ -201,7 +199,7 @@ TclpGetPwNam( if (tsdPtr->pbuflen < 1) { tsdPtr->pbuflen = 1024; } - tsdPtr->pbuf = (char *)ckalloc(tsdPtr->pbuflen); + tsdPtr->pbuf = (char *)Tcl_Alloc(tsdPtr->pbuflen); Tcl_CreateThreadExitHandler(FreePwBuf, NULL); } while (1) { @@ -214,7 +212,7 @@ TclpGetPwNam( return NULL; } tsdPtr->pbuflen *= 2; - tsdPtr->pbuf = (char *)ckrealloc(tsdPtr->pbuf, tsdPtr->pbuflen); + tsdPtr->pbuf = (char *)Tcl_Realloc(tsdPtr->pbuf, tsdPtr->pbuflen); } return (pwPtr != NULL ? &tsdPtr->pwd : NULL); @@ -281,7 +279,7 @@ TclpGetPwUid( if (tsdPtr->pbuflen < 1) { tsdPtr->pbuflen = 1024; } - tsdPtr->pbuf = (char *)ckalloc(tsdPtr->pbuflen); + tsdPtr->pbuf = (char *)Tcl_Alloc(tsdPtr->pbuflen); Tcl_CreateThreadExitHandler(FreePwBuf, NULL); } while (1) { @@ -294,7 +292,7 @@ TclpGetPwUid( return NULL; } tsdPtr->pbuflen *= 2; - tsdPtr->pbuf = (char *)ckrealloc(tsdPtr->pbuf, tsdPtr->pbuflen); + tsdPtr->pbuf = (char *)Tcl_Realloc(tsdPtr->pbuf, tsdPtr->pbuflen); } return (pwPtr != NULL ? &tsdPtr->pwd : NULL); @@ -336,11 +334,11 @@ TclpGetPwUid( #ifdef NEED_PW_CLEANER static void FreePwBuf( - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - ckfree(tsdPtr->pbuf); + Tcl_Free(tsdPtr->pbuf); } #endif /* NEED_PW_CLEANER */ @@ -384,7 +382,7 @@ TclpGetGrNam( if (tsdPtr->gbuflen < 1) { tsdPtr->gbuflen = 1024; } - tsdPtr->gbuf = (char *)ckalloc(tsdPtr->gbuflen); + tsdPtr->gbuf = (char *)Tcl_Alloc(tsdPtr->gbuflen); Tcl_CreateThreadExitHandler(FreeGrBuf, NULL); } while (1) { @@ -397,7 +395,7 @@ TclpGetGrNam( return NULL; } tsdPtr->gbuflen *= 2; - tsdPtr->gbuf = (char *)ckrealloc(tsdPtr->gbuf, tsdPtr->gbuflen); + tsdPtr->gbuf = (char *)Tcl_Realloc(tsdPtr->gbuf, tsdPtr->gbuflen); } return (grPtr != NULL ? &tsdPtr->grp : NULL); @@ -464,7 +462,7 @@ TclpGetGrGid( if (tsdPtr->gbuflen < 1) { tsdPtr->gbuflen = 1024; } - tsdPtr->gbuf = (char *)ckalloc(tsdPtr->gbuflen); + tsdPtr->gbuf = (char *)Tcl_Alloc(tsdPtr->gbuflen); Tcl_CreateThreadExitHandler(FreeGrBuf, NULL); } while (1) { @@ -477,7 +475,7 @@ TclpGetGrGid( return NULL; } tsdPtr->gbuflen *= 2; - tsdPtr->gbuf = (char *)ckrealloc(tsdPtr->gbuf, tsdPtr->gbuflen); + tsdPtr->gbuf = (char *)Tcl_Realloc(tsdPtr->gbuf, tsdPtr->gbuflen); } return (grPtr != NULL ? &tsdPtr->grp : NULL); @@ -519,11 +517,11 @@ TclpGetGrGid( #ifdef NEED_GR_CLEANER static void FreeGrBuf( - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - ckfree(tsdPtr->gbuf); + Tcl_Free(tsdPtr->gbuf); } #endif /* NEED_GR_CLEANER */ diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c index ed6a6e0..b205061 100644 --- a/unix/tclUnixFCmd.c +++ b/unix/tclUnixFCmd.c @@ -41,8 +41,6 @@ */ #include "tclInt.h" -#include <utime.h> -#include <grp.h> #ifndef HAVE_STRUCT_STAT_ST_BLKSIZE #ifndef NO_FSTATFS #include <sys/statfs.h> @@ -260,6 +258,11 @@ MODULE_SCOPE long tclMacOSXDarwinRelease; #else # define haveRealpath 1 #endif +#else /* NO_REALPATH */ +/* + * At least TclpObjNormalizedPath now requires REALPATH +*/ +#error NO_REALPATH is not supported #endif /* NO_REALPATH */ #ifdef HAVE_FTS @@ -544,7 +547,7 @@ TclUnixCopyFile( int dontCopyAtts) /* If flag set, don't copy attributes. */ { int srcFd, dstFd; - unsigned blockSize; /* Optimal I/O blocksize for filesystem */ + size_t blockSize; /* Optimal I/O blocksize for filesystem */ char *buffer; /* Data buffer for copy */ size_t nread; @@ -600,21 +603,21 @@ TclUnixCopyFile( if (blockSize <= 0) { blockSize = DEFAULT_COPY_BLOCK_SIZE; } - buffer = (char *)ckalloc(blockSize); + buffer = (char *)Tcl_Alloc(blockSize); while (1) { - nread = (size_t) read(srcFd, buffer, blockSize); - if ((nread == (size_t) -1) || (nread == 0)) { + nread = read(srcFd, buffer, blockSize); + if ((nread == TCL_IO_FAILURE) || (nread == 0)) { break; } if ((size_t) write(dstFd, buffer, nread) != nread) { - nread = (size_t) -1; + nread = TCL_IO_FAILURE; break; } } - ckfree(buffer); + Tcl_Free(buffer); close(srcFd); - if ((close(dstFd) != 0) || (nread == (size_t) -1)) { + if ((close(dstFd) != 0) || (nread == TCL_IO_FAILURE)) { unlink(dst); /* INTL: Native. */ return TCL_ERROR; } @@ -759,16 +762,16 @@ TclpObjCopyDirectory( Tcl_Obj *transPtr; transPtr = Tcl_FSGetTranslatedPath(NULL,srcPathPtr); - Tcl_UtfToExternalDString(NULL, + Tcl_UtfToExternalDStringEx(NULL, (transPtr != NULL ? TclGetString(transPtr) : NULL), - -1, &srcString); + -1, TCL_ENCODING_NOCOMPLAIN, &srcString); if (transPtr != NULL) { Tcl_DecrRefCount(transPtr); } transPtr = Tcl_FSGetTranslatedPath(NULL,destPathPtr); - Tcl_UtfToExternalDString(NULL, + Tcl_UtfToExternalDStringEx(NULL, (transPtr != NULL ? TclGetString(transPtr) : NULL), - -1, &dstString); + -1, TCL_ENCODING_NOCOMPLAIN, &dstString); if (transPtr != NULL) { Tcl_DecrRefCount(transPtr); } @@ -823,9 +826,9 @@ TclpObjRemoveDirectory( int ret; Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr); - Tcl_UtfToExternalDString(NULL, + Tcl_UtfToExternalDStringEx(NULL, (transPtr != NULL ? TclGetString(transPtr) : NULL), - -1, &pathString); + -1, TCL_ENCODING_NOCOMPLAIN, &pathString); if (transPtr != NULL) { Tcl_DecrRefCount(transPtr); } @@ -883,7 +886,7 @@ DoRemoveDirectory( result = TCL_OK; if ((errno != EEXIST) || (recursive == 0)) { if (errorPtr != NULL) { - Tcl_ExternalToUtfDString(NULL, path, TCL_INDEX_NONE, errorPtr); + Tcl_ExternalToUtfDStringEx(NULL, path, TCL_INDEX_NONE, TCL_ENCODING_NOCOMPLAIN, errorPtr); } result = TCL_ERROR; } @@ -950,8 +953,8 @@ TraverseUnixTree( { Tcl_StatBuf statBuf; const char *source, *errfile; - int result, sourceLen; - int targetLen; + int result; + size_t targetLen, sourceLen; #ifndef HAVE_FTS int numProcessed = 0; Tcl_DirEntry *dirEntPtr; @@ -1132,7 +1135,7 @@ TraverseUnixTree( end: if (errfile != NULL) { if (errorPtr != NULL) { - Tcl_ExternalToUtfDString(NULL, errfile, TCL_INDEX_NONE, errorPtr); + Tcl_ExternalToUtfDStringEx(NULL, errfile, TCL_INDEX_NONE, TCL_ENCODING_NOCOMPLAIN, errorPtr); } result = TCL_ERROR; } @@ -1202,8 +1205,8 @@ TraversalCopy( */ if (errorPtr != NULL) { - Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(dstPtr), - Tcl_DStringLength(dstPtr), errorPtr); + Tcl_ExternalToUtfDStringEx(NULL, Tcl_DStringValue(dstPtr), + Tcl_DStringLength(dstPtr), TCL_ENCODING_NOCOMPLAIN, errorPtr); } return TCL_ERROR; } @@ -1253,8 +1256,8 @@ TraversalDelete( break; } if (errorPtr != NULL) { - Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(srcPtr), - Tcl_DStringLength(srcPtr), errorPtr); + Tcl_ExternalToUtfDStringEx(NULL, Tcl_DStringValue(srcPtr), + Tcl_DStringLength(srcPtr), TCL_ENCODING_NOCOMPLAIN, errorPtr); } return TCL_ERROR; } @@ -1421,7 +1424,7 @@ GetOwnerAttribute( } else { Tcl_DString ds; - (void) Tcl_ExternalToUtfDString(NULL, pwPtr->pw_name, TCL_INDEX_NONE, &ds); + Tcl_ExternalToUtfDStringEx(NULL, pwPtr->pw_name, TCL_INDEX_NONE, TCL_ENCODING_NOCOMPLAIN, &ds); *attributePtrPtr = Tcl_DStringToObj(&ds); } return TCL_OK; @@ -1501,10 +1504,11 @@ SetGroupAttribute( Tcl_DString ds; struct group *groupPtr = NULL; const char *string; + size_t length; - string = TclGetString(attributePtr); + string = Tcl_GetStringFromObj(attributePtr, &length); - native = Tcl_UtfToExternalDString(NULL, string, attributePtr->length, &ds); + native = Tcl_UtfToExternalDString(NULL, string, length, &ds); groupPtr = TclpGetGrNam(native); /* INTL: Native. */ Tcl_DStringFree(&ds); @@ -1567,10 +1571,11 @@ SetOwnerAttribute( Tcl_DString ds; struct passwd *pwPtr = NULL; const char *string; + size_t length; - string = TclGetString(attributePtr); + string = Tcl_GetStringFromObj(attributePtr, &length); - native = Tcl_UtfToExternalDString(NULL, string, attributePtr->length, &ds); + native = Tcl_UtfToExternalDString(NULL, string, length, &ds); pwPtr = TclpGetPwNam(native); /* INTL: Native. */ Tcl_DStringFree(&ds); @@ -1942,8 +1947,8 @@ TclpObjNormalizePath( { const char *currentPathEndPosition; char cur; - const char *path = TclGetString(pathPtr); - size_t pathLen = pathPtr->length; + size_t pathLen; + const char *path = Tcl_GetStringFromObj(pathPtr, &pathLen); Tcl_DString ds; const char *nativePath; #ifndef NO_REALPATH @@ -2047,7 +2052,7 @@ TclpObjNormalizePath( nativePath = Tcl_UtfToExternalDString(NULL, path,nextCheckpoint, &ds); if (Realpath(nativePath, normPath) != NULL) { - int newNormLen; + size_t newNormLen; wholeStringOk: newNormLen = strlen(normPath); @@ -2081,7 +2086,7 @@ TclpObjNormalizePath( */ Tcl_DStringFree(&ds); - Tcl_ExternalToUtfDString(NULL, normPath, (int) newNormLen, &ds); + Tcl_ExternalToUtfDStringEx(NULL, normPath, newNormLen, TCL_ENCODING_NOCOMPLAIN, &ds); if (path[nextCheckpoint] != '\0') { /* @@ -2166,14 +2171,15 @@ TclUnixOpenTemporaryFile( Tcl_DString templ, tmp; const char *string; int fd; + size_t length; /* * We should also check against making more then TMP_MAX of these. */ if (dirObj) { - string = TclGetString(dirObj); - Tcl_UtfToExternalDString(NULL, string, dirObj->length, &templ); + string = Tcl_GetStringFromObj(dirObj, &length); + Tcl_UtfToExternalDStringEx(NULL, string, length, TCL_ENCODING_NOCOMPLAIN, &templ); } else { Tcl_DStringInit(&templ); Tcl_DStringAppend(&templ, DefaultTempDir(), TCL_INDEX_NONE); /* INTL: native */ @@ -2182,8 +2188,8 @@ TclUnixOpenTemporaryFile( TclDStringAppendLiteral(&templ, "/"); if (basenameObj) { - string = TclGetString(basenameObj); - Tcl_UtfToExternalDString(NULL, string, basenameObj->length, &tmp); + string = Tcl_GetStringFromObj(basenameObj, &length); + Tcl_UtfToExternalDStringEx(NULL, string, length, TCL_ENCODING_NOCOMPLAIN, &tmp); TclDStringAppendDString(&templ, &tmp); Tcl_DStringFree(&tmp); } else { @@ -2194,8 +2200,8 @@ TclUnixOpenTemporaryFile( #ifdef HAVE_MKSTEMPS if (extensionObj) { - string = TclGetString(extensionObj); - Tcl_UtfToExternalDString(NULL, string, extensionObj->length, &tmp); + string = Tcl_GetStringFromObj(extensionObj, &length); + Tcl_UtfToExternalDStringEx(NULL, string, length, TCL_ENCODING_NOCOMPLAIN, &tmp); TclDStringAppendDString(&templ, &tmp); fd = mkstemps(Tcl_DStringValue(&templ), Tcl_DStringLength(&tmp)); Tcl_DStringFree(&tmp); @@ -2211,8 +2217,8 @@ TclUnixOpenTemporaryFile( } if (resultingNameObj) { - Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&templ), - Tcl_DStringLength(&templ), &tmp); + Tcl_ExternalToUtfDStringEx(NULL, Tcl_DStringValue(&templ), + Tcl_DStringLength(&templ), TCL_ENCODING_NOCOMPLAIN, &tmp); Tcl_SetStringObj(resultingNameObj, Tcl_DStringValue(&tmp), Tcl_DStringLength(&tmp)); Tcl_DStringFree(&tmp); @@ -2298,7 +2304,7 @@ TclpCreateTemporaryDirectory( if (dirObj) { string = TclGetString(dirObj); - Tcl_UtfToExternalDString(NULL, string, dirObj->length, &templ); + Tcl_UtfToExternalDStringEx(NULL, string, dirObj->length, TCL_ENCODING_NOCOMPLAIN, &templ); } else { Tcl_DStringInit(&templ); Tcl_DStringAppend(&templ, DefaultTempDir(), TCL_INDEX_NONE); /* INTL: native */ @@ -2311,7 +2317,7 @@ TclpCreateTemporaryDirectory( if (basenameObj) { string = TclGetString(basenameObj); if (basenameObj->length) { - Tcl_UtfToExternalDString(NULL, string, basenameObj->length, &tmp); + Tcl_UtfToExternalDStringEx(NULL, string, basenameObj->length, TCL_ENCODING_NOCOMPLAIN, &tmp); TclDStringAppendDString(&templ, &tmp); Tcl_DStringFree(&tmp); } else { @@ -2336,8 +2342,8 @@ TclpCreateTemporaryDirectory( * The template has been updated. Tell the caller what it was. */ - Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&templ), - Tcl_DStringLength(&templ), &tmp); + Tcl_ExternalToUtfDStringEx(NULL, Tcl_DStringValue(&templ), + Tcl_DStringLength(&templ), TCL_ENCODING_NOCOMPLAIN, &tmp); Tcl_DStringFree(&templ); return Tcl_DStringToObj(&tmp); } @@ -2359,12 +2365,12 @@ static WCHAR * winPathFromObj( Tcl_Obj *fileName) { - int size; + size_t size; const char *native = (const char *)Tcl_FSGetNativePath(fileName); WCHAR *winPath; size = cygwin_conv_path(1, native, NULL, 0); - winPath = (WCHAR *)ckalloc(size); + winPath = (WCHAR *)Tcl_Alloc(size); cygwin_conv_path(1, native, winPath, size); return winPath; @@ -2404,7 +2410,7 @@ GetUnixFileAttributes( WCHAR *winPath = winPathFromObj(fileName); fileAttributes = GetFileAttributesW(winPath); - ckfree(winPath); + Tcl_Free(winPath); if (fileAttributes == -1) { StatError(interp, fileName); @@ -2451,7 +2457,7 @@ SetUnixFileAttributes( fileAttributes = old = GetFileAttributesW(winPath); if (fileAttributes == -1) { - ckfree(winPath); + Tcl_Free(winPath); StatError(interp, fileName); return TCL_ERROR; } @@ -2464,12 +2470,12 @@ SetUnixFileAttributes( if ((fileAttributes != old) && !SetFileAttributesW(winPath, fileAttributes)) { - ckfree(winPath); + Tcl_Free(winPath); StatError(interp, fileName); return TCL_ERROR; } - ckfree(winPath); + Tcl_Free(winPath); return TCL_OK; } #elif defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE) diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c index 99f8046..50e82c2 100644 --- a/unix/tclUnixFile.c +++ b/unix/tclUnixFile.c @@ -40,7 +40,7 @@ TclpFindExecutable( TCL_UNUSED(const char *) /*argv0*/) { Tcl_Encoding encoding; - int length; + size_t length; wchar_t buf[PATH_MAX] = L""; char name[PATH_MAX * 3 + 1]; @@ -155,7 +155,7 @@ TclpFindExecutable( #endif { encoding = Tcl_GetEncoding(NULL, NULL); - Tcl_ExternalToUtfDString(encoding, name, TCL_INDEX_NONE, &utfName); + Tcl_ExternalToUtfDStringEx(encoding, name, TCL_INDEX_NONE, TCL_ENCODING_NOCOMPLAIN, &utfName); TclSetObjNameOfExecutable( Tcl_NewStringObj(Tcl_DStringValue(&utfName), TCL_INDEX_NONE), encoding); Tcl_DStringFree(&utfName); @@ -181,8 +181,8 @@ TclpFindExecutable( Tcl_DStringAppend(&nameString, name, TCL_INDEX_NONE); Tcl_DStringFree(&buffer); - Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&cwd), - Tcl_DStringLength(&cwd), &buffer); + Tcl_UtfToExternalDStringEx(NULL, Tcl_DStringValue(&cwd), + Tcl_DStringLength(&cwd), TCL_ENCODING_NOCOMPLAIN, &buffer); if (Tcl_DStringValue(&cwd)[Tcl_DStringLength(&cwd) -1] != '/') { TclDStringAppendLiteral(&buffer, "/"); } @@ -191,8 +191,8 @@ TclpFindExecutable( Tcl_DStringFree(&nameString); encoding = Tcl_GetEncoding(NULL, NULL); - Tcl_ExternalToUtfDString(encoding, Tcl_DStringValue(&buffer), TCL_INDEX_NONE, - &utfName); + Tcl_ExternalToUtfDStringEx(encoding, Tcl_DStringValue(&buffer), TCL_INDEX_NONE, + TCL_ENCODING_NOCOMPLAIN, &utfName); TclSetObjNameOfExecutable( Tcl_NewStringObj(Tcl_DStringValue(&utfName), TCL_INDEX_NONE), encoding); Tcl_DStringFree(&utfName); @@ -606,8 +606,7 @@ TclpGetUserHome( if (pwPtr == NULL) { return NULL; } - Tcl_ExternalToUtfDString(NULL, pwPtr->pw_dir, TCL_INDEX_NONE, bufferPtr); - return Tcl_DStringValue(bufferPtr); + return Tcl_ExternalToUtfDString(NULL, pwPtr->pw_dir, TCL_INDEX_NONE, bufferPtr); } /* @@ -729,7 +728,7 @@ TclpGetNativeCwd( #endif /* USEGETWD */ if ((clientData == NULL) || strcmp(buffer, (const char *) clientData)) { - char *newCd = (char*)ckalloc(strlen(buffer) + 1); + char *newCd = (char *)Tcl_Alloc(strlen(buffer) + 1); strcpy(newCd, buffer); return newCd; @@ -828,7 +827,7 @@ TclpReadlink( return NULL; } - Tcl_ExternalToUtfDString(NULL, link, length, linkPtr); + Tcl_ExternalToUtfDStringEx(NULL, link, length, TCL_ENCODING_NOCOMPLAIN, linkPtr); return Tcl_DStringValue(linkPtr); #else return NULL; @@ -949,6 +948,7 @@ TclpObjLink( if (linkAction & TCL_CREATE_SYMBOLIC_LINK) { Tcl_DString ds; Tcl_Obj *transPtr; + size_t length; /* * Now we don't want to link to the absolute, normalized path. @@ -960,8 +960,8 @@ TclpObjLink( if (transPtr == NULL) { return NULL; } - target = TclGetString(transPtr); - target = Tcl_UtfToExternalDString(NULL, target, transPtr->length, &ds); + target = Tcl_GetStringFromObj(transPtr, &length); + target = Tcl_UtfToExternalDString(NULL, target, length, &ds); Tcl_DecrRefCount(transPtr); if (symlink(target, src) != 0) { @@ -996,7 +996,7 @@ TclpObjLink( return NULL; } - Tcl_ExternalToUtfDString(NULL, link, length, &ds); + Tcl_ExternalToUtfDStringEx(NULL, link, length, TCL_ENCODING_NOCOMPLAIN, &ds); linkPtr = Tcl_DStringToObj(&ds); Tcl_IncrRefCount(linkPtr); return linkPtr; @@ -1061,7 +1061,7 @@ TclpNativeToNormalized( { Tcl_DString ds; - Tcl_ExternalToUtfDString(NULL, (const char *) clientData, TCL_INDEX_NONE, &ds); + Tcl_ExternalToUtfDStringEx(NULL, (const char *) clientData, TCL_INDEX_NONE, TCL_ENCODING_NOCOMPLAIN, &ds); return Tcl_DStringToObj(&ds); } @@ -1114,9 +1114,8 @@ TclNativeCreateNativeRep( Tcl_IncrRefCount(validPathPtr); } - str = TclGetString(validPathPtr); - len = validPathPtr->length; - Tcl_UtfToExternalDString(NULL, str, len, &ds); + str = Tcl_GetStringFromObj(validPathPtr, &len); + Tcl_UtfToExternalDStringEx(NULL, str, len, TCL_ENCODING_NOCOMPLAIN, &ds); len = Tcl_DStringLength(&ds) + sizeof(char); if (strlen(Tcl_DStringValue(&ds)) < len - sizeof(char)) { /* See bug [3118489]: NUL in filenames */ @@ -1125,7 +1124,7 @@ TclNativeCreateNativeRep( return NULL; } Tcl_DecrRefCount(validPathPtr); - nativePathPtr = (char *)ckalloc(len); + nativePathPtr = (char *)Tcl_Alloc(len); memcpy(nativePathPtr, Tcl_DStringValue(&ds), len); Tcl_DStringFree(&ds); @@ -1166,7 +1165,7 @@ TclNativeDupInternalRep( len = (strlen((const char*) clientData) + 1) * sizeof(char); - copy = (char *)ckalloc(len); + copy = (char *)Tcl_Alloc(len); memcpy(copy, clientData, len); return copy; } diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c index 1252043..995bd83 100644 --- a/unix/tclUnixInit.c +++ b/unix/tclUnixInit.c @@ -92,7 +92,7 @@ typedef struct { */ #ifndef TCL_DEFAULT_ENCODING -#define TCL_DEFAULT_ENCODING "iso8859-1" +#define TCL_DEFAULT_ENCODING "utf-8" #endif /* @@ -455,7 +455,7 @@ TclpInitPlatform(void) void TclpInitLibraryPath( char **valuePtr, - unsigned int *lengthPtr, + size_t *lengthPtr, Tcl_Encoding *encodingPtr) { #define LIBRARY_SIZE 32 @@ -473,12 +473,12 @@ TclpInitLibraryPath( */ str = getenv("TCL_LIBRARY"); /* INTL: Native. */ - Tcl_ExternalToUtfDString(NULL, str, TCL_INDEX_NONE, &buffer); + Tcl_ExternalToUtfDStringEx(NULL, str, TCL_INDEX_NONE, TCL_ENCODING_NOCOMPLAIN, &buffer); str = Tcl_DStringValue(&buffer); if ((str != NULL) && (str[0] != '\0')) { Tcl_DString ds; - int pathc; + size_t pathc; const char **pathv; char installLib[LIBRARY_SIZE]; @@ -512,7 +512,7 @@ TclpInitLibraryPath( str = Tcl_JoinPath(pathc, pathv, &ds); Tcl_ListObjAppendElement(NULL, pathPtr, Tcl_DStringToObj(&ds)); } - ckfree(pathv); + Tcl_Free(pathv); } /* @@ -544,9 +544,8 @@ TclpInitLibraryPath( Tcl_DStringFree(&buffer); *encodingPtr = Tcl_GetEncoding(NULL, NULL); - str = TclGetString(pathPtr); - *lengthPtr = pathPtr->length; - *valuePtr = (char *)ckalloc(*lengthPtr + 1); + str = Tcl_GetStringFromObj(pathPtr, lengthPtr); + *valuePtr = (char *)Tcl_Alloc(*lengthPtr + 1); memcpy(*valuePtr, str, *lengthPtr + 1); Tcl_DecrRefCount(pathPtr); } @@ -864,6 +863,18 @@ TclpSetVariables( Tcl_SetVar2(interp, "tcl_pkgPath", NULL, pkgPath, TCL_GLOBAL_ONLY); } + { + /* Some platforms build configure scripts expect ~ expansion so do that */ + Tcl_Obj *origPaths; + Tcl_Obj *resolvedPaths; + origPaths = Tcl_GetVar2Ex(interp, "tcl_pkgPath", NULL, TCL_GLOBAL_ONLY); + resolvedPaths = TclResolveTildePathList(origPaths); + if (resolvedPaths != origPaths && resolvedPaths != NULL) { + Tcl_SetVar2Ex(interp, "tcl_pkgPath", NULL, + resolvedPaths, TCL_GLOBAL_ONLY); + } + } + #ifdef DJGPP Tcl_SetVar2(interp, "tcl_platform", "platform", "dos", TCL_GLOBAL_ONLY); #else @@ -988,7 +999,7 @@ TclpSetVariables( * * Results: * The return value is the index in environ of an entry with the name - * "name", or -1 if there is no such entry. The integer at *lengthPtr is + * "name", or TCL_INDEX_NONE if there is no such entry. The integer at *lengthPtr is * filled in with the length of name (if a matching entry is found) or * the length of the environ array (if no matching entry is found). * @@ -998,16 +1009,16 @@ TclpSetVariables( *---------------------------------------------------------------------- */ -int +size_t TclpFindVariable( const char *name, /* Name of desired environment variable * (native). */ - int *lengthPtr) /* Used to return length of name (for + size_t *lengthPtr) /* Used to return length of name (for * successful searches) or number of non-NULL * entries in environ (for unsuccessful * searches). */ { - int i, result = -1; + size_t i, result = TCL_INDEX_NONE; const char *env, *p1, *p2; Tcl_DString envString; diff --git a/unix/tclUnixPipe.c b/unix/tclUnixPipe.c index c53360a..0692df5 100644 --- a/unix/tclUnixPipe.c +++ b/unix/tclUnixPipe.c @@ -35,7 +35,7 @@ typedef struct { TclFile inFile; /* Output from pipe. */ TclFile outFile; /* Input to pipe. */ TclFile errorFile; /* Error output from pipe. */ - int numPids; /* How many processes are attached to this + size_t numPids; /* How many processes are attached to this * pipe? */ Tcl_Pid *pidPtr; /* The process IDs themselves. Allocated by * the creator of the pipe. */ @@ -69,7 +69,7 @@ static int SetupStdFile(TclFile file, int type); static const Tcl_ChannelType pipeChannelType = { "pipe", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ - TCL_CLOSE2PROC, /* Close proc. */ + NULL, /* Close proc. */ PipeInputProc, /* Input proc. */ PipeOutputProc, /* Output proc. */ NULL, /* Seek proc. */ @@ -381,7 +381,7 @@ TclpCreateProcess( * occurred when creating the child process. * Error messages from the child process * itself are sent to errorFile. */ - int argc, /* Number of arguments in following array. */ + size_t argc, /* Number of arguments in following array. */ const char **argv, /* Array of argument strings in UTF-8. * argv[0] contains the name of the executable * translated using Tcl_TranslateFileName @@ -410,7 +410,8 @@ TclpCreateProcess( char errSpace[200 + TCL_INTEGER_SPACE]; Tcl_DString *dsArray; char **newArgv; - int pid, i; + int pid; + size_t i; errPipeIn = NULL; errPipeOut = NULL; @@ -524,7 +525,7 @@ TclpCreateProcess( errPipeOut = NULL; fd = GetFd(errPipeIn); - count = read(fd, errSpace, (size_t) (sizeof(errSpace) - 1)); + count = read(fd, errSpace, sizeof(errSpace) - 1); if (count > 0) { char *end; @@ -736,7 +737,7 @@ TclpCreateCommandChannel( TclFile writeFile, /* If non-null, gives the file for writing. */ TclFile errorFile, /* If non-null, gives the file where errors * can be read. */ - int numPids, /* The number of pids in the pid array. */ + size_t numPids, /* The number of pids in the pid array. */ Tcl_Pid *pidPtr) /* An array of process identifiers. Allocated * by the caller, freed when the channel is * closed or the processes are detached (in a @@ -744,7 +745,7 @@ TclpCreateCommandChannel( { char channelName[16 + TCL_INTEGER_SPACE]; int channelId; - PipeState *statePtr = (PipeState *)ckalloc(sizeof(PipeState)); + PipeState *statePtr = (PipeState *)Tcl_Alloc(sizeof(PipeState)); int mode; statePtr->inFile = readFile; @@ -858,7 +859,7 @@ TclGetAndDetachPids( PipeState *pipePtr; const Tcl_ChannelType *chanTypePtr; Tcl_Obj *pidsObj; - int i; + size_t i; /* * Punt if the channel is not a command channel. @@ -878,7 +879,7 @@ TclGetAndDetachPids( } Tcl_SetObjResult(interp, pidsObj); if (pipePtr->numPids > 0) { - ckfree(pipePtr->pidPtr); + Tcl_Free(pipePtr->pidPtr); pipePtr->numPids = 0; } } @@ -1008,9 +1009,9 @@ PipeClose2Proc( } if (pipePtr->numPids != 0) { - ckfree(pipePtr->pidPtr); + Tcl_Free(pipePtr->pidPtr); } - ckfree(pipePtr); + Tcl_Free(pipePtr); if (errorCode == 0) { return result; } @@ -1058,7 +1059,7 @@ PipeInputProc( */ do { - bytesRead = read(GetFd(psPtr->inFile), buf, (size_t) toRead); + bytesRead = read(GetFd(psPtr->inFile), buf, toRead); } while ((bytesRead < 0) && (errno == EINTR)); if (bytesRead < 0) { @@ -1104,7 +1105,7 @@ PipeOutputProc( */ do { - written = write(GetFd(psPtr->outFile), buf, (size_t) toWrite); + written = write(GetFd(psPtr->outFile), buf, toWrite); } while ((written < 0) && (errno == EINTR)); if (written < 0) { @@ -1250,14 +1251,14 @@ Tcl_WaitPid( int Tcl_PidObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Argument strings. */ { Tcl_Channel chan; PipeState *pipePtr; - int i; + size_t i; Tcl_Obj *resultPtr; if (objc > 2) { @@ -1272,7 +1273,7 @@ Tcl_PidObjCmd( * Get the channel and make sure that it refers to a pipe. */ - chan = Tcl_GetChannel(interp, Tcl_GetString(objv[1]), NULL); + chan = Tcl_GetChannel(interp, TclGetString(objv[1]), NULL); if (chan == NULL) { return TCL_ERROR; } @@ -1288,7 +1289,7 @@ Tcl_PidObjCmd( TclNewObj(resultPtr); for (i = 0; i < pipePtr->numPids; i++) { Tcl_ListObjAppendElement(NULL, resultPtr, - Tcl_NewWideIntObj(PTR2INT(TclpGetPid(pipePtr->pidPtr[i])))); + Tcl_NewWideIntObj(TclpGetPid(pipePtr->pidPtr[i]))); } Tcl_SetObjResult(interp, resultPtr); } diff --git a/unix/tclUnixPort.h b/unix/tclUnixPort.h index 791c2a3..54f98c8 100644 --- a/unix/tclUnixPort.h +++ b/unix/tclUnixPort.h @@ -90,11 +90,8 @@ typedef off_t Tcl_SeekOffset; extern "C" { #endif /* Make some symbols available without including <windows.h> */ -# define DWORD unsigned int # define CP_UTF8 65001 # define GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS 0x00000004 -# define HANDLE void * -# define HINSTANCE void * # define HMODULE void * # define MAX_PATH 260 # define SOCKET unsigned int @@ -678,9 +675,9 @@ typedef int socklen_t; *--------------------------------------------------------------------------- */ -#define TclpSysAlloc(size, isBin) malloc((size_t)(size)) -#define TclpSysFree(ptr) free((char *)(ptr)) -#define TclpSysRealloc(ptr, size) realloc((char *)(ptr), (size_t)(size)) +#define TclpSysAlloc(size) malloc(size) +#define TclpSysFree(ptr) free(ptr) +#define TclpSysRealloc(ptr, size) realloc(ptr, size) /* *--------------------------------------------------------------------------- diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c index 70dfc61..864d477 100644 --- a/unix/tclUnixSock.c +++ b/unix/tclUnixSock.c @@ -156,11 +156,7 @@ static void WrapNotify(void *clientData, int mask); static const Tcl_ChannelType tcpChannelType = { "tcp", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ -#ifndef TCL_NO_DEPRECATED - TcpCloseProc, /* Close proc. */ -#else - TCL_CLOSE2PROC, /* Close proc. */ -#endif + NULL, /* Close proc. */ TcpInputProc, /* Input proc. */ TcpOutputProc, /* Output proc. */ NULL, /* Seek proc. */ @@ -220,7 +216,7 @@ printaddrinfo( static void InitializeHostName( char **valuePtr, - unsigned int *lengthPtr, + size_t *lengthPtr, Tcl_Encoding *encodingPtr) { const char *native = NULL; @@ -242,12 +238,12 @@ InitializeHostName( char *dot = strchr(u.nodename, '.'); if (dot != NULL) { - char *node = (char *)ckalloc(dot - u.nodename + 1); + char *node = (char *)Tcl_Alloc(dot - u.nodename + 1); memcpy(node, u.nodename, dot - u.nodename); node[dot - u.nodename] = '\0'; hp = TclpGetHostByName(node); - ckfree(node); + Tcl_Free(node); } } if (hp != NULL) { @@ -286,11 +282,11 @@ InitializeHostName( *encodingPtr = Tcl_GetEncoding(NULL, NULL); if (native) { *lengthPtr = strlen(native); - *valuePtr = (char *)ckalloc(*lengthPtr + 1); + *valuePtr = (char *)Tcl_Alloc(*lengthPtr + 1); memcpy(*valuePtr, native, *lengthPtr + 1); } else { *lengthPtr = 0; - *valuePtr = (char *)ckalloc(1); + *valuePtr = (char *)Tcl_Alloc(1); *valuePtr[0] = '\0'; } } @@ -316,7 +312,8 @@ InitializeHostName( const char * Tcl_GetHostName(void) { - return Tcl_GetString(TclGetProcessGlobalValue(&hostName)); + Tcl_Obj *tclObj = TclGetProcessGlobalValue(&hostName); + return TclGetString(tclObj); } /* @@ -626,7 +623,7 @@ TcpCloseProc( while (fds != NULL) { TcpFdList *next = fds->next; - ckfree(fds); + Tcl_Free(fds); fds = next; } if (statePtr->addrlist != NULL) { @@ -635,7 +632,7 @@ TcpCloseProc( if (statePtr->myaddrlist != NULL) { freeaddrinfo(statePtr->myaddrlist); } - ckfree(statePtr); + Tcl_Free(statePtr); return errorCode; } @@ -1531,7 +1528,7 @@ Tcl_OpenTcpClient( * Allocate a new TcpState for this socket. */ - statePtr = (TcpState *)ckalloc(sizeof(TcpState)); + statePtr = (TcpState *)Tcl_Alloc(sizeof(TcpState)); memset(statePtr, 0, sizeof(TcpState)); statePtr->flags = async ? TCP_ASYNC_CONNECT : 0; statePtr->cachedBlocking = TCL_MODE_BLOCKING; @@ -1554,7 +1551,7 @@ Tcl_OpenTcpClient( statePtr, TCL_READABLE | TCL_WRITABLE); if (Tcl_SetChannelOption(interp, statePtr->channel, "-translation", "auto crlf") == TCL_ERROR) { - Tcl_Close(NULL, statePtr->channel); + Tcl_CloseEx(NULL, statePtr->channel, 0); return NULL; } return statePtr->channel; @@ -1610,7 +1607,7 @@ TclpMakeTcpClientChannelMode( TcpState *statePtr; char channelName[SOCK_CHAN_LENGTH]; - statePtr = (TcpState *)ckalloc(sizeof(TcpState)); + statePtr = (TcpState *)Tcl_Alloc(sizeof(TcpState)); memset(statePtr, 0, sizeof(TcpState)); statePtr->fds.fd = PTR2INT(sock); statePtr->flags = 0; @@ -1621,7 +1618,7 @@ TclpMakeTcpClientChannelMode( statePtr, mode); if (Tcl_SetChannelOption(NULL, statePtr->channel, "-translation", "auto crlf") == TCL_ERROR) { - Tcl_Close(NULL, statePtr->channel); + Tcl_CloseEx(NULL, statePtr->channel, 0); return NULL; } return statePtr->channel; @@ -1837,14 +1834,14 @@ Tcl_OpenTcpServerEx( * Allocate a new TcpState for this socket. */ - statePtr = (TcpState *)ckalloc(sizeof(TcpState)); + statePtr = (TcpState *)Tcl_Alloc(sizeof(TcpState)); memset(statePtr, 0, sizeof(TcpState)); statePtr->acceptProc = acceptProc; statePtr->acceptProcData = acceptProcData; sprintf(channelName, SOCK_TEMPLATE, PTR2INT(statePtr)); newfds = &statePtr->fds; } else { - newfds = (TcpFdList *)ckalloc(sizeof(TcpFdList)); + newfds = (TcpFdList *)Tcl_Alloc(sizeof(TcpFdList)); memset(newfds, (int) 0, sizeof(TcpFdList)); fds->next = newfds; } @@ -1928,7 +1925,7 @@ TcpAccept( (void) fcntl(newsock, F_SETFD, FD_CLOEXEC); - newSockState = (TcpState *)ckalloc(sizeof(TcpState)); + newSockState = (TcpState *)Tcl_Alloc(sizeof(TcpState)); memset(newSockState, 0, sizeof(TcpState)); newSockState->flags = 0; newSockState->fds.fd = newsock; diff --git a/unix/tclUnixTest.c b/unix/tclUnixTest.c index 80e8081..ccb9105 100644 --- a/unix/tclUnixTest.c +++ b/unix/tclUnixTest.c @@ -129,7 +129,7 @@ TclplatformtestInit( static int TestfilehandlerCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Argument strings. */ @@ -310,7 +310,7 @@ TestfilehandlerCmd( static void TestFileHandlerProc( - ClientData clientData, /* Points to a Pipe structure. */ + void *clientData, /* Points to a Pipe structure. */ int mask) /* Indicates which events happened: * TCL_READABLE or TCL_WRITABLE. */ { @@ -343,7 +343,7 @@ TestFileHandlerProc( static int TestfilewaitCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Argument strings. */ @@ -351,7 +351,7 @@ TestfilewaitCmd( int mask, result, timeout; Tcl_Channel channel; int fd; - ClientData data; + void *data; if (objc != 4) { Tcl_WrongNumArgs(interp, 2, objv, "file readable|writable|both timeout"); @@ -374,7 +374,7 @@ TestfilewaitCmd( } if (Tcl_GetChannelHandle(channel, (mask & TCL_READABLE) ? TCL_READABLE : TCL_WRITABLE, - (ClientData*) &data) != TCL_OK) { + (void **) &data) != TCL_OK) { Tcl_AppendResult(interp, "couldn't get channel file", NULL); return TCL_ERROR; } @@ -411,7 +411,7 @@ TestfilewaitCmd( static int TestfindexecutableCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Argument strings. */ @@ -453,7 +453,7 @@ TestfindexecutableCmd( static int TestforkCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Argument strings. */ @@ -499,7 +499,7 @@ TestforkCmd( static int TestalarmCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Argument strings. */ @@ -577,7 +577,7 @@ AlarmHandler( static int TestgotsigCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ TCL_UNUSED(int) /*objc*/, TCL_UNUSED(Tcl_Obj *const *)) @@ -608,7 +608,7 @@ TestgotsigCmd( static int TestchmodCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Argument strings. */ diff --git a/unix/tclUnixThrd.c b/unix/tclUnixThrd.c index aa5926e..36f0648 100644 --- a/unix/tclUnixThrd.c +++ b/unix/tclUnixThrd.c @@ -160,14 +160,6 @@ PCondTimedWait( } #endif /* HAVE_PTHREAD_MUTEX_RECURSIVE */ -#ifndef TCL_NO_DEPRECATED -typedef struct { - char nabuf[16]; -} ThreadSpecificData; - -static Tcl_ThreadDataKey dataKey; -#endif /* TCL_NO_DEPRECATED */ - /* * globalLock is used to serialize creation of mutexes, condition variables, * and thread local storage. This is the only place that can count on the @@ -222,7 +214,7 @@ TclpThreadCreate( Tcl_ThreadId *idPtr, /* Return, the ID of the thread */ Tcl_ThreadCreateProc *proc, /* Main() function of the thread */ ClientData clientData, /* The one argument to Main() */ - int stackSize, /* Size of stack for the new thread */ + size_t stackSize, /* Size of stack for the new thread */ int flags) /* Flags controlling behaviour of the new * thread. */ { @@ -585,7 +577,7 @@ Tcl_MutexLock( * Double inside global lock check to avoid a race condition. */ - pmutexPtr = (PMutex *)ckalloc(sizeof(PMutex)); + pmutexPtr = (PMutex *)Tcl_Alloc(sizeof(PMutex)); PMutexInit(pmutexPtr); *mutexPtr = (Tcl_Mutex) pmutexPtr; TclRememberMutex(mutexPtr); @@ -649,7 +641,7 @@ TclpFinalizeMutex( if (pmutexPtr != NULL) { PMutexDestroy(pmutexPtr); - ckfree(pmutexPtr); + Tcl_Free(pmutexPtr); *mutexPtr = NULL; } } @@ -695,7 +687,7 @@ Tcl_ConditionWait( */ if (*condPtr == NULL) { - pcondPtr = (pthread_cond_t *)ckalloc(sizeof(pthread_cond_t)); + pcondPtr = (pthread_cond_t *)Tcl_Alloc(sizeof(pthread_cond_t)); pthread_cond_init(pcondPtr, NULL); *condPtr = (Tcl_Condition) pcondPtr; TclRememberCondition(condPtr); @@ -783,59 +775,11 @@ TclpFinalizeCondition( if (pcondPtr != NULL) { pthread_cond_destroy(pcondPtr); - ckfree(pcondPtr); + Tcl_Free(pcondPtr); *condPtr = NULL; } } -#endif /* TCL_THREADS */ - -/* - *---------------------------------------------------------------------- - * - * TclpReaddir, TclpInetNtoa -- - * - * These procedures replace core C versions to be used in a threaded - * environment. - * - * Results: - * See documentation of C functions. - * - * Side effects: - * See documentation of C functions. - * - * Notes: - * TclpReaddir is no longer used by the core (see 1095909), but it - * appears in the internal stubs table (see #589526). - * - *---------------------------------------------------------------------- - */ - -#ifndef TCL_NO_DEPRECATED -Tcl_DirEntry * -TclpReaddir( - TclDIR * dir) -{ - return TclOSreaddir(dir); -} - -#undef TclpInetNtoa -char * -TclpInetNtoa( - struct in_addr addr) -{ -#if TCL_THREADS - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - unsigned char *b = (unsigned char*) &addr.s_addr; - - sprintf(tsdPtr->nabuf, "%u.%u.%u.%u", b[0], b[1], b[2], b[3]); - return tsdPtr->nabuf; -#else - return inet_ntoa(addr); -#endif -} -#endif /* TCL_NO_DEPRECATED */ -#if TCL_THREADS /* * Additions by AOL for specialized thread memory allocator. */ @@ -925,7 +869,7 @@ TclpThreadCreateKey(void) { pthread_key_t *ptkeyPtr; - ptkeyPtr = (pthread_key_t *)TclpSysAlloc(sizeof(pthread_key_t), 0); + ptkeyPtr = (pthread_key_t *)TclpSysAlloc(sizeof(pthread_key_t)); if (NULL == ptkeyPtr) { Tcl_Panic("unable to allocate thread key!"); } diff --git a/unix/tclUnixTime.c b/unix/tclUnixTime.c index 6ca641d..7830dc8 100644 --- a/unix/tclUnixTime.c +++ b/unix/tclUnixTime.c @@ -16,41 +16,13 @@ #endif /* - * TclpGetDate is coded to return a pointer to a 'struct tm'. For thread - * safety, this structure must be in thread-specific data. The 'tmKey' - * variable is the key to this buffer. - */ - -#ifndef TCL_NO_DEPRECATED -static Tcl_ThreadDataKey tmKey; -typedef struct { - struct tm gmtime_buf; - struct tm localtime_buf; -} ThreadSpecificData; - -/* - * If we fall back on the thread-unsafe versions of gmtime and localtime, use - * this mutex to try to protect them. - */ - -TCL_DECLARE_MUTEX(tmMutex) - -static char *lastTZ = NULL; /* Holds the last setting of the TZ - * environment variable, or an empty string if - * the variable was not set. */ - -/* * Static functions declared in this file. */ -static void SetTZIfNecessary(void); -static void CleanupMemory(ClientData clientData); -#endif /* TCL_NO_DEPRECATED */ - static void NativeScaleTime(Tcl_Time *timebuf, - ClientData clientData); + void *clientData); static void NativeGetTime(Tcl_Time *timebuf, - ClientData clientData); + void *clientData); /* * TIP #233 (Virtualized Time): Data for the time hooks, if any. @@ -94,10 +66,10 @@ IsTimeNative(void) *---------------------------------------------------------------------- */ -unsigned long +unsigned long long TclpGetSeconds(void) { - return time(NULL); + return (unsigned long long) time(NULL); } /* @@ -123,7 +95,7 @@ TclpGetMicroseconds(void) Tcl_Time time; GetTime(&time); - return ((long long) time.sec)*1000000 + time.usec; + return ((long long)(unsigned long) time.sec)*1000000 + time.usec; } /* @@ -145,30 +117,32 @@ TclpGetMicroseconds(void) *---------------------------------------------------------------------- */ -unsigned long +unsigned long long TclpGetClicks(void) { - unsigned long now; + unsigned long long now; #ifdef NO_GETTOD if (!IsTimeNative()) { Tcl_Time time; GetTime(&time); - now = ((unsigned long)(time.sec)*1000000UL) + (unsigned long)(time.usec); + now = ((unsigned long long)(time.sec)*1000000ULL) + + (unsigned long long)(time.usec); } else { /* * A semi-NativeGetTime, specialized to clicks. */ struct tms dummy; - now = (unsigned long) times(&dummy); + now = (unsigned long long) times(&dummy); } #else /* !NO_GETTOD */ Tcl_Time time; GetTime(&time); - now = ((unsigned long)(time.sec)*1000000UL) + (unsigned long)(time.usec); + now = ((unsigned long long)(time.sec)*1000000ULL) + + (unsigned long long)(time.usec); #endif /* NO_GETTOD */ return now; @@ -181,7 +155,7 @@ TclpGetClicks(void) * TclpGetWideClicks -- * * This procedure returns a WideInt value that represents the highest - * resolution clock available on the system. There are no garantees on + * resolution clock available on the system. There are no guarantees on * what the resolution will be. In Tcl we will call this value a "click". * The start time is also system dependent. * @@ -290,17 +264,15 @@ TclpWideClickInMicrosec(void) static int initialized = 0; static double scale = 0.0; - if (initialized) { - return scale; - } else { + if (!initialized) { mach_timebase_info_data_t tb; mach_timebase_info(&tb); /* value of tb.numer / tb.denom = 1 click in nanoseconds */ - scale = ((double)tb.numer) / tb.denom / 1000; + scale = ((double) tb.numer) / tb.denom / 1000; initialized = 1; - return scale; } + return scale; #else #error Wide high-resolution clicks not implemented on this platform #endif /* MAC_OSX_TCL */ @@ -338,116 +310,6 @@ Tcl_GetTime( /* *---------------------------------------------------------------------- * - * TclpGetDate -- - * - * This function converts between seconds and struct tm. If useGMT is - * true, then the returned date will be in Greenwich Mean Time (GMT). - * Otherwise, it will be in the local time zone. - * - * Results: - * Returns a static tm structure. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -#ifndef TCL_NO_DEPRECATED -struct tm * -TclpGetDate( - const time_t *time, - int useGMT) -{ - if (useGMT) { - return TclpGmtime(time); - } else { - return TclpLocaltime(time); - } -} - -/* - *---------------------------------------------------------------------- - * - * TclpGmtime -- - * - * Wrapper around the 'gmtime' library function to make it thread safe. - * - * Results: - * Returns a pointer to a 'struct tm' in thread-specific data. - * - * Side effects: - * Invokes gmtime or gmtime_r as appropriate. - * - *---------------------------------------------------------------------- - */ - -struct tm * -TclpGmtime( - const time_t *timePtr) /* Pointer to the number of seconds since the - * local system's epoch */ -{ - /* - * Get a thread-local buffer to hold the returned time. - */ - - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tmKey); - -#ifdef HAVE_GMTIME_R - gmtime_r(timePtr, &tsdPtr->gmtime_buf); -#else - Tcl_MutexLock(&tmMutex); - memcpy(&tsdPtr->gmtime_buf, gmtime(timePtr), sizeof(struct tm)); - Tcl_MutexUnlock(&tmMutex); -#endif - - return &tsdPtr->gmtime_buf; -} - -/* - *---------------------------------------------------------------------- - * - * TclpLocaltime -- - * - * Wrapper around the 'localtime' library function to make it thread - * safe. - * - * Results: - * Returns a pointer to a 'struct tm' in thread-specific data. - * - * Side effects: - * Invokes localtime or localtime_r as appropriate. - * - *---------------------------------------------------------------------- - */ - -struct tm * -TclpLocaltime( - const time_t *timePtr) /* Pointer to the number of seconds since the - * local system's epoch */ -{ - /* - * Get a thread-local buffer to hold the returned time. - */ - - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tmKey); - - SetTZIfNecessary(); -#ifdef HAVE_LOCALTIME_R - localtime_r(timePtr, &tsdPtr->localtime_buf); -#else - Tcl_MutexLock(&tmMutex); - memcpy(&tsdPtr->localtime_buf, localtime(timePtr), sizeof(struct tm)); - Tcl_MutexUnlock(&tmMutex); -#endif - - return &tsdPtr->localtime_buf; -} -#endif /* TCL_NO_DEPRECATED */ - -/* - *---------------------------------------------------------------------- - * * Tcl_SetTimeProc -- * * TIP #233 (Virtualized Time): Registers two handlers for the @@ -466,7 +328,7 @@ void Tcl_SetTimeProc( Tcl_GetTimeProc *getProc, Tcl_ScaleTimeProc *scaleProc, - ClientData clientData) + void *clientData) { tclGetTimeProcPtr = getProc; tclScaleTimeProcPtr = scaleProc; @@ -493,7 +355,7 @@ void Tcl_QueryTimeProc( Tcl_GetTimeProc **getProc, Tcl_ScaleTimeProc **scaleProc, - ClientData *clientData) + void **clientData) { if (getProc) { *getProc = tclGetTimeProcPtr; @@ -526,7 +388,7 @@ Tcl_QueryTimeProc( static void NativeScaleTime( TCL_UNUSED(Tcl_Time *), - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { /* Native scale is 1:1. Nothing is done */ } @@ -551,7 +413,7 @@ NativeScaleTime( static void NativeGetTime( Tcl_Time *timePtr, - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { struct timeval tv; @@ -559,72 +421,6 @@ NativeGetTime( timePtr->sec = tv.tv_sec; timePtr->usec = tv.tv_usec; } -/* - *---------------------------------------------------------------------- - * - * SetTZIfNecessary -- - * - * Determines whether a call to 'tzset' is needed prior to the next call - * to 'localtime' or examination of the 'timezone' variable. - * - * Results: - * None. - * - * Side effects: - * If 'tzset' has never been called in the current process, or if the - * value of the environment variable TZ has changed since the last call - * to 'tzset', then 'tzset' is called again. - * - *---------------------------------------------------------------------- - */ - -#ifndef TCL_NO_DEPRECATED -static void -SetTZIfNecessary(void) -{ - const char *newTZ = getenv("TZ"); - - Tcl_MutexLock(&tmMutex); - if (newTZ == NULL) { - newTZ = ""; - } - if (lastTZ == NULL || strcmp(lastTZ, newTZ)) { - tzset(); - if (lastTZ == NULL) { - Tcl_CreateExitHandler(CleanupMemory, NULL); - } else { - ckfree(lastTZ); - } - lastTZ = (char *) ckalloc(strlen(newTZ) + 1); - strcpy(lastTZ, newTZ); - } - Tcl_MutexUnlock(&tmMutex); -} - -/* - *---------------------------------------------------------------------- - * - * CleanupMemory -- - * - * Releases the private copy of the TZ environment variable upon exit - * from Tcl. - * - * Results: - * None. - * - * Side effects: - * Frees allocated memory. - * - *---------------------------------------------------------------------- - */ - -static void -CleanupMemory( - TCL_UNUSED(ClientData)) -{ - ckfree(lastTZ); -} -#endif /* TCL_NO_DEPRECATED */ /* * Local Variables: diff --git a/unix/tclXtNotify.c b/unix/tclXtNotify.c index 45bda3e..ab1bfee 100644 --- a/unix/tclXtNotify.c +++ b/unix/tclXtNotify.c @@ -33,7 +33,7 @@ typedef struct FileHandler { XtInputId except; /* Xt exception callback handle. */ Tcl_FileProc *proc; /* Procedure to call, in the style of * Tcl_CreateFileHandler. */ - ClientData clientData; /* Argument to pass to proc. */ + void *clientData; /* Argument to pass to proc. */ struct FileHandler *nextPtr;/* Next in list of all files we care about. */ } FileHandler; @@ -79,10 +79,10 @@ static int initialized = 0; static int FileHandlerEventProc(Tcl_Event *evPtr, int flags); static void FileProc(XtPointer clientData, int *source, XtInputId *id); -static void NotifierExitHandler(ClientData clientData); +static void NotifierExitHandler(void *clientData); static void TimerProc(XtPointer clientData, XtIntervalId *id); static void CreateFileHandler(int fd, int mask, - Tcl_FileProc *proc, ClientData clientData); + Tcl_FileProc *proc, void *clientData); static void DeleteFileHandler(int fd); static void SetTimer(const Tcl_Time * timePtr); static int WaitForEvent(const Tcl_Time * timePtr); @@ -229,7 +229,7 @@ InitNotifier(void) static void NotifierExitHandler( - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { if (notifier.currentTimeout != 0) { XtRemoveTimeOut(notifier.currentTimeout); @@ -265,7 +265,7 @@ static void SetTimer( const Tcl_Time *timePtr) /* Timeout value, may be NULL. */ { - long timeout; + unsigned long timeout; if (!initialized) { InitNotifier(); @@ -278,7 +278,7 @@ SetTimer( if (timePtr) { timeout = timePtr->sec * 1000 + timePtr->usec / 1000; notifier.currentTimeout = XtAppAddTimeOut(notifier.appContext, - (unsigned long) timeout, TimerProc, NULL); + timeout, TimerProc, NULL); } else { notifier.currentTimeout = 0; } @@ -339,7 +339,7 @@ CreateFileHandler( * called. */ Tcl_FileProc *proc, /* Procedure to call for each selected * event. */ - ClientData clientData) /* Arbitrary data to pass to proc. */ + void *clientData) /* Arbitrary data to pass to proc. */ { FileHandler *filePtr; @@ -356,7 +356,7 @@ CreateFileHandler( } } if (filePtr == NULL) { - filePtr = (FileHandler *) ckalloc(sizeof(FileHandler)); + filePtr = (FileHandler *) Tcl_Alloc(sizeof(FileHandler)); filePtr->fd = fd; filePtr->read = 0; filePtr->write = 0; @@ -467,7 +467,7 @@ DeleteFileHandler( if (filePtr->mask & TCL_EXCEPTION) { XtRemoveInput(filePtr->except); } - ckfree(filePtr); + Tcl_Free(filePtr); } /* @@ -522,7 +522,7 @@ FileProc( */ filePtr->readyMask |= mask; - fileEvPtr = (FileHandlerEvent *) ckalloc(sizeof(FileHandlerEvent)); + fileEvPtr = (FileHandlerEvent *) Tcl_Alloc(sizeof(FileHandlerEvent)); fileEvPtr->header.proc = FileHandlerEventProc; fileEvPtr->fd = filePtr->fd; Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL); diff --git a/unix/tclXtTest.c b/unix/tclXtTest.c index 882f497..09b16c5 100644 --- a/unix/tclXtTest.c +++ b/unix/tclXtTest.c @@ -77,7 +77,7 @@ Tclxttest_Init( static int TesteventloopCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ diff --git a/win/Makefile.in b/win/Makefile.in index 689f9b8..7a5dc09 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -50,7 +50,7 @@ LIB_INSTALL_DIR = $(INSTALL_ROOT)$(libdir) SCRIPT_INSTALL_DIR = $(INSTALL_ROOT)$(TCL_LIBRARY) # Path name to use when installing Tcl modules. -MODULE_INSTALL_DIR = $(SCRIPT_INSTALL_DIR)/../tcl8 +MODULE_INSTALL_DIR = $(SCRIPT_INSTALL_DIR)/../tcl9 # Directory in which to install the include file tcl.h: INCLUDE_INSTALL_DIR = $(INSTALL_ROOT)$(includedir) @@ -82,7 +82,7 @@ CFLAGS_OPTIMIZE = @CFLAGS_OPTIMIZE@ #CFLAGS = $(CFLAGS_DEBUG) #CFLAGS = $(CFLAGS_OPTIMIZE) #CFLAGS = $(CFLAGS_DEBUG) $(CFLAGS_OPTIMIZE) -CFLAGS = @CFLAGS@ @CFLAGS_DEFAULT@ -D__USE_MINGW_ANSI_STDIO=0 -DMP_FIXED_CUTOFFS -DMP_NO_STDINT +CFLAGS = @CFLAGS@ @CFLAGS_DEFAULT@ -DMP_FIXED_CUTOFFS -D__USE_MINGW_ANSI_STDIO=0 -DMP_NO_STDINT # To compile without backward compatibility and deprecated code uncomment the # following @@ -149,9 +149,11 @@ TCL_VFS_ROOT = libtcl.vfs TCL_STUB_LIB_FILE = @TCL_STUB_LIB_FILE@ TCL_DLL_FILE = @TCL_DLL_FILE@ TCL_LIB_FILE = @TCL_LIB_FILE@ -DDE_DLL_FILE = tcldde$(DDEVER)${DLLSUFFIX} +DDE_DLL_FILE = tcl9dde$(DDEVER)${DLLSUFFIX} +DDE_DLL_FILE8 = tcldde$(DDEVER)${DLLSUFFIX} DDE_LIB_FILE = @LIBPREFIX@tcldde$(DDEVER)${DLLSUFFIX}${LIBSUFFIX} -REG_DLL_FILE = tclregistry$(REGVER)${DLLSUFFIX} +REG_DLL_FILE = tcl9registry$(REGVER)${DLLSUFFIX} +REG_DLL_FILE8 = tclregistry$(REGVER)${DLLSUFFIX} REG_LIB_FILE = @LIBPREFIX@tclregistry$(REGVER)${DLLSUFFIX}${LIBSUFFIX} TEST_DLL_FILE = tcltest$(VER)${DLLSUFFIX} TEST_EXE_FILE = tcltest${EXESUFFIX} @@ -457,6 +459,8 @@ REG_OBJS = tclWinReg.$(OBJEXT) STUB_OBJS = \ tclStubLib.$(OBJEXT) \ + tclStubCall.$(OBJEXT) \ + tclStubLibTbl.$(OBJEXT) \ tclTomMathStubLib.$(OBJEXT) \ tclOOStubLib.$(OBJEXT) \ tclWinPanic.$(OBJEXT) @@ -515,7 +519,7 @@ tcltest: binaries $(TEST_EXE_FILE) $(TEST_DLL_FILE) $(CAT32) tcltest.cmd binaries: $(TCL_STUB_LIB_FILE) @LIBRARIES@ winextensions ${TCL_ZIP_FILE} $(TCLSH) -winextensions: ${DDE_DLL_FILE} ${REG_DLL_FILE} +winextensions: ${DDE_DLL_FILE} ${REG_DLL_FILE} ${DDE_DLL_FILE8} ${REG_DLL_FILE8} libraries: @@ -545,7 +549,7 @@ $(TCLSH): $(TCLSH_OBJS) @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES) ${TCL_ZIP_ tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE) $(COPY) tclsh.exe.manifest $(TCLSH).manifest @VC_MANIFEST_EMBED_EXE@ - if test "${ZIPFS_BUILD}" = "2" ; then \ + @if test "${ZIPFS_BUILD}" = "2" ; then \ cat ${TCL_ZIP_FILE} >> ${TCLSH}; \ ${NATIVE_ZIP} -A ${TCLSH} \ || echo 'ignore zip-error by adjust sfx process (not executable?)'; \ @@ -589,6 +593,14 @@ ${REG_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${REG_OBJS} @MAKE_DLL@ ${REG_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS) $(COPY) tclsh.exe.manifest ${REG_DLL_FILE}.manifest +${DDE_DLL_FILE8}: ${TCL_STUB_LIB_FILE} tcl8WinDde.$(OBJEXT) + @MAKE_DLL@ tcl8WinDde.$(OBJEXT) $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS) + $(COPY) tclsh.exe.manifest ${DDE_DLL_FILE8}.manifest + +${REG_DLL_FILE8}: ${TCL_STUB_LIB_FILE} tcl8WinReg.$(OBJEXT) + @MAKE_DLL@ -DTCL_MAJOR_VERSION=8 tcl8WinReg.$(OBJEXT) $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS) + $(COPY) tclsh.exe.manifest ${REG_DLL_FILE8}.manifest + ${TEST_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${TCLTEST_OBJS} @$(RM) ${TEST_DLL_FILE} ${TEST_LIB_FILE} @MAKE_DLL@ ${TCLTEST_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS) @@ -641,9 +653,15 @@ tclWinPipe.${OBJEXT}: tclWinPipe.c tclWinReg.${OBJEXT}: tclWinReg.c $(CC) -c $(CC_SWITCHES) $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME) +tcl8WinReg.${OBJEXT}: tclWinReg.c + $(CC) -o $@ -c $(CC_SWITCHES) -DTCL_MAJOR_VERSION=8 $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME) + tclWinDde.${OBJEXT}: tclWinDde.c $(CC) -c $(CC_SWITCHES) $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME) +tcl8WinDde.${OBJEXT}: tclWinDde.c + $(CC) -o $@ -c $(CC_SWITCHES) -DTCL_MAJOR_VERSION=8 $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME) + tclAppInit.${OBJEXT}: tclAppInit.c $(CC) -c $(CC_SWITCHES) $(EXTFLAGS) -DUNICODE -D_UNICODE @DEPARG@ $(CC_OBJNAME) @@ -701,6 +719,15 @@ tclUuid.h: $(TOP_DIR)/manifest.uuid tclStubLib.${OBJEXT}: tclStubLib.c $(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @CFLAGS_NOLTO@ @DEPARG@ $(CC_OBJNAME) +tclStubCall.${OBJEXT}: tclStubCall.c + $(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD \ + -DCFG_RUNTIME_DLLFILE="\"$(TCL_DLL_FILE)\"" \ + -DCFG_RUNTIME_BINDIR="\"$(bindir_native)\"" \ + @DEPARG@ $(CC_OBJNAME) + +tclStubLibTbl.${OBJEXT}: tclStubLibTbl.c + $(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME) + tclTomMathStubLib.${OBJEXT}: tclTomMathStubLib.c $(CC) -c $(CC_SWITCHES) @CFLAGS_NOLTO@ @DEPARG@ $(CC_OBJNAME) @@ -831,6 +858,10 @@ install-binaries: binaries $(COPY) $(ROOT_DIR)/library/dde/pkgIndex.tcl \ "$(LIB_INSTALL_DIR)/dde${DDEDOTVER}"; \ fi + @if [ -f $(DDE_DLL_FILE8) ]; then \ + echo Installing $(DDE_DLL_FILE8); \ + $(COPY) $(DDE_DLL_FILE8) "$(LIB_INSTALL_DIR)/dde${DDEDOTVER}"; \ + fi @if [ -f $(DDE_LIB_FILE) ]; then \ echo Installing $(DDE_LIB_FILE); \ $(COPY) $(DDE_LIB_FILE) "$(LIB_INSTALL_DIR)/dde${DDEDOTVER}"; \ @@ -841,6 +872,10 @@ install-binaries: binaries $(COPY) $(ROOT_DIR)/library/registry/pkgIndex.tcl \ "$(LIB_INSTALL_DIR)/registry${REGDOTVER}"; \ fi + @if [ -f $(REG_DLL_FILE8) ]; then \ + echo Installing $(REG_DLL_FILE8); \ + $(COPY) $(REG_DLL_FILE8) "$(LIB_INSTALL_DIR)/registry${REGDOTVER}"; \ + fi @if [ -f $(REG_LIB_FILE) ]; then \ echo Installing $(REG_LIB_FILE); \ $(COPY) $(REG_LIB_FILE) "$(LIB_INSTALL_DIR)/registry${REGDOTVER}"; \ @@ -864,7 +899,7 @@ install-libraries: libraries install-tzdata install-msgs else true; \ fi; \ done; - @for i in 8.4 8.4/platform 8.5 8.6 8.7; \ + @for i in 9.0 9.0/platform; \ do \ if [ ! -d "$(MODULE_INSTALL_DIR)/$$i" ] ; then \ echo "Making directory $(MODULE_INSTALL_DIR)/$$i"; \ @@ -882,19 +917,19 @@ install-libraries: libraries install-tzdata install-msgs $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/cookiejar0.2"; \ done; @echo "Installing package http 2.10b1 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/http/http.tcl "$(MODULE_INSTALL_DIR)/8.6/http-2.10b1.tm"; + @$(COPY) $(ROOT_DIR)/library/http/http.tcl "$(MODULE_INSTALL_DIR)/9.0/http-2.10b1.tm"; @echo "Installing package opt 0.4.7"; @for j in $(ROOT_DIR)/library/opt/*.tcl; do \ $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \ done; @echo "Installing package msgcat 1.7.1 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl "$(MODULE_INSTALL_DIR)/8.7/msgcat-1.7.1.tm"; + @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl "$(MODULE_INSTALL_DIR)/9.0/msgcat-1.7.1.tm"; @echo "Installing package tcltest 2.5.5 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl "$(MODULE_INSTALL_DIR)/8.5/tcltest-2.5.5.tm"; + @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl "$(MODULE_INSTALL_DIR)/9.0/tcltest-2.5.5.tm"; @echo "Installing package platform 1.0.19 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/platform/platform.tcl "$(MODULE_INSTALL_DIR)/8.4/platform-1.0.19.tm"; + @$(COPY) $(ROOT_DIR)/library/platform/platform.tcl "$(MODULE_INSTALL_DIR)/9.0/platform-1.0.19.tm"; @echo "Installing package platform::shell 1.1.4 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/platform/shell.tcl "$(MODULE_INSTALL_DIR)/8.4/platform/shell-1.1.4.tm"; + @$(COPY) $(ROOT_DIR)/library/platform/shell.tcl "$(MODULE_INSTALL_DIR)/9.0/platform/shell-1.1.4.tm"; @echo "Installing encodings"; @for i in $(ROOT_DIR)/library/encoding/*.enc ; do \ $(COPY) "$$i" "$(SCRIPT_INSTALL_DIR)/encoding"; \ @@ -1100,7 +1135,7 @@ genstubs: # # This target creates the HTML folder for Tcl & Tk and places it in # DISTDIR/html. It uses the tcltk-man2html.tcl tool from the Tcl group's tool -# workspace. It depends on the Tcl & Tk being in directories called tcl8.* & +# workspace. It depends on the Tcl & Tk being in directories called tcl9.* & # tk8.* up two directories from the TOOL_DIR. # @@ -1,4 +1,4 @@ -Tcl 8.7 for Windows +Tcl 9.0 for Windows 1. Introduction --------------- @@ -16,7 +16,7 @@ The information in this file is maintained on the web at: In order to compile Tcl for Windows, you need the following: - Tcl 8.7 Source Distribution (plus any patches) + Tcl 9.0 Source Distribution (plus any patches) and @@ -80,9 +80,9 @@ Use the Makefile "install" target to install Tcl. It will install it according to the prefix options you provided in the correct directory structure. -Note that in order to run tclsh87.exe, you must ensure that tcl87.dll, +Note that in order to run tclsh90.exe, you must ensure that tcl90.dll, libtommath.dll and zlib1.dll are on your path, in the system -directory, or in the directory containing tclsh87.exe. +directory, or in the directory containing tclsh90.exe. Note: Tcl no longer provides support for systems earlier than Windows 7. You will also need the Windows Universal C runtime (UCRT): diff --git a/win/configure b/win/configure index ba0007f..d47fc6cb 100755 --- a/win/configure +++ b/win/configure @@ -1,6 +1,6 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles. -# Generated by GNU Autoconf 2.71 for tcl 8.7. +# Generated by GNU Autoconf 2.71 for tcl 9.0. # # # Copyright (C) 1992-1996, 1998-2017, 2020-2021 Free Software Foundation, @@ -608,8 +608,8 @@ MAKEFLAGS= # Identity of this package. PACKAGE_NAME='tcl' PACKAGE_TARNAME='tcl' -PACKAGE_VERSION='8.7' -PACKAGE_STRING='tcl 8.7' +PACKAGE_VERSION='9.0' +PACKAGE_STRING='tcl 9.0' PACKAGE_BUGREPORT='' PACKAGE_URL='' @@ -809,7 +809,6 @@ ac_user_opts=' enable_option_checking with_encoding enable_shared -enable_time64bit enable_64bit enable_zipfs enable_symbols @@ -1372,7 +1371,7 @@ if test "$ac_init_help" = "long"; then # Omit some internal or obsolete options to make the list less imposing. # This message is too long to be a string in the A/UX 3.1 sh. cat <<_ACEOF -\`configure' configures tcl 8.7 to adapt to many kinds of systems. +\`configure' configures tcl 9.0 to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... @@ -1434,7 +1433,7 @@ fi if test -n "$ac_init_help"; then case $ac_init_help in - short | recursive ) echo "Configuration of tcl 8.7:";; + short | recursive ) echo "Configuration of tcl 9.0:";; esac cat <<\_ACEOF @@ -1443,7 +1442,6 @@ Optional Features: --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no) --enable-FEATURE[=ARG] include FEATURE [ARG=yes] --enable-shared build and link with shared libraries (default: on) - --enable-time64bit force 64-bit time_t for 32-bit build (default: off) --enable-64bit enable 64bit support (where applicable) --enable-zipfs build with Zipfs support (default: on) --enable-symbols build with debugging symbols (default: off) @@ -1532,7 +1530,7 @@ fi test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF -tcl configure 8.7 +tcl configure 9.0 generated by GNU Autoconf 2.71 Copyright (C) 2021 Free Software Foundation, Inc. @@ -1736,7 +1734,7 @@ cat >config.log <<_ACEOF This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. -It was created by tcl $as_me 8.7, which was +It was created by tcl $as_me 9.0, which was generated by GNU Autoconf 2.71. Invocation command line was $ $0$ac_configure_args_raw @@ -2401,10 +2399,10 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu # /bin/sh. The bash shell seems to suffer from some strange failures. SHELL=/bin/sh -TCL_VERSION=8.7 -TCL_MAJOR_VERSION=8 -TCL_MINOR_VERSION=7 -TCL_PATCH_LEVEL="a6" +TCL_VERSION=9.0 +TCL_MAJOR_VERSION=9 +TCL_MINOR_VERSION=0 +TCL_PATCH_LEVEL="a4" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION TCL_DDE_VERSION=1.4 @@ -3893,26 +3891,6 @@ printf "%s\n" "#define STATIC_BUILD 1" >>confdefs.h #-------------------------------------------------------------------- -# Check whether --enable-time64bit was given. -#-------------------------------------------------------------------- - -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking force of 64-bit time_t" >&5 -printf %s "checking force of 64-bit time_t... " >&6; } -# Check whether --enable-time64bit was given. -if test ${enable_time64bit+y} -then : - enableval=$enable_time64bit; tcl_ok=$enableval -else $as_nop - tcl_ok=no -fi - -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: \"$tcl_ok\"" >&5 -printf "%s\n" "\"$tcl_ok\"" >&6; } -if test "$tcl_ok" = "yes"; then - CFLAGS="${CFLAGS} -D_USE_64BIT_TIME_T" -fi - -#-------------------------------------------------------------------- # The statements below define a collection of compile flags. This # macro depends on the value of SHARED_BUILD, and should be called # after SC_ENABLE_SHARED checks the configure switches. @@ -5826,8 +5804,8 @@ eval "TCL_SRC_DIR=\"`cd $srcdir/..; $CYGPATH $(pwd)`\"" eval "TCL_DLL_FILE=tcl${VER}${DLLSUFFIX}" -eval "TCL_STUB_LIB_FILE=\"${LIBPREFIX}tclstub${VER}${LIBSUFFIX}\"" -eval "TCL_STUB_LIB_FLAG=\"-ltclstub${VER}${LIBFLAGSUFFIX}\"" +eval "TCL_STUB_LIB_FILE=\"${LIBPREFIX}tclstub${LIBSUFFIX}\"" +eval "TCL_STUB_LIB_FLAG=\"-ltclstub${LIBFLAGSUFFIX}\"" eval "TCL_BUILD_STUB_LIB_SPEC=\"-L`$CYGPATH $(pwd)` ${TCL_STUB_LIB_FLAG}\"" eval "TCL_STUB_LIB_SPEC=\"-L${libdir} ${TCL_STUB_LIB_FLAG}\"" eval "TCL_BUILD_STUB_LIB_PATH=\"`$CYGPATH $(pwd)`/${TCL_STUB_LIB_FILE}\"" @@ -6520,7 +6498,7 @@ cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log=" -This file was extended by tcl $as_me 8.7, which was +This file was extended by tcl $as_me 9.0, which was generated by GNU Autoconf 2.71. Invocation command line was CONFIG_FILES = $CONFIG_FILES @@ -6575,7 +6553,7 @@ ac_cs_config_escaped=`printf "%s\n" "$ac_cs_config" | sed "s/^ //; s/'/'\\\\\\\\ cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_cs_config='$ac_cs_config_escaped' ac_cs_version="\\ -tcl config.status 8.7 +tcl config.status 9.0 configured by $0, generated by GNU Autoconf 2.71, with options \\"\$ac_cs_config\\" diff --git a/win/configure.ac b/win/configure.ac index 01f70b4..c6ff202 100644 --- a/win/configure.ac +++ b/win/configure.ac @@ -3,7 +3,7 @@ # generate the file "configure", which is run during Tcl installation # to configure the system for the local environment. -AC_INIT([tcl],[8.7]) +AC_INIT([tcl],[9.0]) AC_CONFIG_SRCDIR([../generic/tcl.h]) AC_PREREQ([2.69]) @@ -12,10 +12,10 @@ AC_PREREQ([2.69]) # /bin/sh. The bash shell seems to suffer from some strange failures. SHELL=/bin/sh -TCL_VERSION=8.7 -TCL_MAJOR_VERSION=8 -TCL_MINOR_VERSION=7 -TCL_PATCH_LEVEL="a6" +TCL_VERSION=9.0 +TCL_MAJOR_VERSION=9 +TCL_MINOR_VERSION=0 +TCL_PATCH_LEVEL="a4" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION TCL_DDE_VERSION=1.4 @@ -92,20 +92,6 @@ SC_TCL_CFG_ENCODING SC_ENABLE_SHARED #-------------------------------------------------------------------- -# Check whether --enable-time64bit was given. -#-------------------------------------------------------------------- - -AC_MSG_CHECKING([force of 64-bit time_t]) -AC_ARG_ENABLE(time64bit, - AS_HELP_STRING([--enable-time64bit], - [force 64-bit time_t for 32-bit build (default: off)]), - [tcl_ok=$enableval], [tcl_ok=no]) -AC_MSG_RESULT("$tcl_ok") -if test "$tcl_ok" = "yes"; then - CFLAGS="${CFLAGS} -D_USE_64BIT_TIME_T" -fi - -#-------------------------------------------------------------------- # The statements below define a collection of compile flags. This # macro depends on the value of SHARED_BUILD, and should be called # after SC_ENABLE_SHARED checks the configure switches. @@ -327,8 +313,8 @@ eval "TCL_SRC_DIR=\"`cd $srcdir/..; $CYGPATH $(pwd)`\"" eval "TCL_DLL_FILE=tcl${VER}${DLLSUFFIX}" -eval "TCL_STUB_LIB_FILE=\"${LIBPREFIX}tclstub${VER}${LIBSUFFIX}\"" -eval "TCL_STUB_LIB_FLAG=\"-ltclstub${VER}${LIBFLAGSUFFIX}\"" +eval "TCL_STUB_LIB_FILE=\"${LIBPREFIX}tclstub${LIBSUFFIX}\"" +eval "TCL_STUB_LIB_FLAG=\"-ltclstub${LIBFLAGSUFFIX}\"" eval "TCL_BUILD_STUB_LIB_SPEC=\"-L`$CYGPATH $(pwd)` ${TCL_STUB_LIB_FLAG}\"" eval "TCL_STUB_LIB_SPEC=\"-L${libdir} ${TCL_STUB_LIB_FLAG}\"" eval "TCL_BUILD_STUB_LIB_PATH=\"`$CYGPATH $(pwd)`/${TCL_STUB_LIB_FILE}\"" diff --git a/win/makefile.vc b/win/makefile.vc index e583ae0..f4ae05d 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -52,7 +52,7 @@ # turn on the 64-bit compiler, if your SDK has it.
#
# Basic macros and options usable on the commandline (see rules.vc for more info):
-# OPTS=msvcrt,noembed,nothreads,pdbs,profile,static,symbols,thrdalloc,time64bit,unchecked,utf16,none
+# OPTS=nomsvcrt,noembed,nothreads,pdbs,profile,static,symbols,thrdalloc,unchecked,utf16,none
# Sets special options for the core. The default is for none.
# Any combination of the above may be used (comma separated).
# 'none' will over-ride everything to nothing.
@@ -75,8 +75,6 @@ # have the dde and registry extensions linked inside.
# symbols = Adds symbols for step debugging.
# thrdalloc = Use the thread allocator (shared global free pool).
-# time64bit = Forces a build using 64-bit time_t for 32-bit build
-# (CRT library should support this).
# unchecked = Allows a symbols build to not use the debug
# enabled runtime (msvcrt.dll not msvcrtd.dll
# or libcmt.lib not libcmtd.lib).
@@ -209,10 +207,10 @@ DDEVERSION = $(DDEDOTVERSION:.=) REGDOTVERSION = 1.3
REGVERSION = $(REGDOTVERSION:.=)
-TCLREGLIBNAME = $(PROJECT)registry$(REGVERSION)$(SUFX:t=).$(EXT)
+TCLREGLIBNAME = $(PROJECT)9registry$(REGVERSION)$(SUFX:t=).$(EXT)
TCLREGLIB = $(OUT_DIR)\$(TCLREGLIBNAME)
-TCLDDELIBNAME = $(PROJECT)dde$(DDEVERSION)$(SUFX:t=).$(EXT)
+TCLDDELIBNAME = $(PROJECT)9dde$(DDEVERSION)$(SUFX:t=).$(EXT)
TCLDDELIB = $(OUT_DIR)\$(TCLDDELIBNAME)
TCLTEST = $(OUT_DIR)\$(PROJECT)test.exe
@@ -442,6 +440,8 @@ TCLOBJS = $(COREOBJS) $(ZLIBOBJS) $(TOMMATHOBJS) $(PLATFORMOBJS) TCLSTUBOBJS = \
$(TMP_DIR)\tclStubLib.obj \
+ $(TMP_DIR)\tclStubCall.obj \
+ $(TMP_DIR)\tclStubLibTbl.obj \
$(TMP_DIR)\tclTomMathStubLib.obj \
$(TMP_DIR)\tclOOStubLib.obj \
$(TMP_DIR)\tclWinPanic.obj
@@ -875,11 +875,11 @@ $(TMP_DIR)\tclAppInit.obj: $(WIN_DIR)\tclAppInit.c ### The following objects should be built using the stub interfaces
$(TMP_DIR)\tclWinReg.obj: $(WIN_DIR)\tclWinReg.c
- $(cc32) $(appcflags) /DUSE_TCL_STUBS -Fo$@ $?
+ $(cc32) $(appcflags_nostubs) /DUSE_TCL_STUBS=1 -Fo$@ $?
$(TMP_DIR)\tclWinDde.obj: $(WIN_DIR)\tclWinDde.c
- $(cc32) $(appcflags) /DUSE_TCL_STUBS -Fo$@ $?
+ $(cc32) $(appcflags_nostubs) /DUSE_TCL_STUBS=1 -Fo$@ $?
### The following objects are part of the stub library and should not
@@ -889,6 +889,15 @@ $(TMP_DIR)\tclWinDde.obj: $(WIN_DIR)\tclWinDde.c $(TMP_DIR)\tclStubLib.obj: $(GENERICDIR)\tclStubLib.c
$(cc32) $(stubscflags) -Fo$@ $?
+$(TMP_DIR)\tclStubCall.obj: $(GENERICDIR)\tclStubCall.c
+ $(cc32) $(stubscflags) \
+ /DCFG_RUNTIME_DLLFILE="\"$(TCLLIBNAME)\"" \
+ /DCFG_RUNTIME_BINDIR="\"$(BIN_INSTALL_DIR:\=\\)\"" \
+ $(TCL_INCLUDES) -Fo$@ $?
+
+$(TMP_DIR)\tclStubLibTbl.obj: $(GENERICDIR)\tclStubLibTbl.c
+ $(cc32) $(stubscflags) $(TCL_INCLUDES) -Fo$@ $?
+
$(TMP_DIR)\tclTomMathStubLib.obj: $(GENERICDIR)\tclTomMathStubLib.c
$(cc32) $(stubscflags) -Fo$@ $?
@@ -1029,30 +1038,24 @@ install-libraries: tclConfig tcl-nmake install-msgs install-tzdata @if not exist "$(MODULE_INSTALL_DIR)" \
$(MKDIR) "$(MODULE_INSTALL_DIR)"
@echo Installing package http $(PKG_HTTP_VER) as a Tcl Module
- @if not exist "$(MODULE_INSTALL_DIR)\8.6" \
- $(MKDIR) "$(MODULE_INSTALL_DIR)\8.6"
+ @if not exist "$(MODULE_INSTALL_DIR)\9.0" \
+ $(MKDIR) "$(MODULE_INSTALL_DIR)\9.0"
@$(COPY) "$(ROOT)\library\http\http.tcl" \
- "$(MODULE_INSTALL_DIR)\8.6\http-$(PKG_HTTP_VER).tm"
+ "$(MODULE_INSTALL_DIR)\9.0\http-$(PKG_HTTP_VER).tm"
@echo Installing package msgcat $(PKG_MSGCAT_VER) as a Tcl Module
- @if not exist "$(MODULE_INSTALL_DIR)\8.7" \
- $(MKDIR) "$(MODULE_INSTALL_DIR)\8.7"
@$(COPY) "$(ROOT)\library\msgcat\msgcat.tcl" \
- "$(MODULE_INSTALL_DIR)\8.7\msgcat-$(PKG_MSGCAT_VER).tm"
+ "$(MODULE_INSTALL_DIR)\9.0\msgcat-$(PKG_MSGCAT_VER).tm"
@echo Installing package tcltest $(PKG_TCLTEST_VER) as a Tcl Module
- @if not exist "$(MODULE_INSTALL_DIR)\8.5" \
- $(MKDIR) "$(MODULE_INSTALL_DIR)\8.5"
@$(COPY) "$(ROOT)\library\tcltest\tcltest.tcl" \
- "$(MODULE_INSTALL_DIR)\8.5\tcltest-$(PKG_TCLTEST_VER).tm"
+ "$(MODULE_INSTALL_DIR)\9.0\tcltest-$(PKG_TCLTEST_VER).tm"
@echo Installing package platform $(PKG_PLATFORM_VER) as a Tcl Module
- @if not exist "$(MODULE_INSTALL_DIR)\8.4" \
- $(MKDIR) "$(MODULE_INSTALL_DIR)\8.4"
- @if not exist "$(MODULE_INSTALL_DIR)\8.4\platform" \
- $(MKDIR) "$(MODULE_INSTALL_DIR)\8.4\platform"
+ @if not exist "$(MODULE_INSTALL_DIR)\9.0\platform" \
+ $(MKDIR) "$(MODULE_INSTALL_DIR)\9.0\platform"
@$(COPY) "$(ROOT)\library\platform\platform.tcl" \
- "$(MODULE_INSTALL_DIR)\8.4\platform-$(PKG_PLATFORM_VER).tm"
+ "$(MODULE_INSTALL_DIR)\9.0\platform-$(PKG_PLATFORM_VER).tm"
@echo Installing package platform::shell $(PKG_SHELL_VER) as a Tcl Module
@$(COPY) "$(ROOT)\library\platform\shell.tcl" \
- "$(MODULE_INSTALL_DIR)\8.4\platform\shell-$(PKG_SHELL_VER).tm"
+ "$(MODULE_INSTALL_DIR)\9.0\platform\shell-$(PKG_SHELL_VER).tm"
!endif
@echo Installing $(TCLDDELIBNAME)
!if !$(STATIC_BUILD)
diff --git a/win/tcl.dsp b/win/tcl.dsp index aff1000..db2b896 100644 --- a/win/tcl.dsp +++ b/win/tcl.dsp @@ -36,7 +36,7 @@ CFG=tcl - Win32 Debug Static # PROP BASE Intermediate_Dir "Release\tcl_Dynamic"
# PROP BASE Cmd_Line "nmake -nologo -f makefile.vc MSVCDIR=IDE"
# PROP BASE Rebuild_Opt "-a"
-# PROP BASE Target_File "Release\tclsh87.exe"
+# PROP BASE Target_File "Release\tclsh90.exe"
# PROP BASE Bsc_Name ""
# PROP BASE Target_Dir ""
# PROP Use_MFC 0
@@ -45,7 +45,7 @@ CFG=tcl - Win32 Debug Static # PROP Intermediate_Dir "Release\tcl_Dynamic"
# PROP Cmd_Line "nmake -nologo -f makefile.vc MSVCDIR=IDE"
# PROP Rebuild_Opt "clean release"
-# PROP Target_File "Release\tclsh87t.exe"
+# PROP Target_File "Release\tclsh90t.exe"
# PROP Bsc_Name ""
# PROP Target_Dir ""
@@ -57,7 +57,7 @@ CFG=tcl - Win32 Debug Static # PROP BASE Intermediate_Dir "Debug\tcl_Dynamic"
# PROP BASE Cmd_Line "nmake -nologo -f makefile.vc OPTS=symbols MSVCDIR=IDE"
# PROP BASE Rebuild_Opt "-a"
-# PROP BASE Target_File "Debug\tclsh87g.exe"
+# PROP BASE Target_File "Debug\tclsh90g.exe"
# PROP BASE Bsc_Name ""
# PROP BASE Target_Dir ""
# PROP Use_MFC 0
@@ -66,7 +66,7 @@ CFG=tcl - Win32 Debug Static # PROP Intermediate_Dir "Debug\tcl_Dynamic"
# PROP Cmd_Line "nmake -nologo -f makefile.vc OPTS=threads,symbols MSVCDIR=IDE"
# PROP Rebuild_Opt "clean release"
-# PROP Target_File "Debug\tclsh87tg.exe"
+# PROP Target_File "Debug\tclsh90tg.exe"
# PROP Bsc_Name ""
# PROP Target_Dir ""
@@ -78,7 +78,7 @@ CFG=tcl - Win32 Debug Static # PROP BASE Intermediate_Dir "Debug\tcl_Static"
# PROP BASE Cmd_Line "nmake -nologo -f makefile.vc OPTS=symbols,static MSVCDIR=IDE"
# PROP BASE Rebuild_Opt "-a"
-# PROP BASE Target_File "Debug\tclsh87sg.exe"
+# PROP BASE Target_File "Debug\tclsh90sg.exe"
# PROP BASE Bsc_Name ""
# PROP BASE Target_Dir ""
# PROP Use_MFC 0
@@ -87,7 +87,7 @@ CFG=tcl - Win32 Debug Static # PROP Intermediate_Dir "Debug\tcl_Static"
# PROP Cmd_Line "nmake -nologo -f makefile.vc OPTS=symbols,static MSVCDIR=IDE"
# PROP Rebuild_Opt "-a"
-# PROP Target_File "Debug\tclsh87sg.exe"
+# PROP Target_File "Debug\tclsh90sg.exe"
# PROP Bsc_Name ""
# PROP Target_Dir ""
@@ -99,7 +99,7 @@ CFG=tcl - Win32 Debug Static # PROP BASE Intermediate_Dir "Release\tcl_Static"
# PROP BASE Cmd_Line "nmake -nologo -f makefile.vc OPTS=static MSVCDIR=IDE"
# PROP BASE Rebuild_Opt "-a"
-# PROP BASE Target_File "Release\tclsh87s.exe"
+# PROP BASE Target_File "Release\tclsh90s.exe"
# PROP BASE Bsc_Name ""
# PROP BASE Target_Dir ""
# PROP Use_MFC 0
@@ -108,7 +108,7 @@ CFG=tcl - Win32 Debug Static # PROP Intermediate_Dir "Release\tcl_Static"
# PROP Cmd_Line "nmake -nologo -f makefile.vc OPTS=static MSVCDIR=IDE"
# PROP Rebuild_Opt "-a"
-# PROP Target_File "Release\tclsh87s.exe"
+# PROP Target_File "Release\tclsh90s.exe"
# PROP Bsc_Name ""
# PROP Target_Dir ""
@@ -1288,6 +1288,14 @@ SOURCE=..\generic\tclStubLib.c # End Source File
# Begin Source File
+SOURCE=..\generic\tclStubCall.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclStubLibTbl.c
+# End Source File
+# Begin Source File
+
SOURCE=..\generic\tclOOStubLib.c
# End Source File
# Begin Source File
@@ -1009,13 +1009,13 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ #------------------------------------------------------------------------ AC_DEFUN([SC_WITH_TCL], [ - if test -d ../../tcl8.7$1/win; then - TCL_BIN_DEFAULT=../../tcl8.7$1/win + if test -d ../../tcl9.0$1/win; then + TCL_BIN_DEFAULT=../../tcl9.0$1/win else - TCL_BIN_DEFAULT=../../tcl8.7/win + TCL_BIN_DEFAULT=../../tcl9.0/win fi - AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 8.7 binaries from DIR], + AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 9.0 binaries from DIR], TCL_BIN_DIR=$withval, TCL_BIN_DIR=`cd $TCL_BIN_DEFAULT; pwd`) if test ! -d $TCL_BIN_DIR; then AC_MSG_ERROR(Tcl directory $TCL_BIN_DIR does not exist) diff --git a/win/tclAppInit.c b/win/tclAppInit.c index 27eb164..30127fd 100644 --- a/win/tclAppInit.c +++ b/win/tclAppInit.c @@ -277,11 +277,10 @@ setargv( } } - /* Make sure we don't call ckalloc through the (not yet initialized) stub table */ + /* Make sure we don't call Tcl_Alloc through the (not yet initialized) stub table */ # undef Tcl_Alloc -# undef Tcl_DbCkalloc - argSpace = (TCHAR *)ckalloc(size * sizeof(char *) + argSpace = (TCHAR *)Tcl_Alloc(size * sizeof(char *) + (_tcslen(cmdLine) * sizeof(TCHAR)) + sizeof(TCHAR)); argv = (TCHAR **) argSpace; argSpace += size * (sizeof(char *)/sizeof(TCHAR)); diff --git a/win/tclConfig.sh.in b/win/tclConfig.sh.in index 776dcb0..4883f2c 100644 --- a/win/tclConfig.sh.in +++ b/win/tclConfig.sh.in @@ -23,11 +23,6 @@ TCL_CC='@CC@' # -D flags for use with the C compiler. TCL_DEFS='@DEFS@' -# TCL_DBGX used to be used to distinguish debug vs. non-debug builds. -# This was a righteous pain so the core doesn't do that any more. -# DEPRECATED, will be removed in Tcl 9! -TCL_DBGX='' - # Default flags used in an optimized and debuggable build, respectively. TCL_CFLAGS_DEBUG='@CFLAGS_DEBUG@' TCL_CFLAGS_OPTIMIZE='@CFLAGS_OPTIMIZE@' diff --git a/win/tclWin32Dll.c b/win/tclWin32Dll.c index 0e86611..2836e4f 100644 --- a/win/tclWin32Dll.c +++ b/win/tclWin32Dll.c @@ -144,7 +144,7 @@ DllMain( *---------------------------------------------------------------------- */ -HINSTANCE +void * TclWinGetTclInstance(void) { return hInstance; @@ -247,8 +247,8 @@ TclWinEncodingsCleanup(void) dlIter = driveLetterLookup; while (dlIter != NULL) { dlIter2 = dlIter->nextPtr; - ckfree(dlIter->volumeName); - ckfree(dlIter); + Tcl_Free(dlIter->volumeName); + Tcl_Free(dlIter); dlIter = dlIter2; } Tcl_MutexUnlock(&mountPointMap); @@ -341,8 +341,8 @@ TclWinDriveLetterForVolMountPoint( * Now dlPtr2 points to the structure to free. */ - ckfree(dlPtr2->volumeName); - ckfree(dlPtr2); + Tcl_Free(dlPtr2->volumeName); + Tcl_Free(dlPtr2); /* * Restart the loop - we could try to be clever and continue half @@ -377,7 +377,7 @@ TclWinDriveLetterForVolMountPoint( } } if (!alreadyStored) { - dlPtr2 = (MountPointMap *)ckalloc(sizeof(MountPointMap)); + dlPtr2 = (MountPointMap *)Tcl_Alloc(sizeof(MountPointMap)); dlPtr2->volumeName = (WCHAR *)TclNativeDupInternalRep(Target); dlPtr2->driveLetter = (char) drive[0]; dlPtr2->nextPtr = driveLetterLookup; @@ -403,7 +403,7 @@ TclWinDriveLetterForVolMountPoint( * that fact and store '-1' so we don't have to look it up each time. */ - dlPtr2 = (MountPointMap *)ckalloc(sizeof(MountPointMap)); + dlPtr2 = (MountPointMap *)Tcl_Alloc(sizeof(MountPointMap)); dlPtr2->volumeName = (WCHAR *)TclNativeDupInternalRep((void *)mountPoint); dlPtr2->driveLetter = -1; dlPtr2->nextPtr = driveLetterLookup; @@ -413,76 +413,6 @@ TclWinDriveLetterForVolMountPoint( } /* - *--------------------------------------------------------------------------- - * - * Tcl_WinUtfToTChar, Tcl_WinTCharToUtf -- - * - * Convert between UTF-8 and Unicode when running Windows. - * - * On Mac and Unix, all strings exchanged between Tcl and the OS are - * "char" oriented. We need only one Tcl_Encoding to convert between - * UTF-8 and the system's native encoding. We use NULL to represent - * that encoding. - * - * On Windows, some strings exchanged between Tcl and the OS are "char" - * oriented, while others are in Unicode. We need two Tcl_Encoding APIs - * depending on whether we are targeting a "char" or Unicode interface. - * - * Calling Tcl_UtfToExternal() or Tcl_ExternalToUtf() with an encoding - * of NULL should always used to convert between UTF-8 and the system's - * "char" oriented encoding. The following two functions are used in - * Windows-specific code to convert between UTF-8 and Unicode strings. - * This saves you the trouble of writing the - * following type of fragment over and over: - * - * encoding <- Tcl_GetEncoding("unicode"); - * nativeBuffer <- UtfToExternal(encoding, utfBuffer); - * Tcl_FreeEncoding(encoding); - * - * By convention, in Windows a WCHAR is a Unicode character. If you plan - * on targeting a Unicode interface when running on Windows, these - * functions should be used. If you plan on targetting a "char" oriented - * function on Windows, use Tcl_UtfToExternal() with an encoding of NULL. - * - * Results: - * The result is a pointer to the string in the desired target encoding. - * Storage for the result string is allocated in dsPtr; the caller must - * call Tcl_DStringFree() when the result is no longer needed. - * - * Side effects: - * None. - * - *--------------------------------------------------------------------------- - */ - -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 -#undef Tcl_WinUtfToTChar -TCHAR * -Tcl_WinUtfToTChar( - const char *string, /* Source string in UTF-8. */ - int len, /* Source string length in bytes, or -1 for - * strlen(). */ - Tcl_DString *dsPtr) /* Uninitialized or free DString in which the - * converted string is stored. */ -{ - Tcl_DStringInit(dsPtr); - return (TCHAR *)Tcl_UtfToWCharDString(string, len, dsPtr); -} -#undef Tcl_WinTCharToUtf -char * -Tcl_WinTCharToUtf( - const TCHAR *string, /* Source string in Unicode. */ - int len, /* Source string length in bytes, or -1 for - * platform-specific string length. */ - Tcl_DString *dsPtr) /* Uninitialized or free DString in which the - * converted string is stored. */ -{ - Tcl_DStringInit(dsPtr); - return Tcl_WCharToUtfDString((WCHAR *)string, len >> 1, dsPtr); -} -#endif /* !defined(TCL_NO_DEPRECATED) */ - -/* *------------------------------------------------------------------------ * * TclWinCPUID -- diff --git a/win/tclWinChan.c b/win/tclWinChan.c index 166636c..4968802 100644 --- a/win/tclWinChan.c +++ b/win/tclWinChan.c @@ -72,30 +72,26 @@ typedef struct { * Static routines for this file: */ -static int FileBlockProc(ClientData instanceData, int mode); -static void FileChannelExitHandler(ClientData clientData); -static void FileCheckProc(ClientData clientData, int flags); -static int FileCloseProc(ClientData instanceData, +static int FileBlockProc(void *instanceData, int mode); +static void FileChannelExitHandler(void *clientData); +static void FileCheckProc(void *clientData, int flags); +static int FileCloseProc(void *instanceData, Tcl_Interp *interp, int flags); static int FileEventProc(Tcl_Event *evPtr, int flags); -static int FileGetHandleProc(ClientData instanceData, - int direction, ClientData *handlePtr); +static int FileGetHandleProc(void *instanceData, + int direction, void **handlePtr); static ThreadSpecificData *FileInit(void); -static int FileInputProc(ClientData instanceData, char *buf, +static int FileInputProc(void *instanceData, char *buf, int toRead, int *errorCode); -static int FileOutputProc(ClientData instanceData, +static int FileOutputProc(void *instanceData, const char *buf, int toWrite, int *errorCode); -#ifndef TCL_NO_DEPRECATED -static int FileSeekProc(ClientData instanceData, long offset, - int mode, int *errorCode); -#endif -static long long FileWideSeekProc(ClientData instanceData, +static long long FileWideSeekProc(void *instanceData, long long offset, int mode, int *errorCode); -static void FileSetupProc(ClientData clientData, int flags); -static void FileWatchProc(ClientData instanceData, int mask); -static void FileThreadActionProc(ClientData instanceData, +static void FileSetupProc(void *clientData, int flags); +static void FileWatchProc(void *instanceData, int mask); +static void FileThreadActionProc(void *instanceData, int action); -static int FileTruncateProc(ClientData instanceData, +static int FileTruncateProc(void *instanceData, long long length); static DWORD FileGetType(HANDLE handle); static int NativeIsComPort(const WCHAR *nativeName); @@ -107,14 +103,10 @@ static int NativeIsComPort(const WCHAR *nativeName); static const Tcl_ChannelType fileChannelType = { "file", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ - TCL_CLOSE2PROC, /* Close proc. */ + NULL, /* Close proc. */ FileInputProc, /* Input proc. */ FileOutputProc, /* Output proc. */ -#ifndef TCL_NO_DEPRECATED - FileSeekProc, /* Seek proc. */ -#else NULL, -#endif NULL, /* Set option proc. */ NULL, /* Get option proc. */ FileWatchProc, /* Set up the notifier to watch the channel. */ @@ -186,7 +178,7 @@ FileInit(void) static void FileChannelExitHandler( - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { Tcl_DeleteEventSource(FileSetupProc, FileCheckProc, NULL); } @@ -210,7 +202,7 @@ FileChannelExitHandler( void FileSetupProc( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { FileInfo *infoPtr; @@ -253,7 +245,7 @@ FileSetupProc( static void FileCheckProc( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { FileEvent *evPtr; @@ -273,7 +265,7 @@ FileCheckProc( infoPtr = infoPtr->nextPtr) { if (infoPtr->watchMask && !TEST_FLAG(infoPtr->flags, FILE_PENDING)) { SET_FLAG(infoPtr->flags, FILE_PENDING); - evPtr = (FileEvent *)ckalloc(sizeof(FileEvent)); + evPtr = (FileEvent *)Tcl_Alloc(sizeof(FileEvent)); evPtr->header.proc = FileEventProc; evPtr->infoPtr = infoPtr; Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL); @@ -352,7 +344,7 @@ FileEventProc( static int FileBlockProc( - ClientData instanceData, /* Instance data for channel. */ + void *instanceData, /* Instance data for channel. */ int mode) /* TCL_MODE_BLOCKING or * TCL_MODE_NONBLOCKING. */ { @@ -391,7 +383,7 @@ FileBlockProc( static int FileCloseProc( - ClientData instanceData, /* Pointer to FileInfo structure. */ + void *instanceData, /* Pointer to FileInfo structure. */ TCL_UNUSED(Tcl_Interp *), int flags) { @@ -445,92 +437,13 @@ FileCloseProc( break; } } - ckfree(fileInfoPtr); + Tcl_Free(fileInfoPtr); return errorCode; } /* *---------------------------------------------------------------------- * - * FileSeekProc -- - * - * Seeks on a file-based channel. Returns the new position. - * - * Results: - * -1 if failed, the new position if successful. If failed, it also sets - * *errorCodePtr to the error code. - * - * Side effects: - * Moves the location at which the channel will be accessed in future - * operations. - * - *---------------------------------------------------------------------- - */ -#ifndef TCL_NO_DEPRECATED -static int -FileSeekProc( - ClientData instanceData, /* File state. */ - long offset, /* Offset to seek to. */ - int mode, /* Relative to where should we seek? */ - int *errorCodePtr) /* To store error code. */ -{ - FileInfo *infoPtr = (FileInfo *)instanceData; - LONG newPos, newPosHigh, oldPos, oldPosHigh; - DWORD moveMethod; - - *errorCodePtr = 0; - if (mode == SEEK_SET) { - moveMethod = FILE_BEGIN; - } else if (mode == SEEK_CUR) { - moveMethod = FILE_CURRENT; - } else { - moveMethod = FILE_END; - } - - /* - * Save our current place in case we need to roll-back the seek. - */ - - oldPosHigh = 0; - oldPos = SetFilePointer(infoPtr->handle, 0, &oldPosHigh, FILE_CURRENT); - if (oldPos == (LONG) INVALID_SET_FILE_POINTER) { - DWORD winError = GetLastError(); - - if (winError != NO_ERROR) { - Tcl_WinConvertError(winError); - *errorCodePtr = errno; - return -1; - } - } - - newPosHigh = (offset < 0 ? -1 : 0); - newPos = SetFilePointer(infoPtr->handle, offset, &newPosHigh, moveMethod); - if (newPos == (LONG) INVALID_SET_FILE_POINTER) { - DWORD winError = GetLastError(); - - if (winError != NO_ERROR) { - Tcl_WinConvertError(winError); - *errorCodePtr = errno; - return -1; - } - } - - /* - * Check for expressability in our return type, and roll-back otherwise. - */ - - if (newPosHigh != 0) { - *errorCodePtr = EOVERFLOW; - SetFilePointer(infoPtr->handle, oldPos, &oldPosHigh, FILE_BEGIN); - return -1; - } - return (int) newPos; -} -#endif - -/* - *---------------------------------------------------------------------- - * * FileWideSeekProc -- * * Seeks on a file-based channel. Returns the new position. @@ -548,7 +461,7 @@ FileSeekProc( static long long FileWideSeekProc( - ClientData instanceData, /* File state. */ + void *instanceData, /* File state. */ long long offset, /* Offset to seek to. */ int mode, /* Relative to where should we seek? */ int *errorCodePtr) /* To store error code. */ @@ -600,7 +513,7 @@ FileWideSeekProc( static int FileTruncateProc( - ClientData instanceData, /* File state. */ + void *instanceData, /* File state. */ long long length) /* Length to truncate at. */ { FileInfo *infoPtr = (FileInfo *)instanceData; @@ -676,7 +589,7 @@ FileTruncateProc( static int FileInputProc( - ClientData instanceData, /* File state. */ + void *instanceData, /* File state. */ char *buf, /* Where to store data read. */ int bufSize, /* Num bytes available in buffer. */ int *errorCode) /* Where to store error code. */ @@ -731,7 +644,7 @@ FileInputProc( static int FileOutputProc( - ClientData instanceData, /* File state. */ + void *instanceData, /* File state. */ const char *buf, /* The data buffer. */ int toWrite, /* How many bytes to write? */ int *errorCode) /* Where to store error code. */ @@ -778,7 +691,7 @@ FileOutputProc( static void FileWatchProc( - ClientData instanceData, /* File state. */ + void *instanceData, /* File state. */ int mask) /* What events to watch for; OR-ed combination * of TCL_READABLE, TCL_WRITABLE and * TCL_EXCEPTION. */ @@ -817,9 +730,9 @@ FileWatchProc( static int FileGetHandleProc( - ClientData instanceData, /* The file state. */ + void *instanceData, /* The file state. */ int direction, /* TCL_READABLE or TCL_WRITABLE */ - ClientData *handlePtr) /* Where to store the handle. */ + void **handlePtr) /* Where to store the handle. */ { FileInfo *infoPtr = (FileInfo *)instanceData; @@ -827,7 +740,7 @@ FileGetHandleProc( return TCL_ERROR; } - *handlePtr = (ClientData) infoPtr->handle; + *handlePtr = (void *) infoPtr->handle; return TCL_OK; } @@ -1076,7 +989,7 @@ TclpOpenFileChannel( Tcl_Channel Tcl_MakeFileChannel( - ClientData rawHandle, /* OS level handle */ + void *rawHandle, /* OS level handle */ int mode) /* ORed combination of TCL_READABLE and * TCL_WRITABLE to indicate file mode. */ { @@ -1325,9 +1238,8 @@ TclpGetDefaultStdChannel( */ if (Tcl_SetChannelOption(NULL,channel,"-translation","auto")!=TCL_OK || - Tcl_SetChannelOption(NULL,channel,"-eofchar","\x1A {}")!=TCL_OK || Tcl_SetChannelOption(NULL,channel,"-buffering",bufMode)!=TCL_OK) { - Tcl_Close(NULL, channel); + Tcl_CloseEx(NULL, channel, 0); return (Tcl_Channel) NULL; } return channel; @@ -1377,7 +1289,7 @@ TclWinOpenFileChannel( } } - infoPtr = (FileInfo *)ckalloc(sizeof(FileInfo)); + infoPtr = (FileInfo *)Tcl_Alloc(sizeof(FileInfo)); /* * TIP #218. Removed the code inserting the new structure into the global @@ -1402,7 +1314,6 @@ TclWinOpenFileChannel( */ Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto"); - Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\x1A {}"); return infoPtr->channel; } @@ -1464,7 +1375,7 @@ TclWinFlushDirtyChannels(void) static void FileThreadActionProc( - ClientData instanceData, + void *instanceData, int action) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); diff --git a/win/tclWinConsole.c b/win/tclWinConsole.c index 6688ab1..9f6cadf 100644 --- a/win/tclWinConsole.c +++ b/win/tclWinConsole.c @@ -210,29 +210,29 @@ typedef struct { * Declarations for functions used only in this file. */ -static int ConsoleBlockModeProc(ClientData instanceData, int mode); -static void ConsoleCheckProc(ClientData clientData, int flags); -static int ConsoleCloseProc(ClientData instanceData, +static int ConsoleBlockModeProc(void *instanceData, int mode); +static void ConsoleCheckProc(void *clientData, int flags); +static int ConsoleCloseProc(void *instanceData, Tcl_Interp *interp, int flags); static int ConsoleEventProc(Tcl_Event *evPtr, int flags); -static void ConsoleExitHandler(ClientData clientData); -static int ConsoleGetHandleProc(ClientData instanceData, - int direction, ClientData *handlePtr); -static int ConsoleGetOptionProc(ClientData instanceData, +static void ConsoleExitHandler(void *clientData); +static int ConsoleGetHandleProc(void *instanceData, + int direction, void **handlePtr); +static int ConsoleGetOptionProc(void *instanceData, Tcl_Interp *interp, const char *optionName, Tcl_DString *dsPtr); static void ConsoleInit(void); -static int ConsoleInputProc(ClientData instanceData, char *buf, +static int ConsoleInputProc(void *instanceData, char *buf, int toRead, int *errorCode); -static int ConsoleOutputProc(ClientData instanceData, +static int ConsoleOutputProc(void *instanceData, const char *buf, int toWrite, int *errorCode); -static int ConsoleSetOptionProc(ClientData instanceData, +static int ConsoleSetOptionProc(void *instanceData, Tcl_Interp *interp, const char *optionName, const char *value); -static void ConsoleSetupProc(ClientData clientData, int flags); -static void ConsoleWatchProc(ClientData instanceData, int mask); -static void ProcExitHandler(ClientData clientData); -static void ConsoleThreadActionProc(ClientData instanceData, int action); +static void ConsoleSetupProc(void *clientData, int flags); +static void ConsoleWatchProc(void *instanceData, int mask); +static void ProcExitHandler(void *clientData); +static void ConsoleThreadActionProc(void *instanceData, int action); static DWORD ReadConsoleChars(HANDLE hConsole, WCHAR *lpBuffer, RingSizeT nChars, RingSizeT *nCharsReadPtr); static DWORD WriteConsoleChars(HANDLE hConsole, @@ -298,7 +298,7 @@ static ConsoleChannelInfo *gWatchingChannelList; static const Tcl_ChannelType consoleChannelType = { "console", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ - TCL_CLOSE2PROC, /* Close proc. */ + NULL, /* Close proc. */ ConsoleInputProc, /* Input proc. */ ConsoleOutputProc, /* Output proc. */ NULL, /* Seek proc. */ @@ -336,7 +336,7 @@ RingBufferInit(RingBuffer *ringPtr, RingSizeT capacity) if (capacity <= 0 || capacity > RingSizeT_MAX) { Tcl_Panic("Internal error: invalid ring buffer capacity requested."); } - ringPtr->bufPtr = (char *)ckalloc(capacity); + ringPtr->bufPtr = (char *)Tcl_Alloc(capacity); ringPtr->capacity = capacity; ringPtr->start = 0; ringPtr->length = 0; @@ -361,7 +361,7 @@ static void RingBufferClear(RingBuffer *ringPtr) { if (ringPtr->bufPtr) { - ckfree(ringPtr->bufPtr); + Tcl_Free(ringPtr->bufPtr); ringPtr->bufPtr = NULL; } ringPtr->capacity = 0; @@ -670,7 +670,7 @@ ConsoleInit(void) static void ConsoleExitHandler( - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { Tcl_DeleteEventSource(ConsoleSetupProc, ConsoleCheckProc, NULL); } @@ -694,7 +694,7 @@ ConsoleExitHandler( static void ProcExitHandler( - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { AcquireSRWLockExclusive(&gConsoleLock); gInitialized = 0; @@ -759,7 +759,7 @@ void NudgeWatchers (HANDLE consoleHandle) void ConsoleSetupProc( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { ConsoleChannelInfo *chanInfoPtr; @@ -824,7 +824,7 @@ ConsoleSetupProc( static void ConsoleCheckProc( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { ConsoleChannelInfo *chanInfoPtr; @@ -891,7 +891,7 @@ ConsoleCheckProc( ReleaseSRWLockShared(&handleInfoPtr->lock); if (needEvent) { - ConsoleEvent *evPtr = (ConsoleEvent *)ckalloc(sizeof(ConsoleEvent)); + ConsoleEvent *evPtr = (ConsoleEvent *)Tcl_Alloc(sizeof(ConsoleEvent)); /* See note above loop why this can be accessed without locks */ chanInfoPtr->flags |= CONSOLE_EVENT_QUEUED; @@ -924,7 +924,7 @@ ConsoleCheckProc( static int ConsoleBlockModeProc( - ClientData instanceData, /* Instance data for channel. */ + void *instanceData, /* Instance data for channel. */ int mode) /* TCL_MODE_BLOCKING or * TCL_MODE_NONBLOCKING. */ { @@ -964,7 +964,7 @@ ConsoleBlockModeProc( static int ConsoleCloseProc( - ClientData instanceData, /* Pointer to ConsoleChannelInfo structure. */ + void *instanceData, /* Pointer to ConsoleChannelInfo structure. */ TCL_UNUSED(Tcl_Interp *), int flags) { @@ -1058,7 +1058,7 @@ ConsoleCloseProc( /* There may be references already on the event queue */ chanInfoPtr->numRefs -= 1; } else { - ckfree(chanInfoPtr); + Tcl_Free(chanInfoPtr); } return errorCode; @@ -1083,7 +1083,7 @@ ConsoleCloseProc( */ static int ConsoleInputProc( - ClientData instanceData, /* Console state. */ + void *instanceData, /* Console state. */ char *bufPtr, /* Where to store data read. */ int bufSize, /* How much space is available in the * buffer? */ @@ -1236,7 +1236,7 @@ ConsoleInputProc( */ static int ConsoleOutputProc( - ClientData instanceData, /* Console state. */ + void *instanceData, /* Console state. */ const char *buf, /* The data buffer. */ int toWrite, /* How many bytes to write? */ int *errorCode) /* Where to store error code. */ @@ -1452,7 +1452,7 @@ ConsoleEventProc( } if (freeChannel) { - ckfree(chanInfoPtr); + Tcl_Free(chanInfoPtr); } return 1; @@ -1476,7 +1476,7 @@ ConsoleEventProc( static void ConsoleWatchProc( - ClientData instanceData, /* Console state. */ + void *instanceData, /* Console state. */ int newMask) /* What events to watch for, one of * of TCL_READABLE, TCL_WRITABLE */ @@ -1552,9 +1552,9 @@ ConsoleWatchProc( static int ConsoleGetHandleProc( - ClientData instanceData, /* The console state. */ + void *instanceData, /* The console state. */ TCL_UNUSED(int) /*direction*/, - ClientData *handlePtr) /* Where to store the handle. */ + void **handlePtr) /* Where to store the handle. */ { ConsoleChannelInfo *chanInfoPtr = (ConsoleChannelInfo *)instanceData; @@ -1807,7 +1807,7 @@ ConsoleReaderThread( */ } - ckfree(handleInfoPtr); + Tcl_Free(handleInfoPtr); return 0; } @@ -1965,7 +1965,7 @@ ConsoleWriterThread(LPVOID arg) RingBufferClear(&handleInfoPtr->buffer); - ckfree(handleInfoPtr); + Tcl_Free(handleInfoPtr); return 0; } @@ -2002,7 +2002,8 @@ AllocateConsoleHandleInfo( DWORD consoleMode; - handleInfoPtr = (ConsoleHandleInfo *)ckalloc(sizeof(*handleInfoPtr)); + handleInfoPtr = (ConsoleHandleInfo *)Tcl_Alloc(sizeof(*handleInfoPtr)); + memset(handleInfoPtr, 0, sizeof(*handleInfoPtr)); memset(handleInfoPtr, 0, sizeof(*handleInfoPtr)); handleInfoPtr->console = consoleHandle; InitializeSRWLock(&handleInfoPtr->lock); @@ -2029,7 +2030,7 @@ AllocateConsoleHandleInfo( if (handleInfoPtr->consoleThread == NULL) { /* Note - SRWLock and condition variables do not need finalization */ RingBufferClear(&handleInfoPtr->buffer); - ckfree(handleInfoPtr); + Tcl_Free(handleInfoPtr); return NULL; } @@ -2108,7 +2109,7 @@ TclWinOpenConsoleChannel( ConsoleInit(); - chanInfoPtr = (ConsoleChannelInfo *)ckalloc(sizeof(*chanInfoPtr)); + chanInfoPtr = (ConsoleChannelInfo *)Tcl_Alloc(sizeof(*chanInfoPtr)); memset(chanInfoPtr, 0, sizeof(*chanInfoPtr)); chanInfoPtr->permissions = permissions; @@ -2167,7 +2168,7 @@ TclWinOpenConsoleChannel( if (permissions == TCL_READABLE) { SetConsoleMode(handle, chanInfoPtr->initMode); } - ckfree(chanInfoPtr); + Tcl_Free(chanInfoPtr); return NULL; } @@ -2199,7 +2200,6 @@ TclWinOpenConsoleChannel( */ Tcl_SetChannelOption(NULL, chanInfoPtr->channel, "-translation", "auto"); - Tcl_SetChannelOption(NULL, chanInfoPtr->channel, "-eofchar", "\x1A {}"); Tcl_SetChannelOption(NULL, chanInfoPtr->channel, "-encoding", "utf-16"); return chanInfoPtr->channel; } @@ -2222,7 +2222,7 @@ TclWinOpenConsoleChannel( static void ConsoleThreadActionProc( - ClientData instanceData, + void *instanceData, int action) { ConsoleChannelInfo *chanInfoPtr = (ConsoleChannelInfo *)instanceData; @@ -2255,7 +2255,7 @@ ConsoleThreadActionProc( */ static int ConsoleSetOptionProc( - ClientData instanceData, /* File state. */ + void *instanceData, /* File state. */ Tcl_Interp *interp, /* For error reporting - can be NULL. */ const char *optionName, /* Which option to set? */ const char *value) /* New value for option. */ @@ -2344,7 +2344,7 @@ ConsoleSetOptionProc( static int ConsoleGetOptionProc( - ClientData instanceData, /* File state. */ + void *instanceData, /* File state. */ Tcl_Interp *interp, /* For error reporting - can be NULL. */ const char *optionName, /* Option to get. */ Tcl_DString *dsPtr) /* Where to store value(s). */ diff --git a/win/tclWinDde.c b/win/tclWinDde.c index 1c10c65..23d0bce 100644 --- a/win/tclWinDde.c +++ b/win/tclWinDde.c @@ -117,7 +117,7 @@ static int DdeObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -#if (TCL_MAJOR_VERSION < 9) && (TCL_MINOR_VERSION < 7) +#if (TCL_MAJOR_VERSION < 9) && defined(TCL_MINOR_VERSION) && (TCL_MINOR_VERSION < 7) # if TCL_UTF_MAX > 3 # define Tcl_WCharToUtfDString(a,b,c) Tcl_WinTCharToUtf((TCHAR *)(a),(b)*sizeof(WCHAR),c) # define Tcl_UtfToWCharDString(a,b,c) (WCHAR *)Tcl_WinUtfToTChar(a,b,c) diff --git a/win/tclWinError.c b/win/tclWinError.c index 7e5898b..3e75a85 100644 --- a/win/tclWinError.c +++ b/win/tclWinError.c @@ -351,9 +351,9 @@ void Tcl_WinConvertError( unsigned errCode) /* Win32 error code. */ { - if (errCode >= sizeof(errorTable)/sizeof(errorTable[0])) { + if ((unsigned)errCode >= sizeof(errorTable)/sizeof(errorTable[0])) { errCode -= WSAEWOULDBLOCK; - if (errCode >= sizeof(wsaErrorTable)/sizeof(wsaErrorTable[0])) { + if ((unsigned)errCode >= sizeof(wsaErrorTable)/sizeof(wsaErrorTable[0])) { Tcl_SetErrno(errorTable[1]); } else { Tcl_SetErrno(wsaErrorTable[errCode]); @@ -381,7 +381,7 @@ Tcl_WinConvertError( *---------------------------------------------------------------------- */ -TCL_NORETURN void +void tclWinDebugPanic( const char *format, ...) { @@ -413,12 +413,6 @@ tclWinDebugPanic( fprintf(stderr, "\n"); fflush(stderr); } -# if defined(__GNUC__) - __builtin_trap(); -# else - DebugBreak(); -# endif - abort(); } #endif /* diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c index 7f8cfd1..422c70c 100644 --- a/win/tclWinFCmd.c +++ b/win/tclWinFCmd.c @@ -309,7 +309,7 @@ DoRenameFile( if (srcAttr & FILE_ATTRIBUTE_DIRECTORY) { WCHAR *nativeSrcRest, *nativeDstRest; const char **srcArgv, **dstArgv; - int size, srcArgc, dstArgc; + size_t size, srcArgc, dstArgc; WCHAR nativeSrcPath[MAX_PATH]; WCHAR nativeDstPath[MAX_PATH]; Tcl_DString srcString, dstString; @@ -378,8 +378,8 @@ DoRenameFile( Tcl_SetErrno(EXDEV); } - ckfree(srcArgv); - ckfree(dstArgv); + Tcl_Free((void *)srcArgv); + Tcl_Free((void *)dstArgv); } /* @@ -1535,8 +1535,8 @@ GetWinFileAttributes( * We test for, and fix that case, here. */ - int len; - const char *str = TclGetStringFromObj(fileName, &len); + size_t len; + const char *str = Tcl_GetStringFromObj(fileName, &len); if (len < 4) { if (len == 0) { @@ -1595,8 +1595,9 @@ ConvertFileNameFormat( int longShort, /* 0 to short name, 1 to long name. */ Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */ { - int pathc, i; + size_t pathc, i; Tcl_Obj *splitPath; + size_t length; splitPath = Tcl_FSSplitPath(fileName, &pathc); @@ -1604,7 +1605,7 @@ ConvertFileNameFormat( if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not read \"%s\": no such file or directory", - Tcl_GetString(fileName))); + TclGetString(fileName))); errno = ENOENT; Tcl_PosixError(interp); } @@ -1621,11 +1622,10 @@ ConvertFileNameFormat( for (i = 0; i < pathc; i++) { Tcl_Obj *elt; char *pathv; - int length; Tcl_ListObjIndex(NULL, splitPath, i, &elt); - pathv = TclGetStringFromObj(elt, &length); + pathv = Tcl_GetStringFromObj(elt, &length); if ((pathv[0] == '/') || ((length == 3) && (pathv[1] == ':')) || (strcmp(pathv, ".") == 0) || (strcmp(pathv, "..") == 0)) { /* @@ -1661,7 +1661,7 @@ ConvertFileNameFormat( * likely to lead to infinite loops. */ - tempString = TclGetStringFromObj(tempPath, &length); + tempString = Tcl_GetStringFromObj(tempPath, &length); Tcl_DStringInit(&ds); nativeName = Tcl_UtfToWCharDString(tempString, length, &ds); Tcl_DecrRefCount(tempPath); @@ -1715,19 +1715,8 @@ ConvertFileNameFormat( Tcl_WCharToUtfDString(nativeName, TCL_INDEX_NONE, &dsTemp); Tcl_DStringFree(&ds); - /* - * Deal with issues of tildes being absolute. - */ - - if (Tcl_DStringValue(&dsTemp)[0] == '~') { - TclNewLiteralStringObj(tempPath, "./"); - Tcl_AppendToObj(tempPath, Tcl_DStringValue(&dsTemp), - Tcl_DStringLength(&dsTemp)); - Tcl_DStringFree(&dsTemp); - } else { - tempPath = Tcl_DStringToObj(&dsTemp); - } - Tcl_ListObjReplace(NULL, splitPath, i, 1, 1, &tempPath); + tempPath = Tcl_DStringToObj(&dsTemp); + Tcl_ListObjReplace(NULL, splitPath, i, 1, 1, &tempPath); FindClose(handle); } } @@ -1896,7 +1885,7 @@ CannotSetAttribute( { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "cannot set attribute \"%s\" for file \"%s\": attribute is readonly", - tclpFileAttrStrings[objIndex], Tcl_GetString(fileName))); + tclpFileAttrStrings[objIndex], TclGetString(fileName))); errno = EINVAL; Tcl_PosixError(interp); return TCL_ERROR; diff --git a/win/tclWinFile.c b/win/tclWinFile.c index 7e0a763..30ca622 100644 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -149,8 +149,8 @@ typedef struct { * Other typedefs required by this code. */ -static time_t ToCTime(FILETIME fileTime); -static void FromCTime(time_t posixTime, FILETIME *fileTime); +static __time64_t ToCTime(FILETIME fileTime); +static void FromCTime(__time64_t posixTime, FILETIME *fileTime); /* * Declarations for local functions defined in this file: @@ -177,7 +177,7 @@ static int WinLink(const WCHAR *LinkSource, const WCHAR *LinkTarget, int linkAction); static int WinSymLinkDirectory(const WCHAR *LinkDirectory, const WCHAR *LinkTarget); -MODULE_SCOPE TCL_NORETURN void tclWinDebugPanic(const char *format, ...); +MODULE_SCOPE void tclWinDebugPanic(const char *format, ...); /* *-------------------------------------------------------------------- @@ -808,7 +808,7 @@ NativeWriteReparse( *---------------------------------------------------------------------- */ -TCL_NORETURN void +void tclWinDebugPanic( const char *format, ...) { @@ -838,16 +838,6 @@ tclWinDebugPanic( MessageBoxW(NULL, msgString, L"Fatal Error", MB_ICONSTOP | MB_OK | MB_TASKMODAL | MB_SETFOREGROUND); } -#if defined(__GNUC__) - __builtin_trap(); -#elif defined(_WIN64) - __debugbreak(); -#elif defined(_MSC_VER) && defined (_M_IX86) - _asm {int 3} -#else - DebugBreak(); -#endif - abort(); } /* @@ -874,16 +864,7 @@ TclpFindExecutable( { WCHAR wName[MAX_PATH]; char name[MAX_PATH * 3]; - - /* - * Under Windows we ignore argv0, and return the path for the file used to - * create this process. Only if it is NULL, install a new panic handler. - */ - - if (argv0 == NULL) { -# undef Tcl_SetPanicProc - Tcl_SetPanicProc(tclWinDebugPanic); - } + (void)argv0; GetModuleFileNameW(NULL, wName, sizeof(wName)/sizeof(WCHAR)); WideCharToMultiByte(CP_UTF8, 0, wName, -1, name, sizeof(name), NULL, NULL); @@ -941,7 +922,7 @@ TclpMatchInDirectory( DWORD attr; WIN32_FILE_ATTRIBUTE_DATA data; Tcl_Size len = 0; - const char *str = TclGetStringFromObj(norm, &len); + const char *str = Tcl_GetStringFromObj(norm, &len); native = (const WCHAR *)Tcl_FSGetNativePath(pathPtr); @@ -1001,7 +982,7 @@ TclpMatchInDirectory( */ Tcl_DStringInit(&dsOrig); - dirName = TclGetStringFromObj(fileNamePtr, &dirLength); + dirName = Tcl_GetStringFromObj(fileNamePtr, &dirLength); Tcl_DStringAppend(&dsOrig, dirName, dirLength); lastChar = dirName[dirLength -1]; @@ -2294,7 +2275,7 @@ NativeStatMode( * * ToCTime -- * - * Converts a Windows FILETIME to a time_t in UTC. + * Converts a Windows FILETIME to a __time64_t in UTC. * * Results: * Returns the count of seconds from the Posix epoch. @@ -2302,7 +2283,7 @@ NativeStatMode( *------------------------------------------------------------------------ */ -static time_t +static __time64_t ToCTime( FILETIME fileTime) /* UTC time */ { @@ -2311,7 +2292,7 @@ ToCTime( convertedTime.LowPart = fileTime.dwLowDateTime; convertedTime.HighPart = (LONG) fileTime.dwHighDateTime; - return (time_t) ((convertedTime.QuadPart - + return (__time64_t) ((convertedTime.QuadPart - (long long) POSIX_EPOCH_AS_FILETIME) / (long long) 10000000); } @@ -2320,7 +2301,7 @@ ToCTime( * * FromCTime -- * - * Converts a time_t to a Windows FILETIME + * Converts a __time64_t to a Windows FILETIME * * Results: * Returns the count of 100-ns ticks seconds from the Windows epoch. @@ -2330,7 +2311,7 @@ ToCTime( static void FromCTime( - time_t posixTime, + __time64_t posixTime, FILETIME *fileTime) /* UTC Time */ { LARGE_INTEGER convertedTime; @@ -2477,7 +2458,7 @@ TclpFilesystemPathType( if (normPath == NULL) { return NULL; } - path = Tcl_GetString(normPath); + path = TclGetString(normPath); if (path == NULL) { return NULL; } @@ -2557,7 +2538,7 @@ TclpObjNormalizePath( Tcl_DString ds; /* Some workspace. */ Tcl_DStringInit(&dsNorm); - path = Tcl_GetString(pathPtr); + path = TclGetString(pathPtr); currentPathEndPosition = path + nextCheckpoint; if (*currentPathEndPosition == '/') { @@ -2655,12 +2636,12 @@ TclpObjNormalizePath( * Convert link to forward slashes. */ - for (path = Tcl_GetString(to); *path != 0; path++) { + for (path = TclGetString(to); *path != 0; path++) { if (*path == '\\') { *path = '/'; } } - path = Tcl_GetString(to); + path = TclGetString(to); currentPathEndPosition = path + nextCheckpoint; if (temp != NULL) { Tcl_DecrRefCount(temp); @@ -2826,7 +2807,7 @@ TclpObjNormalizePath( tmpPathPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), nextCheckpoint); Tcl_AppendToObj(tmpPathPtr, lastValidPathEnd, TCL_INDEX_NONE); - path = TclGetStringFromObj(tmpPathPtr, &len); + path = Tcl_GetStringFromObj(tmpPathPtr, &len); Tcl_SetStringObj(pathPtr, path, len); Tcl_DecrRefCount(tmpPathPtr); } else { @@ -2895,7 +2876,7 @@ TclWinVolumeRelativeNormalize( * current volume. */ - const char *drive = Tcl_GetString(useThisCwd); + const char *drive = TclGetString(useThisCwd); absolutePath = Tcl_NewStringObj(drive,2); Tcl_AppendToObj(absolutePath, path, TCL_INDEX_NONE); @@ -2911,7 +2892,7 @@ TclWinVolumeRelativeNormalize( */ Tcl_Size cwdLen; - const char *drive = TclGetStringFromObj(useThisCwd, &cwdLen); + const char *drive = Tcl_GetStringFromObj(useThisCwd, &cwdLen); char drive_cur = path[0]; if (drive_cur >= 'a') { @@ -3084,7 +3065,7 @@ TclNativeCreateNativeRep( Tcl_IncrRefCount(validPathPtr); } - str = TclGetStringFromObj(validPathPtr, &len); + str = Tcl_GetStringFromObj(validPathPtr, &len); if (strlen(str) != (size_t)len) { /* @@ -3115,7 +3096,7 @@ TclNativeCreateNativeRep( * Overallocate 6 chars, making some room for extended paths */ - wp = nativePathPtr = (WCHAR *)ckalloc((len + 6) * sizeof(WCHAR)); + wp = nativePathPtr = (WCHAR *)Tcl_Alloc((len + 6) * sizeof(WCHAR)); if (nativePathPtr==0) { goto done; } @@ -3214,7 +3195,7 @@ TclNativeDupInternalRep( len = sizeof(WCHAR) * (wcslen((const WCHAR *) clientData) + 1); - copy = (char *)ckalloc(len); + copy = (char *)Tcl_Alloc(len); memcpy(copy, clientData, len); return copy; } @@ -3330,7 +3311,7 @@ TclWinFileOwned( bufsz = 0; GetTokenInformation(token, TokenUser, NULL, 0, &bufsz); if (bufsz) { - buf = (LPBYTE)ckalloc(bufsz); + buf = (LPBYTE)Tcl_Alloc(bufsz); if (GetTokenInformation(token, TokenUser, buf, bufsz, &bufsz)) { owned = EqualSid(ownerSid, ((PTOKEN_USER) buf)->User.Sid); } @@ -3346,7 +3327,7 @@ TclWinFileOwned( LocalFree(secd); /* Also frees ownerSid */ } if (buf) { - ckfree(buf); + Tcl_Free(buf); } return (owned != 0); /* Convert non-0 to 1 */ diff --git a/win/tclWinInit.c b/win/tclWinInit.c index 77ee107..a7e82de 100644 --- a/win/tclWinInit.c +++ b/win/tclWinInit.c @@ -124,14 +124,14 @@ TclpInitPlatform(void) void TclpInitLibraryPath( char **valuePtr, - unsigned int *lengthPtr, + size_t *lengthPtr, Tcl_Encoding *encodingPtr) { #define LIBRARY_SIZE 64 Tcl_Obj *pathPtr; char installLib[LIBRARY_SIZE]; const char *bytes; - int length; + size_t length; TclNewObj(pathPtr); @@ -167,9 +167,9 @@ TclpInitLibraryPath( TclGetProcessGlobalValue(&sourceLibraryDir)); *encodingPtr = NULL; - bytes = TclGetStringFromObj(pathPtr, &length); + bytes = Tcl_GetStringFromObj(pathPtr, &length); *lengthPtr = length++; - *valuePtr = (char *)ckalloc(length); + *valuePtr = (char *)Tcl_Alloc(length); memcpy(*valuePtr, bytes, length); Tcl_DecrRefCount(pathPtr); } @@ -198,7 +198,7 @@ AppendEnvironment( Tcl_Obj *pathPtr, const char *lib) { - int pathc; + size_t pathc; WCHAR wBuf[MAX_PATH]; char buf[MAX_PATH * 3]; Tcl_Obj *objPtr; @@ -260,7 +260,7 @@ AppendEnvironment( objPtr = Tcl_NewStringObj(buf, TCL_INDEX_NONE); } Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); - ckfree(pathv); + Tcl_Free((void *)pathv); } } @@ -284,10 +284,10 @@ AppendEnvironment( static void InitializeDefaultLibraryDir( char **valuePtr, - unsigned int *lengthPtr, + size_t *lengthPtr, Tcl_Encoding *encodingPtr) { - HMODULE hModule = TclWinGetTclInstance(); + HMODULE hModule = (HMODULE)TclWinGetTclInstance(); WCHAR wName[MAX_PATH + LIBRARY_SIZE]; char name[(MAX_PATH + LIBRARY_SIZE) * 3]; char *end, *p; @@ -306,7 +306,7 @@ InitializeDefaultLibraryDir( TclWinNoBackslash(name); sprintf(end + 1, "lib/tcl%s", TCL_VERSION); *lengthPtr = strlen(name); - *valuePtr = (char *)ckalloc(*lengthPtr + 1); + *valuePtr = (char *)Tcl_Alloc(*lengthPtr + 1); *encodingPtr = NULL; memcpy(*valuePtr, name, *lengthPtr + 1); } @@ -332,10 +332,10 @@ InitializeDefaultLibraryDir( static void InitializeSourceLibraryDir( char **valuePtr, - unsigned int *lengthPtr, + size_t *lengthPtr, Tcl_Encoding *encodingPtr) { - HMODULE hModule = TclWinGetTclInstance(); + HMODULE hModule = (HMODULE)TclWinGetTclInstance(); WCHAR wName[MAX_PATH + LIBRARY_SIZE]; char name[(MAX_PATH + LIBRARY_SIZE) * 3]; char *end, *p; @@ -354,7 +354,7 @@ InitializeSourceLibraryDir( TclWinNoBackslash(name); sprintf(end + 1, "../library"); *lengthPtr = strlen(name); - *valuePtr = (char *)ckalloc(*lengthPtr + 1); + *valuePtr = (char *)Tcl_Alloc(*lengthPtr + 1); *encodingPtr = NULL; memcpy(*valuePtr, name, *lengthPtr + 1); } @@ -493,20 +493,6 @@ TclpSetVariables( TCL_GLOBAL_ONLY); } -#if !defined(NDEBUG) && !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 - - /* - * The existence of the "debug" element of the tcl_platform array - * indicates that this particular Tcl shell has been compiled with debug - * information. Using "info exists tcl_platform(debug)" a Tcl script can - * direct the interpreter to load debug versions of DLLs with the load - * command. - */ - - Tcl_SetVar2(interp, "tcl_platform", "debug", "1", - TCL_GLOBAL_ONLY); -#endif - /* * Set up the HOME environment variable from the HOMEDRIVE & HOMEPATH * environment variables, if necessary. @@ -566,9 +552,10 @@ TclpSetVariables( * * Results: * The return value is the index in environ of an entry with the name - * "name", or -1 if there is no such entry. The integer at *lengthPtr is - * filled in with the length of name (if a matching entry is found) or - * the length of the environ array (if no matching entry is found). + * "name", or TCL_INDEX_NONE if there is no such entry. The integer + * at *lengthPtr is filled in with the length of name (if a matching + * entry is found) or the length of the environ array (if no + * matching entry is found). * * Side effects: * None. @@ -579,16 +566,16 @@ TclpSetVariables( # define tenviron2utfdstr(string, len, dsPtr) \ (char *)Tcl_Char16ToUtfDString((const unsigned short *)(string), ((((len) + 2) >> 1) - 1), (dsPtr)) -int +size_t TclpFindVariable( const char *name, /* Name of desired environment variable * (UTF-8). */ - int *lengthPtr) /* Used to return length of name (for + size_t *lengthPtr) /* Used to return length of name (for * successful searches) or number of non-NULL * entries in environ (for unsuccessful * searches). */ { - int i, length, result = -1; + size_t i, length, result = TCL_INDEX_NONE; const WCHAR *env; const char *p1, *p2; char *envUpper, *nameUpper; @@ -599,7 +586,7 @@ TclpFindVariable( */ length = strlen(name); - nameUpper = (char *)ckalloc(length + 1); + nameUpper = (char *)Tcl_Alloc(length + 1); memcpy(nameUpper, name, length+1); Tcl_UtfToUpper(nameUpper); @@ -619,7 +606,7 @@ TclpFindVariable( if (p1 == NULL) { continue; } - length = (int) (p1 - envUpper); + length = p1 - envUpper; Tcl_DStringSetLength(&envString, length+1); Tcl_UtfToUpper(envUpper); @@ -641,7 +628,7 @@ TclpFindVariable( done: Tcl_DStringFree(&envString); - ckfree(nameUpper); + Tcl_Free(nameUpper); return result; } diff --git a/win/tclWinInt.h b/win/tclWinInt.h index 1b6e606..d3d6680 100644 --- a/win/tclWinInt.h +++ b/win/tclWinInt.h @@ -81,7 +81,7 @@ typedef struct TclPipeThreadInfo { } TclPipeThreadInfo; -/* If pipe-workers will use some tcl subsystem, we can use ckalloc without +/* If pipe-workers will use some tcl subsystem, we can use Tcl_Alloc without * more overhead for finalize thread (should be executed anyway) * * #define _PTI_USE_CKALLOC 1 diff --git a/win/tclWinLoad.c b/win/tclWinLoad.c index df49337..ccedb9d 100644 --- a/win/tclWinLoad.c +++ b/win/tclWinLoad.c @@ -121,7 +121,7 @@ TclpDlopen( } errMsg = Tcl_ObjPrintf("couldn't load library \"%s\": ", - Tcl_GetString(pathPtr)); + TclGetString(pathPtr)); /* * Check for possible DLL errors. This doesn't work quite right, @@ -174,7 +174,7 @@ TclpDlopen( * Succeded; package everything up for Tcl. */ - handlePtr = (Tcl_LoadHandle)ckalloc(sizeof(struct Tcl_LoadHandle_)); + handlePtr = (Tcl_LoadHandle)Tcl_Alloc(sizeof(struct Tcl_LoadHandle_)); handlePtr->clientData = (ClientData) hInstance; handlePtr->findSymbolProcPtr = &FindSymbol; handlePtr->unloadFileProcPtr = &UnloadFile; @@ -259,7 +259,7 @@ UnloadFile( HINSTANCE hInstance = (HINSTANCE) loadHandle->clientData; FreeLibrary(hInstance); - ckfree(loadHandle); + Tcl_Free(loadHandle); } /* @@ -390,7 +390,7 @@ InitDLLDirectoryName(void) */ copyToGlobalBuffer: - dllDirectoryName = (WCHAR *)ckalloc((nameLen+1) * sizeof(WCHAR)); + dllDirectoryName = (WCHAR *)Tcl_Alloc((nameLen+1) * sizeof(WCHAR)); wcscpy(dllDirectoryName, name); return TCL_OK; } diff --git a/win/tclWinNotify.c b/win/tclWinNotify.c index fd39428..ec6fd51 100644 --- a/win/tclWinNotify.c +++ b/win/tclWinNotify.c @@ -100,7 +100,7 @@ TclpInitNotifier(void) clazz.style = 0; clazz.cbClsExtra = 0; clazz.cbWndExtra = 0; - clazz.hInstance = TclWinGetTclInstance(); + clazz.hInstance = (HINSTANCE) TclWinGetTclInstance(); clazz.hbrBackground = NULL; clazz.lpszMenuName = NULL; clazz.lpszClassName = className; @@ -188,7 +188,7 @@ TclpFinalizeNotifier( if (notifierCount) { notifierCount--; if (notifierCount == 0) { - UnregisterClassW(className, TclWinGetTclInstance()); + UnregisterClassW(className, (HINSTANCE) TclWinGetTclInstance()); } } LeaveCriticalSection(¬ifierMutex); @@ -337,7 +337,8 @@ TclpServiceModeHook( if (mode == TCL_SERVICE_ALL && !tsdPtr->hwnd) { tsdPtr->hwnd = CreateWindowW(className, className, WS_TILED, - 0, 0, 0, 0, NULL, NULL, TclWinGetTclInstance(), NULL); + 0, 0, 0, 0, NULL, NULL, (HINSTANCE) TclWinGetTclInstance(), + NULL); /* * Send an initial message to the window to ensure that we wake up the diff --git a/win/tclWinPanic.c b/win/tclWinPanic.c index 364673e..7c21167 100644 --- a/win/tclWinPanic.c +++ b/win/tclWinPanic.c @@ -1,4 +1,4 @@ -/* + /* * tclWinPanic.c -- * * Contains the Windows-specific command-line panic proc. @@ -28,7 +28,7 @@ *---------------------------------------------------------------------- */ -void +TCL_NORETURN1 void Tcl_ConsolePanic( const char *format, ...) { diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c index 6f9a8db..b7949d1 100644 --- a/win/tclWinPipe.c +++ b/win/tclWinPipe.c @@ -61,7 +61,7 @@ typedef struct { typedef struct ProcInfo { HANDLE hProcess; - DWORD dwProcessId; + size_t dwProcessId; struct ProcInfo *nextPtr; } ProcInfo; @@ -203,7 +203,7 @@ static void PipeThreadActionProc(void *instanceData, static const Tcl_ChannelType pipeChannelType = { "pipe", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ - TCL_CLOSE2PROC, /* Close proc. */ + NULL, /* Close proc. */ PipeInputProc, /* Input proc. */ PipeOutputProc, /* Output proc. */ NULL, /* Seek proc. */ @@ -402,7 +402,7 @@ PipeCheckProc( if (needEvent) { infoPtr->flags |= PIPE_PENDING; - evPtr = (PipeEvent *)ckalloc(sizeof(PipeEvent)); + evPtr = (PipeEvent *)Tcl_Alloc(sizeof(PipeEvent)); evPtr->header.proc = PipeEventProc; evPtr->infoPtr = infoPtr; Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL); @@ -433,7 +433,7 @@ TclWinMakeFile( { WinFile *filePtr; - filePtr = (WinFile *)ckalloc(sizeof(WinFile)); + filePtr = (WinFile *)Tcl_Alloc(sizeof(WinFile)); filePtr->type = WIN_FILE; filePtr->handle = handle; @@ -826,7 +826,7 @@ TclpCloseFile( if (filePtr->handle != NULL && CloseHandle(filePtr->handle) == FALSE) { Tcl_WinConvertError(GetLastError()); - ckfree(filePtr); + Tcl_Free(filePtr); return -1; } } @@ -836,7 +836,7 @@ TclpCloseFile( Tcl_Panic("TclpCloseFile: unexpected file type"); } - ckfree(filePtr); + Tcl_Free(filePtr); return 0; } @@ -869,7 +869,7 @@ TclpGetPid( Tcl_MutexLock(&pipeMutex); for (infoPtr = procList; infoPtr != NULL; infoPtr = infoPtr->nextPtr) { - if (infoPtr->dwProcessId == (DWORD)(size_t)pid) { + if (infoPtr->dwProcessId == (size_t)pid) { Tcl_MutexUnlock(&pipeMutex); return infoPtr->dwProcessId; } @@ -1764,7 +1764,7 @@ TclpCreateCommandChannel( Tcl_Pid *pidPtr) /* An array of process identifiers. */ { char channelName[16 + TCL_INTEGER_SPACE]; - PipeInfo *infoPtr = (PipeInfo *)ckalloc(sizeof(PipeInfo)); + PipeInfo *infoPtr = (PipeInfo *)Tcl_Alloc(sizeof(PipeInfo)); PipeInit(); @@ -1827,14 +1827,7 @@ TclpCreateCommandChannel( infoPtr->channel = Tcl_CreateChannel(&pipeChannelType, channelName, infoPtr, infoPtr->validMask); - /* - * Pipes have AUTO translation mode on Windows and ^Z eof char, which - * means that a ^Z will be appended to them at close. This is needed for - * Windows programs that expect a ^Z at EOF. - */ - Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto"); - Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\x1A {}"); return infoPtr->channel; } @@ -1922,13 +1915,13 @@ TclGetAndDetachPids( TclNewObj(pidsObj); for (i = 0; i < pipePtr->numPids; i++) { Tcl_ListObjAppendElement(NULL, pidsObj, - Tcl_NewWideIntObj((unsigned) + Tcl_NewWideIntObj( TclpGetPid(pipePtr->pidPtr[i]))); Tcl_DetachPids(1, &pipePtr->pidPtr[i]); } Tcl_SetObjResult(interp, pidsObj); if (pipePtr->numPids > 0) { - ckfree(pipePtr->pidPtr); + Tcl_Free(pipePtr->pidPtr); pipePtr->numPids = 0; } } @@ -2113,9 +2106,9 @@ PipeClose2Proc( if (pipePtr->errorFile) { WinFile *filePtr = (WinFile *) pipePtr->errorFile; - errChan = Tcl_MakeFileChannel((void *)filePtr->handle, + errChan = Tcl_MakeFileChannel((void *) filePtr->handle, TCL_READABLE); - ckfree(filePtr); + Tcl_Free(filePtr); } else { errChan = NULL; } @@ -2125,14 +2118,14 @@ PipeClose2Proc( } if (pipePtr->numPids > 0) { - ckfree(pipePtr->pidPtr); + Tcl_Free(pipePtr->pidPtr); } if (pipePtr->writeBuf != NULL) { - ckfree(pipePtr->writeBuf); + Tcl_Free(pipePtr->writeBuf); } - ckfree(pipePtr); + Tcl_Free(pipePtr); if (errorCode == 0) { return result; @@ -2301,10 +2294,10 @@ PipeOutputProc( */ if (infoPtr->writeBuf) { - ckfree(infoPtr->writeBuf); + Tcl_Free(infoPtr->writeBuf); } infoPtr->writeBufLen = toWrite; - infoPtr->writeBuf = (char *)ckalloc(toWrite); + infoPtr->writeBuf = (char *)Tcl_Alloc(toWrite); } memcpy(infoPtr->writeBuf, buf, toWrite); infoPtr->toWrite = toWrite; @@ -2566,7 +2559,7 @@ Tcl_WaitPid( prevPtrPtr = &procList; for (infoPtr = procList; infoPtr != NULL; prevPtrPtr = &infoPtr->nextPtr, infoPtr = infoPtr->nextPtr) { - if (infoPtr->dwProcessId == (DWORD) (size_t) pid) { + if (infoPtr->dwProcessId == (size_t) pid) { *prevPtrPtr = infoPtr->nextPtr; break; } @@ -2684,7 +2677,7 @@ Tcl_WaitPid( */ CloseHandle(infoPtr->hProcess); - ckfree(infoPtr); + Tcl_Free(infoPtr); return result; } @@ -2710,9 +2703,9 @@ Tcl_WaitPid( void TclWinAddProcess( void *hProcess, /* Handle to process */ - unsigned long id) /* Global process identifier */ + size_t id) /* Global process identifier */ { - ProcInfo *procPtr = (ProcInfo*)ckalloc(sizeof(ProcInfo)); + ProcInfo *procPtr = (ProcInfo*)Tcl_Alloc(sizeof(ProcInfo)); PipeInit(); @@ -2759,9 +2752,9 @@ Tcl_PidObjCmd( return TCL_ERROR; } if (objc == 1) { - Tcl_SetObjResult(interp, Tcl_NewWideIntObj((unsigned) getpid())); + Tcl_SetObjResult(interp, Tcl_NewWideIntObj(getpid())); } else { - chan = Tcl_GetChannel(interp, Tcl_GetString(objv[1]), + chan = Tcl_GetChannel(interp, TclGetString(objv[1]), NULL); if (chan == (Tcl_Channel) NULL) { return TCL_ERROR; @@ -2775,7 +2768,7 @@ Tcl_PidObjCmd( TclNewObj(resultPtr); for (i = 0; i < pipePtr->numPids; i++) { Tcl_ListObjAppendElement(/*interp*/ NULL, resultPtr, - Tcl_NewWideIntObj((unsigned) + Tcl_NewWideIntObj( TclpGetPid(pipePtr->pidPtr[i]))); } Tcl_SetObjResult(interp, resultPtr); @@ -3213,7 +3206,7 @@ TclpOpenTemporaryFile( } namePtr += length * sizeof(WCHAR); if (basenameObj) { - const char *string = TclGetStringFromObj(basenameObj, &length); + const char *string = Tcl_GetStringFromObj(basenameObj, &length); Tcl_DStringInit(&buf); Tcl_UtfToWCharDString(string, length, &buf); @@ -3289,7 +3282,7 @@ TclPipeThreadCreateTI( #ifndef _PTI_USE_CKALLOC pipeTI = (TclPipeThreadInfo *)malloc(sizeof(TclPipeThreadInfo)); #else - pipeTI = (TclPipeThreadInfo *)ckalloc(sizeof(TclPipeThreadInfo)); + pipeTI = (TclPipeThreadInfo *)Tcl_Alloc(sizeof(TclPipeThreadInfo)); #endif /* !_PTI_USE_CKALLOC */ pipeTI->evControl = CreateEventW(NULL, FALSE, FALSE, NULL); pipeTI->state = PTI_STATE_IDLE; @@ -3650,7 +3643,7 @@ TclPipeThreadStop( #ifndef _PTI_USE_CKALLOC free(pipeTI); #else - ckfree(pipeTI); + Tcl_Free(pipeTI); #endif /* !_PTI_USE_CKALLOC */ } } @@ -3700,7 +3693,7 @@ TclPipeThreadExit( #ifndef _PTI_USE_CKALLOC free(pipeTI); #else - ckfree(pipeTI); + Tcl_Free(pipeTI); /* be sure all subsystems used are finalized */ Tcl_FinalizeThread(); #endif /* !_PTI_USE_CKALLOC */ diff --git a/win/tclWinPort.h b/win/tclWinPort.h index d7d60a4..2c01a6b 100644 --- a/win/tclWinPort.h +++ b/win/tclWinPort.h @@ -517,7 +517,7 @@ typedef DWORD_PTR * PDWORD_PTR; * use by tclAlloc.c. */ -#define TclpSysAlloc(size, isBin) ((void*)HeapAlloc(GetProcessHeap(), \ +#define TclpSysAlloc(size) ((void*)HeapAlloc(GetProcessHeap(), \ (DWORD)0, (DWORD)size)) #define TclpSysFree(ptr) (HeapFree(GetProcessHeap(), \ (DWORD)0, (HGLOBAL)ptr)) @@ -533,7 +533,7 @@ typedef DWORD_PTR * PDWORD_PTR; * address platform-specific issues. */ -#define TclpReleaseFile(file) ckfree(file) +#define TclpReleaseFile(file) Tcl_Free(file) /* * The following macros and declarations wrap the C runtime library @@ -550,7 +550,4 @@ typedef DWORD_PTR * PDWORD_PTR; # define LABEL_SECURITY_INFORMATION (0x00000010L) #endif -#define Tcl_DirEntry void -#define TclDIR void - #endif /* _TCLWINPORT */ diff --git a/win/tclWinReg.c b/win/tclWinReg.c index 998521c..a3341c2 100644 --- a/win/tclWinReg.c +++ b/win/tclWinReg.c @@ -124,7 +124,7 @@ static int SetValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj, Tcl_Obj *valueNameObj, Tcl_Obj *dataObj, Tcl_Obj *typeObj, REGSAM mode); -#if (TCL_MAJOR_VERSION < 9) && (TCL_MINOR_VERSION < 7) +#if (TCL_MAJOR_VERSION < 9) && defined(TCL_MINOR_VERSION) && (TCL_MINOR_VERSION < 7) # if TCL_UTF_MAX > 3 # define Tcl_WCharToUtfDString(a,b,c) Tcl_WinTCharToUtf((TCHAR *)(a),(b)*sizeof(WCHAR),c) # define Tcl_UtfToWCharDString(a,b,c) (WCHAR *)Tcl_WinUtfToTChar(a,b,c) diff --git a/win/tclWinSerial.c b/win/tclWinSerial.c index 449a8d7..3db36d5 100644 --- a/win/tclWinSerial.c +++ b/win/tclWinSerial.c @@ -204,7 +204,7 @@ static int SerialBlockingWrite(SerialInfo *infoPtr, LPVOID buf, static const Tcl_ChannelType serialChannelType = { "serial", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ - TCL_CLOSE2PROC, /* Close proc. */ + NULL, /* Close proc. */ SerialInputProc, /* Input proc. */ SerialOutputProc, /* Output proc. */ NULL, /* Seek proc. */ @@ -285,7 +285,7 @@ SerialInit(void) static void SerialExitHandler( - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); SerialInfo *infoPtr; @@ -323,7 +323,7 @@ SerialExitHandler( static void ProcExitHandler( - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { Tcl_MutexLock(&serialMutex); initialized = 0; @@ -406,7 +406,7 @@ SerialGetMilliseconds(void) void SerialSetupProc( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { SerialInfo *infoPtr; @@ -461,7 +461,7 @@ SerialSetupProc( static void SerialCheckProc( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { SerialInfo *infoPtr; @@ -535,7 +535,7 @@ SerialCheckProc( if (needEvent) { infoPtr->flags |= SERIAL_PENDING; - evPtr = (SerialEvent *)ckalloc(sizeof(SerialEvent)); + evPtr = (SerialEvent *)Tcl_Alloc(sizeof(SerialEvent)); evPtr->header.proc = SerialEventProc; evPtr->infoPtr = infoPtr; Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL); @@ -670,10 +670,10 @@ SerialCloseProc( */ if (serialPtr->writeBuf != NULL) { - ckfree(serialPtr->writeBuf); + Tcl_Free(serialPtr->writeBuf); serialPtr->writeBuf = NULL; } - ckfree(serialPtr); + Tcl_Free(serialPtr); if (errorCode == 0) { return result; @@ -1035,10 +1035,10 @@ SerialOutputProc( */ if (infoPtr->writeBuf) { - ckfree(infoPtr->writeBuf); + Tcl_Free(infoPtr->writeBuf); } infoPtr->writeBufLen = toWrite; - infoPtr->writeBuf = (char *)ckalloc(toWrite); + infoPtr->writeBuf = (char *)Tcl_Alloc(toWrite); } memcpy(infoPtr->writeBuf, buf, toWrite); infoPtr->toWrite = toWrite; @@ -1455,7 +1455,7 @@ TclWinOpenSerialChannel( SerialInit(); - infoPtr = (SerialInfo *)ckalloc(sizeof(SerialInfo)); + infoPtr = (SerialInfo *)Tcl_Alloc(sizeof(SerialInfo)); memset(infoPtr, 0, sizeof(SerialInfo)); infoPtr->validMask = permissions; @@ -1508,13 +1508,7 @@ TclWinOpenSerialChannel( infoPtr->evWritable), 0, NULL); } - /* - * Files have default translation of AUTO and ^Z eof char, which means - * that a ^Z will be accepted as EOF when reading. - */ - Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto"); - Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\x1A {}"); return infoPtr->channel; } @@ -1630,7 +1624,7 @@ SerialSetOptionProc( size_t len, vlen; Tcl_DString ds; const WCHAR *native; - int argc; + size_t argc; const char **argv; infoPtr = (SerialInfo *) instanceData; @@ -1782,7 +1776,7 @@ SerialSetOptionProc( " two elements with each a single 8-bit character", TCL_INDEX_NONE)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "XCHAR", NULL); } - ckfree(argv); + Tcl_Free((void *)argv); return TCL_ERROR; } @@ -1813,7 +1807,7 @@ SerialSetOptionProc( } dcb.XoffChar = (char) character; } - ckfree(argv); + Tcl_Free((void *)argv); if (!SetCommState(infoPtr->handle, &dcb)) { goto setStateFailed; @@ -1826,7 +1820,8 @@ SerialSetOptionProc( */ if ((len > 4) && (strncmp(optionName, "-ttycontrol", len) == 0)) { - int i, res = TCL_OK; + size_t i; + int res = TCL_OK; if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) { return TCL_ERROR; @@ -1838,7 +1833,7 @@ SerialSetOptionProc( "a list of signal,value pairs", value)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "TTYCONTROL", NULL); } - ckfree(argv); + Tcl_Free((void *)argv); return TCL_ERROR; } @@ -1896,7 +1891,7 @@ SerialSetOptionProc( } } - ckfree(argv); + Tcl_Free((void *)argv); return res; } @@ -1922,7 +1917,7 @@ SerialSetOptionProc( inSize = atoi(argv[0]); outSize = atoi(argv[1]); } - ckfree(argv); + Tcl_Free((void *)argv); if ((argc < 1) || (argc > 2) || (inSize <= 0) || (outSize <= 0)) { if (interp != NULL) { diff --git a/win/tclWinSock.c b/win/tclWinSock.c index b349d0d..e5c7ee3 100644 --- a/win/tclWinSock.c +++ b/win/tclWinSock.c @@ -243,12 +243,12 @@ static int FindFDInList(TcpState *statePtr, SOCKET socket); static DWORD WINAPI SocketThread(LPVOID arg); static void TcpThreadActionProc(void *instanceData, int action); +static int TcpCloseProc(void *, Tcl_Interp *); static Tcl_EventCheckProc SocketCheckProc; static Tcl_EventProc SocketEventProc; static Tcl_EventSetupProc SocketSetupProc; static Tcl_DriverBlockModeProc TcpBlockModeProc; -static Tcl_DriverCloseProc TcpCloseProc; static Tcl_DriverClose2Proc TcpClose2Proc; static Tcl_DriverSetOptionProc TcpSetOptionProc; static Tcl_DriverGetOptionProc TcpGetOptionProc; @@ -265,11 +265,7 @@ static Tcl_DriverGetHandleProc TcpGetHandleProc; static const Tcl_ChannelType tcpChannelType = { "tcp", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ -#ifndef TCL_NO_DEPRECATED - TcpCloseProc, /* Close proc. */ -#else - TCL_CLOSE2PROC, /* Close proc. */ -#endif + NULL, /* Close proc. */ TcpInputProc, /* Input proc. */ TcpOutputProc, /* Output proc. */ NULL, /* Seek proc. */ @@ -377,15 +373,15 @@ InitializeHostName( Tcl_DStringSetLength(&inDs, 256); if (gethostname(Tcl_DStringValue(&inDs), Tcl_DStringLength(&inDs)) == 0) { - Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&inDs), - TCL_INDEX_NONE, &ds); + Tcl_ExternalToUtfDStringEx(NULL, Tcl_DStringValue(&inDs), + TCL_INDEX_NONE, TCL_ENCODING_NOCOMPLAIN, &ds); } Tcl_DStringFree(&inDs); } *encodingPtr = Tcl_GetEncoding(NULL, "utf-8"); *lengthPtr = Tcl_DStringLength(&ds); - *valuePtr = (char *)ckalloc(*lengthPtr + 1); + *valuePtr = (char *)Tcl_Alloc(*lengthPtr + 1); memcpy(*valuePtr, Tcl_DStringValue(&ds), *lengthPtr + 1); Tcl_DStringFree(&ds); } @@ -1012,7 +1008,7 @@ TcpCloseProc( Tcl_WinConvertError((DWORD) WSAGetLastError()); errorCode = Tcl_GetErrno(); } - ckfree(thisfd); + Tcl_Free(thisfd); } if (statePtr->addrlist != NULL) { @@ -1053,7 +1049,7 @@ TcpCloseProc( * fear of damaging the list. */ - ckfree(statePtr); + Tcl_Free(statePtr); return errorCode; } @@ -1987,11 +1983,11 @@ Tcl_OpenTcpClient( statePtr, (TCL_READABLE | TCL_WRITABLE)); if (TCL_ERROR == Tcl_SetChannelOption(NULL, statePtr->channel, "-translation", "auto crlf")) { - Tcl_Close(NULL, statePtr->channel); + Tcl_CloseEx(NULL, statePtr->channel, 0); return NULL; } else if (TCL_ERROR == Tcl_SetChannelOption(NULL, statePtr->channel, "-eofchar", "")) { - Tcl_Close(NULL, statePtr->channel); + Tcl_CloseEx(NULL, statePtr->channel, 0); return NULL; } return statePtr->channel; @@ -2230,7 +2226,7 @@ Tcl_OpenTcpServerEx( SendSelectMessage(tsdPtr, SELECT, statePtr); if (Tcl_SetChannelOption(interp, statePtr->channel, "-eofchar", "") == TCL_ERROR) { - Tcl_Close(NULL, statePtr->channel); + Tcl_CloseEx(NULL, statePtr->channel, 0); return NULL; } return statePtr->channel; @@ -2302,12 +2298,12 @@ TcpAccept( newInfoPtr, (TCL_READABLE | TCL_WRITABLE)); if (Tcl_SetChannelOption(NULL, newInfoPtr->channel, "-translation", "auto crlf") == TCL_ERROR) { - Tcl_Close(NULL, newInfoPtr->channel); + Tcl_CloseEx(NULL, newInfoPtr->channel, 0); return; } if (Tcl_SetChannelOption(NULL, newInfoPtr->channel, "-eofchar", "") == TCL_ERROR) { - Tcl_Close(NULL, newInfoPtr->channel); + Tcl_CloseEx(NULL, newInfoPtr->channel, 0); return; } @@ -2550,7 +2546,7 @@ SocketCheckProc( statePtr->watchEvents | FD_CONNECT | FD_ACCEPT) && !GOT_BITS(statePtr->flags, SOCKET_PENDING)) { SET_BITS(statePtr->flags, SOCKET_PENDING); - evPtr = (SocketEvent *)ckalloc(sizeof(SocketEvent)); + evPtr = (SocketEvent *)Tcl_Alloc(sizeof(SocketEvent)); evPtr->header.proc = SocketEventProc; evPtr->socket = statePtr->sockets->fd; Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL); @@ -2825,7 +2821,7 @@ AddSocketInfoFd( * Add the first FD. */ - statePtr->sockets = (TcpFdList *)ckalloc(sizeof(TcpFdList)); + statePtr->sockets = (TcpFdList *)Tcl_Alloc(sizeof(TcpFdList)); fds = statePtr->sockets; } else { /* @@ -2836,7 +2832,7 @@ AddSocketInfoFd( fds = fds->next; } - fds->next = (TcpFdList *)ckalloc(sizeof(TcpFdList)); + fds->next = (TcpFdList *)Tcl_Alloc(sizeof(TcpFdList)); fds = fds->next; } @@ -2869,7 +2865,7 @@ AddSocketInfoFd( static TcpState * NewSocketInfo(SOCKET socket) { - TcpState *statePtr = (TcpState *)ckalloc(sizeof(TcpState)); + TcpState *statePtr = (TcpState *)Tcl_Alloc(sizeof(TcpState)); memset(statePtr, 0, sizeof(TcpState)); @@ -3232,68 +3228,6 @@ FindFDInList( /* *---------------------------------------------------------------------- * - * TclWinGetSockOpt, et al. -- - * - * Those functions are historically exported by the stubs table and - * just use the original system calls now. - * - * Warning: - * Those functions are depreciated and will be removed with TCL 9.0. - * - * Results: - * As defined for each function. - * - * Side effects: - * As defined for each function. - * - *---------------------------------------------------------------------- - */ - -#ifndef TCL_NO_DEPRECATED -#undef TclWinGetSockOpt -int -TclWinGetSockOpt( - SOCKET s, - int level, - int optname, - char *optval, - int *optlen) -{ - - return getsockopt(s, level, optname, optval, optlen); -} -#undef TclWinSetSockOpt -int -TclWinSetSockOpt( - SOCKET s, - int level, - int optname, - const char *optval, - int optlen) -{ - return setsockopt(s, level, optname, optval, optlen); -} - -#undef TclpInetNtoa -char * -TclpInetNtoa( - struct in_addr addr) -{ - return inet_ntoa(addr); -} -#undef TclWinGetServByName -struct servent * -TclWinGetServByName( - const char *name, - const char *proto) -{ - return getservbyname(name, proto); -} -#endif /* TCL_NO_DEPRECATED */ - -/* - *---------------------------------------------------------------------- - * * TcpThreadActionProc -- * * Insert or remove any thread local refs to this channel. diff --git a/win/tclWinTest.c b/win/tclWinTest.c index c910bc5..c012b53 100644 --- a/win/tclWinTest.c +++ b/win/tclWinTest.c @@ -41,7 +41,6 @@ static Tcl_ObjCmdProc TesteventloopCmd; static Tcl_ObjCmdProc TestvolumetypeCmd; static Tcl_ObjCmdProc TestwinclockCmd; static Tcl_ObjCmdProc TestwinsleepCmd; -static Tcl_ObjCmdProc TestSizeCmd; static Tcl_ObjCmdProc TestExceptionCmd; static int TestplatformChmod(const char *nativePath, int pmode); static Tcl_ObjCmdProc TestchmodCmd; @@ -78,7 +77,6 @@ TclplatformtestInit( Tcl_CreateObjCommand(interp, "testwinclock", TestwinclockCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testwinsleep", TestwinsleepCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testexcept", TestExceptionCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "testsize", TestSizeCmd, NULL, NULL); return TCL_OK; } @@ -102,7 +100,7 @@ TclplatformtestInit( static int TesteventloopCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -178,7 +176,7 @@ TesteventloopCmd( static int TestvolumetypeCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -244,7 +242,7 @@ TestvolumetypeCmd( static int TestwinclockCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp* interp, /* Tcl interpreter */ int objc, /* Argument count */ Tcl_Obj *const objv[]) /* Argument vector */ @@ -293,7 +291,7 @@ TestwinclockCmd( static int TestwinsleepCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp* interp, /* Tcl interpreter */ int objc, /* Parameter count */ Tcl_Obj *const * objv) /* Parameter vector */ @@ -311,28 +309,6 @@ TestwinsleepCmd( return TCL_OK; } -static int -TestSizeCmd( - TCL_UNUSED(ClientData), - Tcl_Interp* interp, /* Tcl interpreter */ - int objc, /* Parameter count */ - Tcl_Obj *const * objv) /* Parameter vector */ -{ - - if (objc != 2) { - goto syntax; - } - if (strcmp(Tcl_GetString(objv[1]), "st_mtime") == 0) { - Tcl_StatBuf *statPtr; - Tcl_SetObjResult(interp, Tcl_NewWideIntObj(sizeof(statPtr->st_mtime))); - return TCL_OK; - } - -syntax: - Tcl_WrongNumArgs(interp, 1, objv, "st_mtime"); - return TCL_ERROR; -} - /* *---------------------------------------------------------------------- * @@ -358,7 +334,7 @@ syntax: static int TestExceptionCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp* interp, /* Tcl interpreter */ int objc, /* Argument count */ Tcl_Obj *const objv[]) /* Argument vector */ @@ -487,7 +463,7 @@ TestplatformChmod( goto done; } - secDesc = (BYTE *)ckalloc(secDescLen); + secDesc = (BYTE *)Tcl_Alloc(secDescLen); if (!GetFileSecurityA(nativePath, infoBits, (PSECURITY_DESCRIPTOR) secDesc, secDescLen, &secDescLen2) || (secDescLen < secDescLen2)) { @@ -499,7 +475,7 @@ TestplatformChmod( * Get the World SID. */ - userSid = (SID *)ckalloc(GetSidLengthRequired((UCHAR) 1)); + userSid = (SID *)Tcl_Alloc(GetSidLengthRequired((UCHAR) 1)); InitializeSid(userSid, &userSidAuthority, (BYTE) 1); *(GetSidSubAuthority(userSid, 0)) = SECURITY_WORLD_RID; @@ -525,7 +501,7 @@ TestplatformChmod( newAclSize = ACLSize.AclBytesInUse + sizeof(ACCESS_DENIED_ACE) + GetLengthSid(userSid) - sizeof(DWORD); - newAcl = (PACL) ckalloc(newAclSize); + newAcl = (PACL) Tcl_Alloc(newAclSize); /* * Initialize the new ACL. @@ -602,16 +578,16 @@ TestplatformChmod( done: if (secDesc) { - ckfree(secDesc); + Tcl_Free(secDesc); } if (newAcl) { - ckfree(newAcl); + Tcl_Free(newAcl); } if (userSid) { - ckfree(userSid); + Tcl_Free(userSid); } if (userDomain) { - ckfree(userDomain); + Tcl_Free(userDomain); } if (res != 0) { @@ -646,7 +622,7 @@ TestplatformChmod( static int TestchmodCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Parameter count */ Tcl_Obj *const * objv) /* Parameter vector */ diff --git a/win/tclWinThrd.c b/win/tclWinThrd.c index b69fbfc..841a854 100644 --- a/win/tclWinThrd.c +++ b/win/tclWinThrd.c @@ -178,7 +178,7 @@ TclWinThreadStart( lpOrigStartAddress = winThreadPtr->lpStartAddress; lpOrigParameter = winThreadPtr->lpParameter; - ckfree(winThreadPtr); + Tcl_Free(winThreadPtr); return lpOrigStartAddress(lpOrigParameter); } @@ -204,14 +204,14 @@ TclpThreadCreate( Tcl_ThreadId *idPtr, /* Return, the ID of the thread. */ Tcl_ThreadCreateProc *proc, /* Main() function of the thread. */ ClientData clientData, /* The one argument to Main(). */ - int stackSize, /* Size of stack for the new thread. */ + size_t stackSize, /* Size of stack for the new thread. */ int flags) /* Flags controlling behaviour of the new * thread. */ { WinThread *winThreadPtr; /* Per-thread startup info */ HANDLE tHandle; - winThreadPtr = (WinThread *)ckalloc(sizeof(WinThread)); + winThreadPtr = (WinThread *)Tcl_Alloc(sizeof(WinThread)); winThreadPtr->lpStartAddress = (LPTHREAD_START_ROUTINE) proc; winThreadPtr->lpParameter = clientData; winThreadPtr->fpControl = _controlfp(0, 0); @@ -568,7 +568,7 @@ Tcl_MutexLock( */ if (*mutexPtr == NULL) { - csPtr = (CRITICAL_SECTION *)ckalloc(sizeof(CRITICAL_SECTION)); + csPtr = (CRITICAL_SECTION *)Tcl_Alloc(sizeof(CRITICAL_SECTION)); InitializeCriticalSection(csPtr); *mutexPtr = (Tcl_Mutex)csPtr; TclRememberMutex(mutexPtr); @@ -629,7 +629,7 @@ TclpFinalizeMutex( if (csPtr != NULL) { DeleteCriticalSection(csPtr); - ckfree(csPtr); + Tcl_Free(csPtr); *mutexPtr = NULL; } } @@ -711,7 +711,7 @@ Tcl_ConditionWait( */ if (*condPtr == NULL) { - winCondPtr = (WinCondition *)ckalloc(sizeof(WinCondition)); + winCondPtr = (WinCondition *)Tcl_Alloc(sizeof(WinCondition)); InitializeCriticalSection(&winCondPtr->condLock); winCondPtr->firstPtr = NULL; winCondPtr->lastPtr = NULL; @@ -922,7 +922,7 @@ TclpFinalizeCondition( if (winCondPtr != NULL) { DeleteCriticalSection(&winCondPtr->condLock); - ckfree(winCondPtr); + Tcl_Free(winCondPtr); *condPtr = NULL; } } @@ -1037,7 +1037,7 @@ TclpThreadCreateKey(void) { DWORD *key; - key = (DWORD *)TclpSysAlloc(sizeof *key, 0); + key = (DWORD *)TclpSysAlloc(sizeof *key); if (key == NULL) { Tcl_Panic("unable to allocate thread key!"); } diff --git a/win/tclWinTime.c b/win/tclWinTime.c index e8401a5..1855c20 100644 --- a/win/tclWinTime.c +++ b/win/tclWinTime.c @@ -12,10 +12,6 @@ #include "tclInt.h" -#define SECSPERDAY (60L * 60L * 24L) -#define SECSPERYEAR (SECSPERDAY * 365L) -#define SECSPER4YEAR (SECSPERYEAR * 4L + SECSPERDAY) - /* * Number of samples over which to estimate the performance counter. */ @@ -23,27 +19,6 @@ #define SAMPLES 64 /* - * The following arrays contain the day of year for the last day of each - * month, where index 1 is January. - */ - -#ifndef TCL_NO_DEPRECATED -static const int normalDays[] = { - -1, 30, 58, 89, 119, 150, 180, 211, 242, 272, 303, 333, 364 -}; - -static const int leapDays[] = { - -1, 30, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365 -}; - -typedef struct { - char tzName[64]; /* Time zone name */ - struct tm tm; /* time information */ -} ThreadSpecificData; -static Tcl_ThreadDataKey dataKey; -#endif /* TCL_NO_DEPRECATED */ - -/* * Data for managing high-resolution timers. */ @@ -133,10 +108,7 @@ static struct { * Declarations for functions defined later in this file. */ -#ifndef TCL_NO_DEPRECATED -static struct tm * ComputeGMT(const time_t *tp); -#endif /* TCL_NO_DEPRECATED */ -static void StopCalibration(ClientData clientData); +static void StopCalibration(void *clientData); static DWORD WINAPI CalibrationThread(LPVOID arg); static void UpdateTimeEachSecond(void); static void ResetCounterSamples(unsigned long long fileTime, @@ -144,10 +116,10 @@ static void ResetCounterSamples(unsigned long long fileTime, static long long AccumulateSample(long long perfCounter, unsigned long long fileTime); static void NativeScaleTime(Tcl_Time* timebuf, - ClientData clientData); + void *clientData); static long long NativeGetMicroseconds(void); static void NativeGetTime(Tcl_Time* timebuf, - ClientData clientData); + void *clientData); /* * TIP #233 (Virtualized Time): Data for the time hooks, if any. @@ -155,7 +127,7 @@ static void NativeGetTime(Tcl_Time* timebuf, Tcl_GetTimeProc *tclGetTimeProcPtr = NativeGetTime; Tcl_ScaleTimeProc *tclScaleTimeProcPtr = NativeScaleTime; -ClientData tclTimeClientData = NULL; +void *tclTimeClientData = NULL; /* * Inlined version of Tcl_GetTime. @@ -191,7 +163,7 @@ IsTimeNative(void) *---------------------------------------------------------------------- */ -unsigned long +unsigned long long TclpGetSeconds(void) { long long usecSincePosixEpoch; @@ -206,7 +178,7 @@ TclpGetSeconds(void) Tcl_Time t; GetTime(&t); - return t.sec; + return (unsigned long long)(unsigned long) t.sec; } } @@ -229,7 +201,7 @@ TclpGetSeconds(void) *---------------------------------------------------------------------- */ -unsigned long +unsigned long long TclpGetClicks(void) { long long usecSincePosixEpoch; @@ -239,7 +211,7 @@ TclpGetClicks(void) */ if (IsTimeNative() && (usecSincePosixEpoch = NativeGetMicroseconds())) { - return (unsigned long) usecSincePosixEpoch; + return (Tcl_WideUInt) usecSincePosixEpoch; } else { /* * Use the Tcl_GetTime abstraction to get the time in microseconds, as @@ -249,7 +221,8 @@ TclpGetClicks(void) Tcl_Time now; /* Current Tcl time */ GetTime(&now); - return ((unsigned long)(now.sec)*1000000UL) + (unsigned long)(now.usec); + return ((unsigned long long)(now.sec)*1000000ULL) + + (unsigned long long)(now.usec); } } @@ -438,7 +411,7 @@ Tcl_GetTime( static void NativeScaleTime( TCL_UNUSED(Tcl_Time *), - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { /* * Native scale is 1:1. Nothing is done. @@ -626,7 +599,6 @@ NativeGetMicroseconds(void) LONGLONG perfCounterLastCall, curCounterFreq; /* Copy with current data of calibration * cycle. */ - LARGE_INTEGER curCounter; /* Current performance counter. */ @@ -681,6 +653,7 @@ NativeGetMicroseconds(void) /* * High resolution timer is not available. */ + return 0; } @@ -704,7 +677,7 @@ NativeGetMicroseconds(void) static void NativeGetTime( Tcl_Time *timePtr, - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { long long usecSincePosixEpoch; @@ -751,7 +724,7 @@ void TclWinResetTimerResolution(void); static void StopCalibration( - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { SetEvent(timeInfo.exitEvent); @@ -768,226 +741,6 @@ StopCalibration( /* *---------------------------------------------------------------------- * - * TclpGetDate -- - * - * This function converts between seconds and struct tm. If useGMT is - * true, then the returned date will be in Greenwich Mean Time (GMT). - * Otherwise, it will be in the local time zone. - * - * Results: - * Returns a static tm structure. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -#ifndef TCL_NO_DEPRECATED -struct tm * -TclpGetDate( - const time_t *t, - int useGMT) -{ - struct tm *tmPtr; - time_t time; -#if defined(_WIN64) || defined(_USE_64BIT_TIME_T) -# define t2 *t /* no need to cripple time to 32-bit */ -#else - time_t t2 = *(__time32_t *) t; -#endif - - if (!useGMT) { -#if defined(_MSC_VER) -# undef timezone /* prevent conflict with timezone() function */ - long timezone = 0; -#endif - - tzset(); - - /* - * If we are in the valid range, let the C run-time library handle it. - * Otherwise we need to fake it. Note that this algorithm ignores - * daylight savings time before the epoch. - */ - - if (t2 >= 0) { - return TclpLocaltime(&t2); - } - -#if defined(_MSC_VER) - _get_timezone(&timezone); -#endif - - time = t2 - timezone; - - /* - * If we aren't near to overflowing the long, just add the bias and - * use the normal calculation. Otherwise we will need to adjust the - * result at the end. - */ - - if (t2 < (LONG_MAX - 2*SECSPERDAY) && t2 > (LONG_MIN + 2*SECSPERDAY)) { - tmPtr = ComputeGMT(&time); - } else { - tmPtr = ComputeGMT(&t2); - - tzset(); - - /* - * Add the bias directly to the tm structure to avoid overflow. - * Propagate seconds overflow into minutes, hours and days. - */ - - time = tmPtr->tm_sec - timezone; - tmPtr->tm_sec = (int)(time % 60); - if (tmPtr->tm_sec < 0) { - tmPtr->tm_sec += 60; - time -= 60; - } - - time = tmPtr->tm_min + time / 60; - tmPtr->tm_min = (int)(time % 60); - if (tmPtr->tm_min < 0) { - tmPtr->tm_min += 60; - time -= 60; - } - - time = tmPtr->tm_hour + time / 60; - tmPtr->tm_hour = (int)(time % 24); - if (tmPtr->tm_hour < 0) { - tmPtr->tm_hour += 24; - time -= 24; - } - - time /= 24; - tmPtr->tm_mday += (int) time; - tmPtr->tm_yday += (int) time; - tmPtr->tm_wday = (tmPtr->tm_wday + (int) time) % 7; - } - } else { - tmPtr = ComputeGMT(&t2); - } - return tmPtr; -} - -/* - *---------------------------------------------------------------------- - * - * ComputeGMT -- - * - * This function computes GMT given the number of seconds since the epoch - * (midnight Jan 1 1970). - * - * Results: - * Returns a (per thread) statically allocated struct tm. - * - * Side effects: - * Updates the values of the static struct tm. - * - *---------------------------------------------------------------------- - */ - -static struct tm * -ComputeGMT( - const time_t *tp) -{ - struct tm *tmPtr; - long tmp, rem; - int isLeap; - const int *days; - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - - tmPtr = &tsdPtr->tm; - - /* - * Compute the 4 year span containing the specified time. - */ - - tmp = (long) (*tp / SECSPER4YEAR); - rem = (long) (*tp % SECSPER4YEAR); - - /* - * Correct for weird mod semantics so the remainder is always positive. - */ - - if (rem < 0) { - tmp--; - rem += SECSPER4YEAR; - } - - /* - * Compute the year after 1900 by taking the 4 year span and adjusting for - * the remainder. This works because 2000 is a leap year, and 1900/2100 - * are out of the range. - */ - - tmp = (tmp * 4) + 70; - isLeap = 0; - if (rem >= SECSPERYEAR) { /* 1971, etc. */ - tmp++; - rem -= SECSPERYEAR; - if (rem >= SECSPERYEAR) { /* 1972, etc. */ - tmp++; - rem -= SECSPERYEAR; - if (rem >= SECSPERYEAR + SECSPERDAY) { /* 1973, etc. */ - tmp++; - rem -= SECSPERYEAR + SECSPERDAY; - } else { - isLeap = 1; - } - } - } - tmPtr->tm_year = tmp; - - /* - * Compute the day of year and leave the seconds in the current day in the - * remainder. - */ - - tmPtr->tm_yday = rem / SECSPERDAY; - rem %= SECSPERDAY; - - /* - * Compute the time of day. - */ - - tmPtr->tm_hour = rem / 3600; - rem %= 3600; - tmPtr->tm_min = rem / 60; - tmPtr->tm_sec = rem % 60; - - /* - * Compute the month and day of month. - */ - - days = (isLeap) ? leapDays : normalDays; - for (tmp = 1; days[tmp] < tmPtr->tm_yday; tmp++) { - /* empty body */ - } - tmPtr->tm_mon = --tmp; - tmPtr->tm_mday = tmPtr->tm_yday - days[tmp]; - - /* - * Compute day of week. Epoch started on a Thursday. - */ - - tmPtr->tm_wday = (long) (*tp / SECSPERDAY) + 4; - if ((*tp % SECSPERDAY) < 0) { - tmPtr->tm_wday--; - } - tmPtr->tm_wday %= 7; - if (tmPtr->tm_wday < 0) { - tmPtr->tm_wday += 7; - } - - return tmPtr; -} -#endif /* TCL_NO_DEPRECATED */ - -/* - *---------------------------------------------------------------------- - * * CalibrationThread -- * * Thread that manages calibration of the hi-resolution time derived from @@ -1253,6 +1006,7 @@ UpdateTimeEachSecond(void) * First adjust with a micro jump (short frozen time is * acceptable). */ + vt0 += nt0 - nt1; /* @@ -1426,77 +1180,6 @@ AccumulateSample( /* *---------------------------------------------------------------------- * - * TclpGmtime -- - * - * Wrapper around the 'gmtime' library function to make it thread safe. - * - * Results: - * Returns a pointer to a 'struct tm' in thread-specific data. - * - * Side effects: - * Invokes gmtime or gmtime_r as appropriate. - * - *---------------------------------------------------------------------- - */ - -#ifndef TCL_NO_DEPRECATED -struct tm * -TclpGmtime( - const time_t *timePtr) /* Pointer to the number of seconds since the - * local system's epoch */ -{ - /* - * The MS implementation of gmtime is thread safe because it returns the - * time in a block of thread-local storage, and Windows does not provide a - * Posix gmtime_r function. - */ - -#if defined(_WIN64) || defined(_USE_64BIT_TIME_T) - return gmtime(timePtr); -#else - return _gmtime32((const __time32_t *) timePtr); -#endif /* _WIN64 || _USE_64BIT_TIME_T */ -} - -/* - *---------------------------------------------------------------------- - * - * TclpLocaltime -- - * - * Wrapper around the 'localtime' library function to make it thread - * safe. - * - * Results: - * Returns a pointer to a 'struct tm' in thread-specific data. - * - * Side effects: - * Invokes localtime or localtime_r as appropriate. - * - *---------------------------------------------------------------------- - */ - -struct tm * -TclpLocaltime( - const time_t *timePtr) /* Pointer to the number of seconds since the - * local system's epoch */ -{ - /* - * The MS implementation of localtime is thread safe because it returns - * the time in a block of thread-local storage, and Windows does not - * provide a Posix localtime_r function. - */ - -#if defined(_WIN64) || defined(_USE_64BIT_TIME_T) - return localtime(timePtr); -#else - return _localtime32((const __time32_t *) timePtr); -#endif /* _WIN64 || _USE_64BIT_TIME_T */ -} -#endif /* TCL_NO_DEPRECATED */ - -/* - *---------------------------------------------------------------------- - * * Tcl_SetTimeProc -- * * TIP #233 (Virtualized Time): Registers two handlers for the @@ -1515,7 +1198,7 @@ void Tcl_SetTimeProc( Tcl_GetTimeProc *getProc, Tcl_ScaleTimeProc *scaleProc, - ClientData clientData) + void *clientData) { tclGetTimeProcPtr = getProc; tclScaleTimeProcPtr = scaleProc; @@ -1542,7 +1225,7 @@ void Tcl_QueryTimeProc( Tcl_GetTimeProc **getProc, Tcl_ScaleTimeProc **scaleProc, - ClientData *clientData) + void **clientData) { if (getProc) { *getProc = tclGetTimeProcPtr; |