diff options
310 files changed, 7996 insertions, 17971 deletions
@@ -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 6438d66..a7c1d2f 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 @@ -91,13 +91,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 @@ -232,15 +225,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=utfmax' '-f' makefile.vc all tcltest - - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=utfmax' '-f' makefile.vc test - name: "Windows/MSVC/Shared: NO_DEPRECATED" os: windows compiler: cl @@ -296,15 +280,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=utfmax' '-f' makefile.vc all tcltest - - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'OPTS=utfmax' '-f' makefile.vc test - name: "Windows/MSVC-x86/Shared: NO_DEPRECATED" os: windows compiler: cl @@ -353,12 +328,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 @@ -404,12 +379,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 @@ -1,11 +1,11 @@ # README: Tcl -This is the **Tcl 8.7a4** source distribution. +This is the **Tcl 9.0a2** source distribution. You can get any source release of Tcl from [our distribution site](https://sourceforge.net/projects/tcl/files/Tcl/). -[](https://travis-ci.org/tcltk/tcl) +[](https://travis-ci.org/tcltk/tcl) ## Contents 1. [Introduction](#intro) @@ -43,7 +43,7 @@ and selling it either in whole or in part. See the file ## <a id="doc">2.</a> Documentation Extensive documentation is available at our website. The home page for this release, including new features, is -[here](https://www.tcl.tk/software/tcltk/8.7.html). +[here](https://www.tcl.tk/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. @@ -53,8 +53,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 @@ -9120,3 +9120,23 @@ in this changeset (new minor version) rather than bug fixes: 2019-09-14 [TIP 548] wchar_t conversion functions - Released 8.7a3, Nov 21, 2019 --- http://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 --- http://core.tcl-lang.org/tcl/ for details - 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 5b0fe5a..e250127 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) @@ -60,10 +58,10 @@ unless \fIlength\fR is negative. .AP Tcl_Obj *objPtr in A message to be appended to the \fB\-errorinfo\fR return option in the form of a Tcl_Obj value. -.AP 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 char *element in @@ -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 8f25c52..849f65e 100644 --- a/doc/Alloc.3 +++ b/doc/Alloc.3 @@ -8,7 +8,7 @@ .so man.macros .BS .SH NAME -Tcl_Alloc, Tcl_Free, Tcl_Realloc, Tcl_AttemptAlloc, Tcl_AttemptRealloc, ckalloc, ckfree, ckrealloc, attemptckalloc, attemptckrealloc \- allocate or free heap memory +Tcl_Alloc, Tcl_Free, Tcl_Realloc, Tcl_AttemptAlloc, Tcl_AttemptRealloc \- allocate or free heap memory .SH SYNOPSIS .nf \fB#include <tcl.h>\fR @@ -19,29 +19,14 @@ 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 -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 @@ -79,14 +64,10 @@ 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. .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 347ba3d..62f450e 100644 --- a/doc/Async.3 +++ b/doc/Async.3 @@ -30,7 +30,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. @@ -84,7 +84,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 0805f8e..0000000 --- a/doc/Backslash.3 +++ /dev/null @@ -1,47 +0,0 @@ -'\" -'\" Copyright (c) 1989-1993 The Regents of the University of California. -'\" Copyright (c) 1994-1996 Sun Microsystems, Inc. -'\" -'\" See the file "license.terms" for information on usage and redistribution -'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" -.TH Tcl_Backslash 3 "8.1" Tcl "Tcl Library Procedures" -.so man.macros -.BS -.SH NAME -Tcl_Backslash \- parse a backslash sequence -.SH SYNOPSIS -.nf -\fB#include <tcl.h>\fR -.sp -char -\fBTcl_Backslash\fR(\fIsrc, countPtr\fR) -.SH ARGUMENTS -.AS char *countPtr out -.AP char *src in -Pointer to a string starting with a backslash. -.AP int *countPtr out -If \fIcountPtr\fR is not NULL, \fI*countPtr\fR gets filled -in with number of characters in the backslash sequence, including -the backslash character. -.BE - -.SH DESCRIPTION -.PP -The use of \fBTcl_Backslash\fR is deprecated in favor of -\fBTcl_UtfBackslash\fR. -.PP -This is a utility procedure provided for backwards compatibility with -non-internationalized Tcl extensions. It parses a backslash sequence and -returns the low byte of the Unicode character corresponding to the sequence. -\fBTcl_Backslash\fR modifies \fI*countPtr\fR to contain the number of -characters in the backslash sequence. -.PP -See the Tcl manual entry for information on the valid backslash sequences. -All of the sequences described in the Tcl manual entry are supported by -\fBTcl_Backslash\fR. -.SH "SEE ALSO" -Tcl(n), Tcl_UtfBackslash(3) - -.SH KEYWORDS -backslash, parse diff --git a/doc/ByteArrObj.3 b/doc/ByteArrObj.3 index ff0b4e1..d6947eb 100644 --- a/doc/ByteArrObj.3 +++ b/doc/ByteArrObj.3 @@ -29,8 +29,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 \fIlength\fR is non-zero. -.AP int length in -The length of the array of bytes. It must be >= 0. +.AP size_t length in +The length of the array of bytes. .AP Tcl_Obj *objPtr in/out For \fBTcl_SetByteArrayObj\fR, this points to the value to be converted to byte-array type. For \fBTcl_GetByteArrayFromObj\fR and 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 847707e..def0f2a 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 57203d5..12658ce 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) @@ -56,7 +56,7 @@ Tcl_ObjectMapMethodNameProc .sp \fBTcl_ObjectSetMethodNameMapper\fR(\fIobject\fR, \fImethodNameMapper\fR) .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. @@ -85,7 +85,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 @@ -185,7 +185,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 @@ -198,8 +198,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/CrtAlias.3 b/doc/CrtAlias.3 index 92f9b0c..4888b61 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_MakeSafe, 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 @@ -23,18 +23,9 @@ 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 @@ -142,8 +133,6 @@ 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), @@ -165,14 +154,10 @@ may be a better choice, since it creates interpreters in a known-safe state. \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 929b1b8..9edb782 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 * @@ -75,9 +75,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 @@ -87,9 +84,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 @@ -128,7 +122,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 @@ -139,7 +133,7 @@ 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 @@ -286,16 +280,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 @@ -315,10 +306,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; @@ -347,9 +338,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, @@ -372,25 +362,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 @@ -399,7 +373,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 @@ -426,22 +400,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 @@ -450,35 +425,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 @@ -487,7 +447,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); @@ -531,7 +491,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); @@ -561,17 +521,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 Tcl_WideInt \fBTcl_DriverWideSeekProc\fR( + void *\fIinstanceData\fR, + Tcl_WideInt \fIoffset\fR, int \fIseekMode\fR, int *\fIerrorCodePtr\fR); .CE @@ -590,30 +550,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 Tcl_WideInt \fBTcl_DriverWideSeekProc\fR( - ClientData \fIinstanceData\fR, - Tcl_WideInt \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 @@ -622,7 +560,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); @@ -663,7 +601,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); @@ -701,7 +639,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 @@ -732,9 +670,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 @@ -761,7 +699,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 @@ -776,7 +714,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 @@ -805,7 +743,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 @@ -822,7 +760,7 @@ length. It can be NULL. .PP .CS typedef int \fBTcl_DriverTruncateProc\fR( - ClientData \fIinstanceData\fR, + void *\fIinstanceData\fR, Tcl_WideInt \fIlength\fR); .CE .PP @@ -870,58 +808,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..c9f4efe 100644 --- a/doc/CrtChnlHdlr.3 +++ b/doc/CrtChnlHdlr.3 @@ -32,7 +32,7 @@ a zero value to temporarily disable an existing handler. .AP Tcl_FileProc *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 acceb5b..0000000 --- a/doc/CrtMathFnc.3 +++ /dev/null @@ -1,162 +0,0 @@ -'\" -'\" Copyright (c) 1989-1993 The Regents of the University of California. -'\" Copyright (c) 1994-1996 Sun Microsystems, Inc. -'\" -'\" See the file "license.terms" for information on usage and redistribution -'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" -.TH Tcl_CreateMathFunc 3 8.4 Tcl "Tcl Library Procedures" -.so man.macros -.BS -.SH NAME -Tcl_CreateMathFunc, Tcl_GetMathFuncInfo, Tcl_ListMathFuncs \- Define, query and enumerate math functions for expressions -.SH "NOTICE OF EVENTUAL DEPRECATION" -.PP -The \fBTcl_CreateMathFunc\fR and \fBTcl_GetMathFuncInfo\fR functions -are rendered somewhat obsolete by the ability to create functions for -expressions by placing commands in the \fBtcl::mathfunc\fR namespace, -as described in the \fBmathfunc\fR manual page; the API described on -this page is not expected to be maintained indefinitely. -.SH SYNOPSIS -.nf -\fB#include <tcl.h>\fR -.sp -void -\fBTcl_CreateMathFunc\fR(\fIinterp, name, numArgs, argTypes, proc, clientData\fR) -.sp -int -\fBTcl_GetMathFuncInfo\fR(\fIinterp, name, numArgsPtr, argTypesPtr, procPtr, - clientDataPtr\fR) -.sp -Tcl_Obj * -\fBTcl_ListMathFuncs\fR(\fIinterp, pattern\fR) -.SH ARGUMENTS -.AS Tcl_ValueType *clientDataPtr out -.AP Tcl_Interp *interp in -Interpreter in which new function will be defined. -.AP "const char" *name in -Name for new function. -.AP int numArgs in -Number of arguments to new function; also gives size of \fIargTypes\fR array. -.AP Tcl_ValueType *argTypes in -Points to an array giving the permissible types for each argument to -function. -.AP Tcl_MathProc *proc in -Procedure that implements the function. -.AP ClientData clientData in -Arbitrary one-word value to pass to \fIproc\fR when it is invoked. -.AP int *numArgsPtr out -Points to a variable that will be set to contain the number of -arguments to the function. -.AP Tcl_ValueType **argTypesPtr out -Points to a variable that will be set to contain a pointer to an array -giving the permissible types for each argument to the function which -will need to be freed up using \fITcl_Free\fR. -.AP Tcl_MathProc **procPtr out -Points to a variable that will be set to contain a pointer to the -implementation code for the function (or NULL if the function is -implemented directly in bytecode). -.AP ClientData *clientDataPtr out -Points to a variable that will be set to contain the clientData -argument passed to \fITcl_CreateMathFunc\fR when the function was -created if the function is not implemented directly in bytecode. -.AP "const char" *pattern in -Pattern to match against function names so as to filter them (by -passing to \fITcl_StringMatch\fR), or NULL to not apply any filter. -.BE -.SH DESCRIPTION -.PP -Tcl allows a number of mathematical functions to be used in -expressions, such as \fBsin\fR, \fBcos\fR, and \fBhypot\fR. -These functions are represented by commands in the namespace, -\fBtcl::mathfunc\fR. The \fBTcl_CreateMathFunc\fR function is -an obsolete way for applications to add additional functions -to those already provided by Tcl or to replace existing functions. -It should not be used by new applications, which should create -math functions using \fBTcl_CreateObjCommand\fR to create a command -in the \fBtcl::mathfunc\fR namespace. -.PP -In the \fBTcl_CreateMathFunc\fR interface, -\fIName\fR is the name of the function as it will appear in expressions. -If \fIname\fR does not already exist in the \fB::tcl::mathfunc\fR -namespace, then a new command is created in that namespace. -If \fIname\fR does exist, then the existing function is replaced. -\fINumArgs\fR and \fIargTypes\fR describe the arguments to the function. -Each entry in the \fIargTypes\fR array must be -one of \fBTCL_INT\fR, \fBTCL_DOUBLE\fR, \fBTCL_WIDE_INT\fR, -or \fBTCL_EITHER\fR to indicate whether the corresponding argument must be an -integer, a double-precision floating value, a wide (64-bit) integer, -or any, respectively. -.PP -Whenever the function is invoked in an expression Tcl will invoke -\fIproc\fR. \fIProc\fR should have arguments and result that match -the type \fBTcl_MathProc\fR: -.PP -.CS -typedef int \fBTcl_MathProc\fR( - ClientData \fIclientData\fR, - Tcl_Interp *\fIinterp\fR, - Tcl_Value *\fIargs\fR, - Tcl_Value *\fIresultPtr\fR); -.CE -.PP -When \fIproc\fR is invoked the \fIclientData\fR and \fIinterp\fR -arguments will be the same as those passed to \fBTcl_CreateMathFunc\fR. -\fIArgs\fR will point to an array of \fInumArgs\fR Tcl_Value structures, -which describe the actual arguments to the function: -.PP -.CS -typedef struct Tcl_Value { - Tcl_ValueType \fItype\fR; - long \fIintValue\fR; - double \fIdoubleValue\fR; - Tcl_WideInt \fIwideValue\fR; -} \fBTcl_Value\fR; -.CE -.PP -The \fItype\fR field indicates the type of the argument and is -one of \fBTCL_INT\fR, \fBTCL_DOUBLE\fR or \fBTCL_WIDE_INT\fR. -It will match the \fIargTypes\fR value specified for the function unless -the \fIargTypes\fR value was \fBTCL_EITHER\fR. Tcl converts -the argument supplied in the expression to the type requested in -\fIargTypes\fR, if that is necessary. -Depending on the value of the \fItype\fR field, the \fIintValue\fR, -\fIdoubleValue\fR or \fIwideValue\fR -field will contain the actual value of the argument. -.PP -\fIProc\fR should compute its result and store it either as an integer -in \fIresultPtr->intValue\fR or as a floating value in -\fIresultPtr->doubleValue\fR. -It should set also \fIresultPtr->type\fR to one of -\fBTCL_INT\fR, \fBTCL_DOUBLE\fR or \fBTCL_WIDE_INT\fR -to indicate which value was set. -Under normal circumstances \fIproc\fR should return \fBTCL_OK\fR. -If an error occurs while executing the function, \fIproc\fR should -return \fBTCL_ERROR\fR and leave an error message in the interpreter's result. -.PP -\fBTcl_GetMathFuncInfo\fR retrieves the values associated with -function \fIname\fR that were passed to a preceding -\fBTcl_CreateMathFunc\fR call. Normally, the return code is -\fBTCL_OK\fR but if the named function does not exist, \fBTCL_ERROR\fR -is returned and an error message is placed in the interpreter's -result. -.PP -If an error did not occur, the array reference placed in the variable -pointed to by \fIargTypesPtr\fR is newly allocated, and should be -released by passing it to \fBTcl_Free\fR. Some functions (the -standard set implemented in the core, and those defined by placing -commands in the \fBtcl::mathfunc\fR namespace) do not have -argument type information; attempting to retrieve values for -them causes a NULL to be stored in the variable pointed to by -\fIprocPtr\fR and the variable pointed to by \fIclientDataPtr\fR -will not be modified. The variable pointed to by \fInumArgsPointer\fR -will contain -1, and no argument types will be stored in the variable -pointed to by \fIargTypesPointer\fR. -.PP -\fBTcl_ListMathFuncs\fR returns a Tcl value containing a list of all -the math functions defined in the interpreter whose name matches -\fIpattern\fR. The returned value has a reference count of zero. -.SH "SEE ALSO" -expr(n), info(n), Tcl_CreateObjCommand(3), Tcl_Free(3), Tcl_NewListObj(3) -.SH KEYWORDS -expression, mathematical function diff --git a/doc/CrtObjCmd.3 b/doc/CrtObjCmd.3 index 2cd9222..746faba 100644 --- a/doc/CrtObjCmd.3 +++ b/doc/CrtObjCmd.3 @@ -59,7 +59,7 @@ Name of command. .AP Tcl_ObjCmdProc *proc in Implementation of the new command: \fIproc\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; @@ -102,7 +102,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[]); @@ -175,7 +175,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 @@ -217,11 +217,11 @@ A \fBTcl_CmdInfo\fR structure has the following fields: typedef struct Tcl_CmdInfo { 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; } \fBTcl_CmdInfo\fR; .CE @@ -247,7 +247,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. @@ -261,7 +261,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. @@ -277,9 +277,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 d5353ac..fbce7e1 100644 --- a/doc/CrtTrace.3 +++ b/doc/CrtTrace.3 @@ -41,7 +41,7 @@ details of the calling sequence. .AP Tcl_CmdTraceProc *proc in Procedure to call for each command that is executed. See below for details on the calling sequence. -.AP ClientData clientData in +.AP void *clientData in Arbitrary one-word value to pass to \fIobjProc\fR or \fIproc\fR. .AP Tcl_CmdObjTraceDeleteProc *deleteProc in Procedure to call when the trace is deleted. See below for details of @@ -66,7 +66,7 @@ interpreter. .PP .CS typedef int \fBTcl_CmdObjTraceProc\fR( - \fBClientData\fR \fIclientData\fR, + \fBvoid *\fR \fIclientData\fR, \fBTcl_Interp\fR* \fIinterp\fR, int \fIlevel\fR, const char *\fIcommand\fR, @@ -77,7 +77,7 @@ typedef int \fBTcl_CmdObjTraceProc\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 @@ -144,7 +144,7 @@ When \fBTcl_DeleteTrace\fR is called, the interpreter invokes the .PP .CS typedef void \fBTcl_CmdObjTraceDeleteProc\fR( - \fBClientData\fR \fIclientData\fR); + \fBvoid *\fR \fIclientData\fR); .CE .PP The \fIclientData\fR parameter will be the same as the @@ -160,12 +160,12 @@ match the type \fBTcl_CmdTraceProc\fR: .PP .CS typedef void \fBTcl_CmdTraceProc\fR( - ClientData \fIclientData\fR, + void *\fIclientData\fR, Tcl_Interp *\fIinterp\fR, int \fIlevel\fR, char *\fIcommand\fR, Tcl_CmdProc *\fIcmdProc\fR, - ClientData \fIcmdClientData\fR, + void *\fIcmdClientData\fR, int \fIargc\fR, const char *\fIargv\fR[]); .CE diff --git a/doc/DString.3 b/doc/DString.3 index 00f1b8a..cbce13f 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) @@ -49,10 +47,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 @@ -128,10 +126,6 @@ caller to fill in the new space. even if the string is truncated to zero length, so \fBTcl_DStringFree\fR will still need to be called. .PP -\fBTcl_DStringTrunc\fR changes the length of a dynamic string. -This procedure is now deprecated. \fBTcl_DStringSetLength\fR should -be used instead. -.PP \fBTcl_DStringFree\fR should be called when you are finished using the string. It frees up any memory that was allocated for the string and reinitializes the string's value to an empty string. diff --git a/doc/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 43333da..ab75ad2 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 2d2461e..497683d 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 @@ -36,12 +36,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 @@ -62,12 +56,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 @@ -85,11 +73,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 @@ -255,18 +243,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 @@ -293,7 +269,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 @@ -320,7 +296,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 @@ -351,7 +327,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, @@ -383,7 +359,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 @@ -408,15 +384,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 @@ -67,9 +64,6 @@ first null byte are used. Points to first byte of script to execute (null-terminated and UTF-8). .AP char *part in String forming part of a Tcl script. -.AP va_list argList in -An argument list which must have been initialized using -\fBva_start\fR, and cleared using \fBva_end\fR. .BE .SH DESCRIPTION @@ -128,16 +122,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 @@ -153,11 +141,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 4e77114..eb388a2 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 * @@ -208,7 +208,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 @@ -245,7 +245,7 @@ Name of a procedure to look up in the file's symbol table Filled with the init function for this code. .AP Tcl_PackageInitProc **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 @@ -716,7 +716,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 @@ -783,7 +783,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 @@ -831,7 +831,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 @@ -1008,7 +1008,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 @@ -1018,8 +1018,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 @@ -1028,7 +1028,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 @@ -1039,7 +1039,7 @@ representation is the normalized path. .PP .CS typedef Tcl_Obj *\fBTcl_FSInternalToNormalizedProc\fR( - ClientData \fIclientData\fR); + void *\fIclientData\fR); .CE .SS CREATEINTERNALREPPROC .PP @@ -1050,7 +1050,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 149ef8a..a1dd20d 100644 --- a/doc/FindExec.3 +++ b/doc/FindExec.3 @@ -59,7 +59,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 eba549d..5562e28 100644 --- a/doc/GetInt.3 +++ b/doc/GetInt.3 @@ -64,12 +64,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 9f96be5..4bb3759 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 @@ -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. 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 3c138a4..7551145 100644 --- a/doc/InitSubSyst.3 +++ b/doc/InitSubSyst.3 @@ -23,9 +23,9 @@ first thing in the application's main program. .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 unicode 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/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..4842c05 100644 --- a/doc/Limit.3 +++ b/doc/Limit.3 @@ -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 92e7d03..de37938 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" @@ -265,7 +265,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/Method.3 b/doc/Method.3 index 9e636a1..41e190d 100644 --- a/doc/Method.3 +++ b/doc/Method.3 @@ -61,7 +61,7 @@ Tcl_Object int \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. @@ -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 @@ -49,7 +49,7 @@ in the same way as the \fIproc\fR argument to \fBTcl_CreateObjCommand\fR(3) (\fIq.v.\fR). .AP Tcl_ObjCmdProc *nreProc in Called instead of \fIproc\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 @@ -72,10 +72,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 @@ -130,7 +130,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 @@ -146,7 +146,7 @@ stack, to evalute a script: .CS int \fITheCmdOldObjProc\fR( - ClientData clientData, + void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) @@ -177,7 +177,7 @@ call \fITheCmdNRObjProc\fR: .CS int \fITheCmdOldObjProc\fR( - ClientData clientData, + void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) @@ -190,7 +190,7 @@ int .CS int \fITheCmdNRObjProc\fR - ClientData clientData, + void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) @@ -211,7 +211,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 a037442..c69d547 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 ec9f910..1899032 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 Tcl_QueuePosition position in Where to add the new event in the queue: \fBTCL_QUEUE_TAIL\fR, \fBTCL_QUEUE_HEAD\fR, or \fBTCL_QUEUE_MARK\fR. @@ -225,7 +225,7 @@ the event source. .PP .CS typedef void \fBTcl_EventSetupProc\fR( - ClientData \fIclientData\fR, + void *\fIclientData\fR, int \fIflags\fR); .CE .PP @@ -303,7 +303,7 @@ following prototype: .PP .CS typedef void \fBTcl_EventCheckProc\fR( - ClientData \fIclientData\fR, + void *\fIclientData\fR, int \fIflags\fR); .CE .PP @@ -394,7 +394,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 @@ -419,7 +419,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 eadd041..117e631 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 67f5174..fb76ef7 100644 --- a/doc/ObjectType.3 +++ b/doc/ObjectType.3 @@ -184,8 +184,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, diff --git a/doc/OpenFileChnl.3 b/doc/OpenFileChnl.3 index 82851da..d48a35c 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 @@ -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 Tcl_WideInt offset in diff --git a/doc/OpenTcp.3 b/doc/OpenTcp.3 index 5b941dc..fbaa04f 100644 --- a/doc/OpenTcp.3 +++ b/doc/OpenTcp.3 @@ -50,12 +50,12 @@ If nonzero, the client socket is connected asynchronously to the server. .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 @@ -127,7 +127,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 53b84da..fa45a30 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 @@ -16,9 +16,6 @@ void \fBTcl_Panic\fR(\fIformat\fR, \fIarg\fR, \fIarg\fR, \fI...\fR) .sp void -\fBTcl_PanicVA\fR(\fIformat\fR, \fIargList\fR) -.sp -void \fBTcl_SetPanicProc\fR(\fIpanicProc\fR) .sp void @@ -86,8 +83,8 @@ 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 safely by stub-enabled extensions, so its +symbol is not included in the stub table. .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 @@ -95,10 +92,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 def55de..30a1dd2 100644 --- a/doc/ParseArgs.3 +++ b/doc/ParseArgs.3 @@ -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 40a0818..9da0d42 100644 --- a/doc/ParseCmd.3 +++ b/doc/ParseCmd.3 @@ -8,7 +8,7 @@ .so man.macros .BS .SH NAME -Tcl_ParseCommand, Tcl_ParseExpr, Tcl_ParseBraces, Tcl_ParseQuotedString, Tcl_ParseVarName, Tcl_ParseVar, Tcl_FreeParse, Tcl_EvalTokens, Tcl_EvalTokensStandard \- parse Tcl scripts and expressions +Tcl_ParseCommand, Tcl_ParseExpr, Tcl_ParseBraces, Tcl_ParseQuotedString, Tcl_ParseVarName, Tcl_ParseVar, Tcl_FreeParse, Tcl_EvalTokensStandard \- parse Tcl scripts and expressions .SH SYNOPSIS .nf \fB#include <tcl.h>\fR @@ -33,20 +33,16 @@ const char * .sp \fBTcl_FreeParse\fR(\fIusedParsePtr\fR) .sp -Tcl_Obj * -\fBTcl_EvalTokens\fR(\fIinterp, tokenPtr, numTokens\fR) -.sp int \fBTcl_EvalTokensStandard\fR(\fIinterp, tokenPtr, numTokens\fR) .SH ARGUMENTS .AS Tcl_Interp *usedParsePtr out .AP Tcl_Interp *interp out -For procedures other than \fBTcl_FreeParse\fR, \fBTcl_EvalTokens\fR -and \fBTcl_EvalTokensStandard\fR, used only for error reporting; +For procedures other than \fBTcl_FreeParse\fR and +\fBTcl_EvalTokensStandard\fR, used only for error reporting; if NULL, then no error messages are left after errors. -For \fBTcl_EvalTokens\fR and \fBTcl_EvalTokensStandard\fR, -determines the context for evaluating the -script and also is used for error reporting; must not be NULL. +For \fBTcl_EvalTokensStandard\fR, determines the context for evaluating +the script and also is used for error reporting; must not be NULL. .AP "const char" *start in Pointer to first character in string to parse. .AP int numBytes in @@ -191,16 +187,6 @@ code with one of the values \fBTCL_OK\fR, \fBTCL_ERROR\fR, some other integer value originating in an extension. In addition, a result value or error message is left in \fIinterp\fR's result; it can be retrieved using \fBTcl_GetObjResult\fR. -.PP -\fBTcl_EvalTokens\fR differs from \fBTcl_EvalTokensStandard\fR only in -the return convention used: it returns the result in a new Tcl_Obj. -The reference count of the value returned as result has been -incremented, so the caller must -invoke \fBTcl_DecrRefCount\fR when it is finished with the value. -If an error or other exception occurs while evaluating the tokens -(such as a reference to a non-existent variable) then the return value -is NULL and an error message is left in \fIinterp\fR's result. The use -of \fBTcl_EvalTokens\fR is deprecated. .SH "TCL_PARSE STRUCTURE" .PP \fBTcl_ParseCommand\fR, \fBTcl_ParseExpr\fR, \fBTcl_ParseBraces\fR, @@ -222,8 +208,8 @@ typedef struct Tcl_Parse { 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 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 f9550a2..1d77c12 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 aa757bc..95716e9 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/SetChanErr.3 b/doc/SetChanErr.3 index 5bb86be..e73c38f 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..41c2a0a 100644 --- a/doc/SetRecLmt.3 +++ b/doc/SetRecLmt.3 @@ -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 1622290..1355d6b 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 d19ca14..4b0eee6 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 @@ -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 diff --git a/doc/StaticPkg.3 b/doc/StaticPkg.3 index b22edcc..a28652e 100644 --- a/doc/StaticPkg.3 +++ b/doc/StaticPkg.3 @@ -65,8 +65,8 @@ error message. The result or error from the initialization procedure will be returned as the result of the \fBload\fR command that caused the initialization procedure to be invoked. .PP -\fBTcl_StaticPackage\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_StaticPackage\fR can not be safely used by stub-enabled extensions, +so its symbol is not included in the stub table. .SH KEYWORDS initialization procedure, package, static linking .SH "SEE ALSO" diff --git a/doc/StringObj.3 b/doc/StringObj.3 index 2b665cc..33c5c79 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 @@ -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,29 +87,29 @@ 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 TCL_INDEX_NONE. (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 TCL_INDEX_NONE, 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 +.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 TCL_INDEX_NONE, 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. -.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. .AP Tcl_Obj *objPtr in/out @@ -127,7 +124,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. @@ -140,7 +137,7 @@ Format control string including % conversion specifiers. 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 @@ -247,12 +244,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 diff --git a/doc/TCL_MEM_DEBUG.3 b/doc/TCL_MEM_DEBUG.3 index 3a014d4..38489a3 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 4a5df89..6d9179d 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/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/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 82aa7b8..dd72563 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, char *\fIname1\fR, char *\fIname2\fR, @@ -134,7 +134,7 @@ 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 @@ -308,7 +308,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 +333,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 @@ -49,19 +49,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) @@ -87,7 +87,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 @@ -126,18 +126,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 +.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, @@ -205,7 +203,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 @@ -219,7 +217,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 @@ -285,17 +283,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/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 diff --git a/doc/define.n b/doc/define.n index 9046203..4175efc 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 @@ -95,8 +95,6 @@ first two characters are \fB0d\fR), binary (the first two characters are \fB0b\fR), octal (the first two characters are \fB0o\fR), or hexadecimal (the first two characters are \fB0x\fR) form. 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. .PP \fBFloating-point value\fR .PP diff --git a/doc/interp.n b/doc/interp.n index 2943404..63d8fc5 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 @@ -154,7 +154,7 @@ The following is a minimal extension: .CS #include <tcl.h> #include <stdio.h> -static int fooCmd(ClientData clientData, +static int fooCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { printf("called with %d arguments\en", objc); return TCL_OK; diff --git a/doc/lsearch.n b/doc/lsearch.n index c5dc98f..72c91dc 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 375d867..9b14587 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 c8cdb21..5e1566a 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 8d732ed..43c8417 100644 --- a/doc/re_syntax.n +++ b/doc/re_syntax.n @@ -375,7 +375,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/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/generic/regc_lex.c b/generic/regc_lex.c index a303ec6..0cd7dd6 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 c90dd64..182428d 100644 --- a/generic/regc_locale.c +++ b/generic/regc_locale.c @@ -805,8 +805,6 @@ static const chr graphCharTable[] = { /* * End of auto-generated Unicode character ranges declarations. */ - -#define CH NOCELT /* - element - map collating-element name to celt @@ -899,9 +897,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); } @@ -950,11 +948,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; } @@ -968,7 +966,7 @@ eclass( } cv = getcvec(v, 1, 0); assert(cv != NULL); - addchr(cv, (chr)c); + addchr(cv, c); return cv; } @@ -989,7 +987,8 @@ cclass( Tcl_DString ds; const char *np; const char *const *namePtr; - int i, index; + size_t i; + int index; /* * The following arrays define the valid character class names. @@ -1012,7 +1011,7 @@ 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. @@ -1047,14 +1046,14 @@ cclass( 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); } @@ -1063,11 +1062,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]); } } @@ -1086,11 +1085,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]); } } @@ -1098,7 +1097,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); } @@ -1107,11 +1106,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]); } } @@ -1136,11 +1135,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]); } } @@ -1148,11 +1147,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]); } } @@ -1160,11 +1159,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]); } } @@ -1172,18 +1171,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]); } } @@ -1191,11 +1190,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]); } } @@ -1222,9 +1221,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/regcomp.c b/generic/regcomp.c index 3be5172..4843b54 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 *); @@ -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 "d ==========\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; @@ -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 "d, info 0%lo, ntree %d\n", + re->re_nsub, re->re_info, g->ntree); dumpcolors(&g->cmap, f); if (!NULLCNFA(g->search)) { 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/regerror.c b/generic/regerror.c index 500dfe2..5d74340 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 e7260cd..2c5107f 100644 --- a/generic/regexec.c +++ b/generic/regexec.c @@ -186,10 +186,6 @@ exec( FreeVars(v); return REG_INVARG; } - if (re->re_csize != sizeof(chr)) { - FreeVars(v); - return REG_MIXED; - } /* * Setup. diff --git a/generic/tcl.decls b/generic/tcl.decls index e49ed66..4a58a20 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(unsigned int size) + void *Tcl_Alloc(size_t size) } declare 4 { - void Tcl_Free(char *ptr) + void Tcl_Free(void *ptr) } declare 5 { - char *Tcl_Realloc(char *ptr, unsigned int size) + void *Tcl_Realloc(void *ptr, size_t size) } declare 6 { - char *Tcl_DbCkalloc(unsigned int size, const char *file, int line) + void *Tcl_DbCkalloc(size_t 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, unsigned int size, + void *Tcl_DbCkrealloc(void *ptr, size_t size, const char *file, int line) } @@ -65,7 +65,7 @@ declare 8 { declare 9 unix { void Tcl_CreateFileHandler(int fd, int mask, Tcl_FileProc *proc, - ClientData clientData) + void *clientData) } declare 10 unix { void Tcl_DeleteFileHandler(int fd) @@ -86,7 +86,7 @@ declare 15 { void Tcl_AppendStringsToObj(Tcl_Obj *objPtr, ...) } declare 16 { - void Tcl_AppendToObj(Tcl_Obj *objPtr, const char *bytes, int length) + void Tcl_AppendToObj(Tcl_Obj *objPtr, const char *bytes, size_t length) } declare 17 { Tcl_Obj *Tcl_ConcatObj(int objc, Tcl_Obj *const objv[]) @@ -104,11 +104,12 @@ 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 boolValue, const char *file, int line) -} +# Removed in 9.0 (changed to macro): +#declare 22 { +# Tcl_Obj *Tcl_DbNewBooleanObj(int boolValue, const char *file, int line) +#} declare 23 { - Tcl_Obj *Tcl_DbNewByteArrayObj(const unsigned char *bytes, int length, + Tcl_Obj *Tcl_DbNewByteArrayObj(const unsigned char *bytes, size_t length, const char *file, int line) } declare 24 { @@ -119,14 +120,15 @@ declare 25 { Tcl_Obj *Tcl_DbNewListObj(int 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) } declare 28 { - Tcl_Obj *Tcl_DbNewStringObj(const char *bytes, int length, + Tcl_Obj *Tcl_DbNewStringObj(const char *bytes, size_t length, const char *file, int line) } declare 29 { @@ -152,10 +154,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) } @@ -166,7 +169,7 @@ declare 39 { int Tcl_GetLongFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr) } declare 40 { - CONST86 Tcl_ObjType *Tcl_GetObjType(const char *typeName) + const Tcl_ObjType *Tcl_GetObjType(const char *typeName) } declare 41 { char *Tcl_GetStringFromObj(Tcl_Obj *objPtr, int *lengthPtr) @@ -198,65 +201,73 @@ declare 48 { int Tcl_ListObjReplace(Tcl_Interp *interp, Tcl_Obj *listPtr, int first, int count, int objc, Tcl_Obj *const objv[]) } -declare 49 {deprecated {No longer in use, changed to macro}} { - Tcl_Obj *Tcl_NewBooleanObj(int boolValue) -} +# Removed in 9.0 (changed to macro): +#declare 49 { +# Tcl_Obj *Tcl_NewBooleanObj(int boolValue) +#} declare 50 { - Tcl_Obj *Tcl_NewByteArrayObj(const unsigned char *bytes, int length) + Tcl_Obj *Tcl_NewByteArrayObj(const unsigned char *bytes, size_t length) } 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(int 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, int length) -} -declare 57 {deprecated {No longer in use, changed to macro}} { - void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int boolValue) + Tcl_Obj *Tcl_NewStringObj(const char *bytes, size_t length) } +# Removed in 9.0 (changed to macro): +#declare 57 { +# void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int boolValue) +#} declare 58 { - unsigned char *Tcl_SetByteArrayLength(Tcl_Obj *objPtr, int length) + unsigned char *Tcl_SetByteArrayLength(Tcl_Obj *objPtr, size_t length) } declare 59 { void Tcl_SetByteArrayObj(Tcl_Obj *objPtr, const unsigned char *bytes, - int length) + size_t length) } 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, int 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, int length) + void Tcl_SetObjLength(Tcl_Obj *objPtr, size_t length) } declare 65 { - void Tcl_SetStringObj(Tcl_Obj *objPtr, const char *bytes, int 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) -} + void Tcl_SetStringObj(Tcl_Obj *objPtr, const char *bytes, size_t 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) } @@ -268,7 +279,7 @@ declare 70 { } declare 71 { Tcl_AsyncHandler Tcl_AsyncCreate(Tcl_AsyncProc *proc, - ClientData clientData) + void *clientData) } declare 72 { void Tcl_AsyncDelete(Tcl_AsyncHandler async) @@ -282,26 +293,29 @@ 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) } declare 79 { void Tcl_CallWhenDeleted(Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, - ClientData clientData) + void *clientData) } declare 80 { - void Tcl_CancelIdleCall(Tcl_IdleProc *idleProc, ClientData clientData) -} -declare 81 { - int Tcl_Close(Tcl_Interp *interp, Tcl_Channel chan) + void Tcl_CancelIdleCall(Tcl_IdleProc *idleProc, void *clientData) } +# Removed in 9.0: +#declare 81 { +# int Tcl_Close(Tcl_Interp *interp, Tcl_Channel chan) +#} declare 82 { int Tcl_CommandComplete(const char *cmd) } @@ -309,10 +323,10 @@ declare 83 { char *Tcl_Concat(int argc, const char *const *argv) } declare 84 { - int Tcl_ConvertElement(const char *src, char *dst, int flags) + size_t Tcl_ConvertElement(const char *src, char *dst, int flags) } declare 85 { - int Tcl_ConvertCountedElement(const char *src, int length, char *dst, + size_t Tcl_ConvertCountedElement(const char *src, size_t length, char *dst, int flags) } declare 86 { @@ -327,40 +341,41 @@ declare 87 { } declare 88 { Tcl_Channel Tcl_CreateChannel(const Tcl_ChannelType *typePtr, - const char *chanName, ClientData instanceData, int mask) + const char *chanName, void *instanceData, int mask) } declare 89 { void Tcl_CreateChannelHandler(Tcl_Channel chan, int mask, - Tcl_ChannelProc *proc, ClientData clientData) + Tcl_ChannelProc *proc, void *clientData) } declare 90 { void Tcl_CreateCloseHandler(Tcl_Channel chan, Tcl_CloseProc *proc, - ClientData clientData) + void *clientData) } declare 91 { Tcl_Command Tcl_CreateCommand(Tcl_Interp *interp, const char *cmdName, - Tcl_CmdProc *proc, ClientData clientData, + Tcl_CmdProc *proc, void *clientData, Tcl_CmdDeleteProc *deleteProc) } declare 92 { void Tcl_CreateEventSource(Tcl_EventSetupProc *setupProc, - Tcl_EventCheckProc *checkProc, ClientData clientData) + Tcl_EventCheckProc *checkProc, void *clientData) } declare 93 { - void Tcl_CreateExitHandler(Tcl_ExitProc *proc, ClientData clientData) + void Tcl_CreateExitHandler(Tcl_ExitProc *proc, void *clientData) } 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, ClientData 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, - Tcl_ObjCmdProc *proc, ClientData clientData, + Tcl_ObjCmdProc *proc, void *clientData, Tcl_CmdDeleteProc *deleteProc) } declare 97 { @@ -369,22 +384,22 @@ declare 97 { } declare 98 { Tcl_TimerToken Tcl_CreateTimerHandler(int milliseconds, - Tcl_TimerProc *proc, ClientData clientData) + Tcl_TimerProc *proc, void *clientData) } declare 99 { Tcl_Trace Tcl_CreateTrace(Tcl_Interp *interp, int level, - Tcl_CmdTraceProc *proc, ClientData clientData) + Tcl_CmdTraceProc *proc, void *clientData) } declare 100 { void Tcl_DeleteAssocData(Tcl_Interp *interp, const char *name) } declare 101 { void Tcl_DeleteChannelHandler(Tcl_Channel chan, Tcl_ChannelProc *proc, - ClientData clientData) + void *clientData) } declare 102 { void Tcl_DeleteCloseHandler(Tcl_Channel chan, Tcl_CloseProc *proc, - ClientData clientData) + void *clientData) } declare 103 { int Tcl_DeleteCommand(Tcl_Interp *interp, const char *cmdName) @@ -393,14 +408,14 @@ declare 104 { int Tcl_DeleteCommandFromToken(Tcl_Interp *interp, Tcl_Command command) } declare 105 { - void Tcl_DeleteEvents(Tcl_EventDeleteProc *proc, ClientData clientData) + void Tcl_DeleteEvents(Tcl_EventDeleteProc *proc, void *clientData) } declare 106 { void Tcl_DeleteEventSource(Tcl_EventSetupProc *setupProc, - Tcl_EventCheckProc *checkProc, ClientData clientData) + Tcl_EventCheckProc *checkProc, void *clientData) } declare 107 { - void Tcl_DeleteExitHandler(Tcl_ExitProc *proc, ClientData clientData) + void Tcl_DeleteExitHandler(Tcl_ExitProc *proc, void *clientData) } declare 108 { void Tcl_DeleteHashEntry(Tcl_HashEntry *entryPtr) @@ -422,16 +437,16 @@ declare 113 { } declare 114 { void Tcl_DontCallWhenDeleted(Tcl_Interp *interp, - Tcl_InterpDeleteProc *proc, ClientData clientData) + Tcl_InterpDeleteProc *proc, void *clientData) } declare 115 { int Tcl_DoOneEvent(int flags) } declare 116 { - void Tcl_DoWhenIdle(Tcl_IdleProc *proc, ClientData clientData) + void Tcl_DoWhenIdle(Tcl_IdleProc *proc, void *clientData) } declare 117 { - char *Tcl_DStringAppend(Tcl_DString *dsPtr, const char *bytes, int length) + char *Tcl_DStringAppend(Tcl_DString *dsPtr, const char *bytes, size_t length) } declare 118 { char *Tcl_DStringAppendElement(Tcl_DString *dsPtr, const char *element) @@ -452,7 +467,7 @@ declare 123 { void Tcl_DStringResult(Tcl_Interp *interp, Tcl_DString *dsPtr) } declare 124 { - void Tcl_DStringSetLength(Tcl_DString *dsPtr, int length) + void Tcl_DStringSetLength(Tcl_DString *dsPtr, size_t length) } declare 125 { void Tcl_DStringStartSublist(Tcl_DString *dsPtr) @@ -466,17 +481,19 @@ 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(ClientData clientData, Tcl_FreeProc *freeProc) + void Tcl_EventuallyFree(void *clientData, Tcl_FreeProc *freeProc) } declare 133 { TCL_NORETURN void Tcl_Exit(int status) @@ -513,9 +530,10 @@ declare 142 { declare 143 { void Tcl_Finalize(void) } -declare 144 {nostub {Don't use this function in a stub-enabled extension}} { - void Tcl_FindExecutable(const char *argv0) -} +# Removed in 9.0 (stub entry only) +#declare 144 { +# void Tcl_FindExecutable(const char *argv0) +#} declare 145 { Tcl_HashEntry *Tcl_FirstHashEntry(Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr) @@ -523,9 +541,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, @@ -537,7 +556,7 @@ declare 149 { int *objcPtr, Tcl_Obj ***objv) } declare 150 { - ClientData Tcl_GetAssocData(Tcl_Interp *interp, const char *name, + void *Tcl_GetAssocData(Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc **procPtr) } declare 151 { @@ -549,10 +568,10 @@ declare 152 { } declare 153 { int Tcl_GetChannelHandle(Tcl_Channel chan, int direction, - ClientData *handlePtr) + void **handlePtr) } declare 154 { - ClientData Tcl_GetChannelInstanceData(Tcl_Channel chan) + void *Tcl_GetChannelInstanceData(Tcl_Channel chan) } declare 155 { int Tcl_GetChannelMode(Tcl_Channel chan) @@ -565,7 +584,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 +618,7 @@ declare 166 { declare 167 unix { int Tcl_GetOpenFile(Tcl_Interp *interp, const char *chanID, int forWriting, - int checkUsage, ClientData *filePtr) + int checkUsage, void **filePtr) } # Obsolete. Should now use Tcl_FSGetPathType which is objectified # and therefore usually faster. @@ -607,10 +626,10 @@ declare 168 { Tcl_PathType Tcl_GetPathType(const char *path) } declare 169 { - int Tcl_Gets(Tcl_Channel chan, Tcl_DString *dsPtr) + size_t Tcl_Gets(Tcl_Channel chan, Tcl_DString *dsPtr) } declare 170 { - int Tcl_GetsObj(Tcl_Channel chan, Tcl_Obj *objPtr) + size_t Tcl_GetsObj(Tcl_Channel chan, Tcl_Obj *objPtr) } declare 171 { int Tcl_GetServiceMode(void) @@ -621,23 +640,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) @@ -676,13 +699,13 @@ declare 187 { # } declare 189 { - Tcl_Channel Tcl_MakeFileChannel(ClientData handle, int mode) + Tcl_Channel Tcl_MakeFileChannel(void *handle, int mode) } declare 190 { int Tcl_MakeSafe(Tcl_Interp *interp) } declare 191 { - Tcl_Channel Tcl_MakeTcpClientChannel(ClientData tcpSocket) + Tcl_Channel Tcl_MakeTcpClientChannel(void *tcpSocket) } declare 192 { char *Tcl_Merge(int argc, const char *const *argv) @@ -717,10 +740,10 @@ declare 199 { declare 200 { Tcl_Channel Tcl_OpenTcpServer(Tcl_Interp *interp, int port, const char *host, Tcl_TcpAcceptProc *acceptProc, - ClientData callbackData) + void *callbackData) } declare 201 { - void Tcl_Preserve(ClientData data) + void Tcl_Preserve(void *data) } declare 202 { void Tcl_PrintDouble(Tcl_Interp *interp, double value, char *dst) @@ -735,7 +758,7 @@ declare 205 { void Tcl_QueueEvent(Tcl_Event *evPtr, Tcl_QueuePosition position) } declare 206 { - int Tcl_Read(Tcl_Channel chan, char *bufPtr, int toRead) + size_t Tcl_Read(Tcl_Channel chan, char *bufPtr, size_t toRead) } declare 207 { void Tcl_ReapDetachedProcs(void) @@ -764,24 +787,25 @@ declare 214 { const char *pattern) } declare 215 { - void Tcl_RegExpRange(Tcl_RegExp regexp, int index, + void Tcl_RegExpRange(Tcl_RegExp regexp, size_t index, const char **startPtr, const char **endPtr) } declare 216 { - void Tcl_Release(ClientData clientData) + void Tcl_Release(void *clientData) } declare 217 { void Tcl_ResetResult(Tcl_Interp *interp) } declare 218 { - int Tcl_ScanElement(const char *src, int *flagPtr) + size_t Tcl_ScanElement(const char *src, int *flagPtr) } declare 219 { - int Tcl_ScanCountedElement(const char *src, int length, int *flagPtr) -} -declare 220 {deprecated {}} { - int Tcl_SeekOld(Tcl_Channel chan, int offset, int mode) + size_t Tcl_ScanCountedElement(const char *src, size_t length, int *flagPtr) } +# Removed in 9.0: +#declare 220 { +# int Tcl_SeekOld(Tcl_Channel chan, int offset, int mode) +#} declare 221 { int Tcl_ServiceAll(void) } @@ -790,7 +814,7 @@ declare 222 { } declare 223 { void Tcl_SetAssocData(Tcl_Interp *interp, const char *name, - Tcl_InterpDeleteProc *proc, ClientData clientData) + Tcl_InterpDeleteProc *proc, void *clientData) } declare 224 { void Tcl_SetChannelBufferSize(Tcl_Channel chan, int sz) @@ -812,16 +836,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}} { - void Tcl_SetPanicProc(TCL_NORETURN1 Tcl_PanicProc *panicProc) -} +# Removed in 9.0 (stub entry only) +#declare 230 { +# void Tcl_SetPanicProc(TCL_NORETURN1 Tcl_PanicProc *panicProc) +#} declare 231 { int Tcl_SetRecursionLimit(Tcl_Interp *interp, int 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) } @@ -834,10 +860,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) @@ -859,30 +886,34 @@ declare 242 { 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_StaticPackage(Tcl_Interp *interp, const char *pkgName, - Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *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, ClientData clientData) -} +# Removed in 9.0 (stub entry only) +#declare 244 { +# void Tcl_StaticPackage(Tcl_Interp *interp, const char *pkgName, +# Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *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, ClientData clientData) +#} declare 248 { int Tcl_TraceVar2(Tcl_Interp *interp, const char *part1, const char *part2, - int flags, Tcl_VarTraceProc *proc, ClientData clientData) + int flags, Tcl_VarTraceProc *proc, void *clientData) } declare 249 { char *Tcl_TranslateFileName(Tcl_Interp *interp, const char *name, Tcl_DString *bufferPtr) } declare 250 { - int Tcl_Ungets(Tcl_Channel chan, const char *str, int len, int atHead) + size_t Tcl_Ungets(Tcl_Channel chan, const char *str, size_t len, int atHead) } declare 251 { void Tcl_UnlinkVar(Tcl_Interp *interp, const char *varName) @@ -890,29 +921,32 @@ 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, ClientData clientData) -} +# Removed in 9.0, replaced by macro. +#declare 255 { +# void Tcl_UntraceVar(Tcl_Interp *interp, const char *varName, int flags, +# Tcl_VarTraceProc *proc, ClientData clientData) +#} declare 256 { void Tcl_UntraceVar2(Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, - ClientData clientData) + void *clientData) } 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) @@ -920,17 +954,18 @@ declare 259 { declare 260 { int Tcl_VarEval(Tcl_Interp *interp, ...) } -declare 261 {deprecated {No longer in use, changed to macro}} { - ClientData Tcl_VarTraceInfo(Tcl_Interp *interp, const char *varName, - int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData) -} +# Removed in 9.0, replaced by macro. +#declare 261 { +# ClientData Tcl_VarTraceInfo(Tcl_Interp *interp, const char *varName, +# int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData) +#} declare 262 { - ClientData Tcl_VarTraceInfo2(Tcl_Interp *interp, const char *part1, + void *Tcl_VarTraceInfo2(Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *procPtr, - ClientData prevClientData) + void *prevClientData) } declare 263 { - int Tcl_Write(Tcl_Channel chan, const char *s, int slen) + size_t Tcl_Write(Tcl_Channel chan, const char *s, size_t slen) } declare 264 { void Tcl_WrongNumArgs(Tcl_Interp *interp, int objc, @@ -942,12 +977,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) } @@ -955,36 +992,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) } @@ -1008,7 +1051,7 @@ declare 280 { declare 281 { Tcl_Channel Tcl_StackChannel(Tcl_Interp *interp, - const Tcl_ChannelType *typePtr, ClientData instanceData, + const Tcl_ChannelType *typePtr, void *instanceData, int mask, Tcl_Channel prevChan) } declare 282 { @@ -1036,16 +1079,17 @@ declare 287 { Tcl_Encoding Tcl_CreateEncoding(const Tcl_EncodingType *typePtr) } declare 288 { - void Tcl_CreateThreadExitHandler(Tcl_ExitProc *proc, ClientData clientData) + void Tcl_CreateThreadExitHandler(Tcl_ExitProc *proc, void *clientData) } declare 289 { - void Tcl_DeleteThreadExitHandler(Tcl_ExitProc *proc, ClientData clientData) -} -declare 290 { - void Tcl_DiscardResult(Tcl_SavedResult *statePtr) + void Tcl_DeleteThreadExitHandler(Tcl_ExitProc *proc, void *clientData) } +# Removed in 9.0, replaced by macro. +#declare 290 { +# void Tcl_DiscardResult(Tcl_SavedResult *statePtr) +#} declare 291 { - int Tcl_EvalEx(Tcl_Interp *interp, const char *script, int numBytes, + int Tcl_EvalEx(Tcl_Interp *interp, const char *script, size_t numBytes, int flags) } declare 292 { @@ -1060,19 +1104,19 @@ declare 294 { } declare 295 { int Tcl_ExternalToUtf(Tcl_Interp *interp, Tcl_Encoding encoding, - const char *src, int srcLen, int flags, - Tcl_EncodingState *statePtr, char *dst, int dstLen, + const char *src, size_t srcLen, int flags, + Tcl_EncodingState *statePtr, char *dst, size_t dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr) } declare 296 { char *Tcl_ExternalToUtfDString(Tcl_Encoding encoding, - const char *src, int srcLen, Tcl_DString *dsPtr) + const char *src, size_t srcLen, Tcl_DString *dsPtr) } declare 297 { void Tcl_FinalizeThread(void) } declare 298 { - void Tcl_FinalizeNotifier(ClientData clientData) + void Tcl_FinalizeNotifier(void *clientData) } declare 299 { void Tcl_FreeEncoding(Tcl_Encoding encoding) @@ -1091,18 +1135,18 @@ declare 303 { } declare 304 { int Tcl_GetIndexFromObjStruct(Tcl_Interp *interp, Tcl_Obj *objPtr, - const void *tablePtr, int offset, const char *msg, int flags, + const void *tablePtr, size_t offset, const char *msg, int flags, int *indexPtr) } declare 305 { - void *Tcl_GetThreadData(Tcl_ThreadDataKey *keyPtr, int size) + void *Tcl_GetThreadData(Tcl_ThreadDataKey *keyPtr, size_t size) } declare 306 { Tcl_Obj *Tcl_GetVar2Ex(Tcl_Interp *interp, const char *part1, const char *part2, int flags) } declare 307 { - ClientData Tcl_InitNotifier(void) + void *Tcl_InitNotifier(void) } declare 308 { void Tcl_MutexLock(Tcl_Mutex *mutexPtr) @@ -1118,18 +1162,20 @@ declare 311 { const Tcl_Time *timePtr) } declare 312 { - int Tcl_NumUtfChars(const char *src, int length) + size_t Tcl_NumUtfChars(const char *src, size_t length) } declare 313 { - int Tcl_ReadChars(Tcl_Channel channel, Tcl_Obj *objPtr, int charsToRead, - int appendFlag) -} -declare 314 { - void Tcl_RestoreResult(Tcl_Interp *interp, Tcl_SavedResult *statePtr) -} -declare 315 { - void Tcl_SaveResult(Tcl_Interp *interp, Tcl_SavedResult *statePtr) -} + size_t Tcl_ReadChars(Tcl_Channel channel, Tcl_Obj *objPtr, + size_t charsToRead, int appendFlag) +} +# Removed in 9.0, replaced by macro. +#declare 314 { +# void Tcl_RestoreResult(Tcl_Interp *interp, Tcl_SavedResult *statePtr) +#} +# Removed in 9.0, replaced by macro. +#declare 315 { +# void Tcl_SaveResult(Tcl_Interp *interp, Tcl_SavedResult *statePtr) +#} declare 316 { int Tcl_SetSystemEncoding(Tcl_Interp *interp, const char *name) } @@ -1145,7 +1191,7 @@ declare 319 { Tcl_QueuePosition position) } declare 320 { - int Tcl_UniCharAtIndex(const char *src, int index) + int Tcl_UniCharAtIndex(const char *src, size_t index) } declare 321 { int Tcl_UniCharToLower(int ch) @@ -1160,13 +1206,13 @@ declare 324 { int Tcl_UniCharToUtf(int ch, char *buf) } declare 325 { - const char *Tcl_UtfAtIndex(const char *src, int index) + const char *Tcl_UtfAtIndex(const char *src, size_t index) } declare 326 { - int Tcl_UtfCharComplete(const char *src, int length) + int Tcl_UtfCharComplete(const char *src, size_t length) } declare 327 { - int Tcl_UtfBackslash(const char *src, int *readPtr, char *dst) + size_t Tcl_UtfBackslash(const char *src, int *readPtr, char *dst) } declare 328 { const char *Tcl_UtfFindFirst(const char *src, int ch) @@ -1182,13 +1228,13 @@ declare 331 { } declare 332 { int Tcl_UtfToExternal(Tcl_Interp *interp, Tcl_Encoding encoding, - const char *src, int srcLen, int flags, - Tcl_EncodingState *statePtr, char *dst, int dstLen, + const char *src, size_t srcLen, int flags, + Tcl_EncodingState *statePtr, char *dst, size_t dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr) } declare 333 { char *Tcl_UtfToExternalDString(Tcl_Encoding encoding, - const char *src, int srcLen, Tcl_DString *dsPtr) + const char *src, size_t srcLen, Tcl_DString *dsPtr) } declare 334 { int Tcl_UtfToLower(char *src) @@ -1203,22 +1249,24 @@ declare 337 { int Tcl_UtfToUpper(char *src) } declare 338 { - int Tcl_WriteChars(Tcl_Channel chan, const char *src, int srcLen) + size_t Tcl_WriteChars(Tcl_Channel chan, const char *src, size_t srcLen) } declare 339 { - int Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr) + size_t Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr) } 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(ClientData clientData) + void Tcl_AlertNotifier(void *clientData) } declare 344 { void Tcl_ServiceModeHook(int mode) @@ -1244,56 +1292,60 @@ declare 350 { declare 351 { int Tcl_UniCharIsWordChar(int ch) } -declare 352 {deprecated {Use Tcl_GetCharLength}} { - int Tcl_UniCharLen(const Tcl_UniChar *uniStr) -} -declare 353 {deprecated {Use Tcl_UtfNcmp}} { - int Tcl_UniCharNcmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, - unsigned long numChars) -} +# Removed in 9.0: +#declare 352 { +# size_t Tcl_UniCharLen(const Tcl_UniChar *uniStr) +#} +# Removed in 9.0: +#declare 353 { +# int Tcl_UniCharNcmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, +# size_t numChars) +#} declare 354 { char *Tcl_Char16ToUtfDString(const unsigned short *uniStr, - int uniLength, Tcl_DString *dsPtr) + size_t uniLength, Tcl_DString *dsPtr) } declare 355 { unsigned short *Tcl_UtfToChar16DString(const char *src, - int length, Tcl_DString *dsPtr) + size_t length, Tcl_DString *dsPtr) } 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) } declare 359 { void Tcl_LogCommandInfo(Tcl_Interp *interp, const char *script, - const char *command, int length) + const char *command, size_t length) } declare 360 { - int Tcl_ParseBraces(Tcl_Interp *interp, const char *start, int numBytes, - Tcl_Parse *parsePtr, int append, const char **termPtr) + int Tcl_ParseBraces(Tcl_Interp *interp, const char *start, + size_t numBytes, Tcl_Parse *parsePtr, int append, + const char **termPtr) } declare 361 { - int Tcl_ParseCommand(Tcl_Interp *interp, const char *start, int numBytes, - int nested, Tcl_Parse *parsePtr) + int Tcl_ParseCommand(Tcl_Interp *interp, const char *start, + size_t numBytes, int nested, Tcl_Parse *parsePtr) } declare 362 { - int Tcl_ParseExpr(Tcl_Interp *interp, const char *start, int numBytes, + int Tcl_ParseExpr(Tcl_Interp *interp, const char *start, size_t numBytes, Tcl_Parse *parsePtr) } declare 363 { int Tcl_ParseQuotedString(Tcl_Interp *interp, const char *start, - int numBytes, Tcl_Parse *parsePtr, int append, + size_t numBytes, Tcl_Parse *parsePtr, int append, const char **termPtr) } declare 364 { - int Tcl_ParseVarName(Tcl_Interp *interp, const char *start, int numBytes, - Tcl_Parse *parsePtr, int append) + int Tcl_ParseVarName(Tcl_Interp *interp, const char *start, + size_t numBytes, Tcl_Parse *parsePtr, int append) } # These 4 functions are obsolete, use Tcl_FSGetCwd, Tcl_FSChdir, # Tcl_FSAccess and Tcl_FSStat @@ -1310,10 +1362,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) @@ -1332,34 +1384,36 @@ declare 375 { } declare 376 { int Tcl_RegExpExecObj(Tcl_Interp *interp, Tcl_RegExp regexp, - Tcl_Obj *textObj, int offset, int nmatches, int flags) + Tcl_Obj *textObj, size_t offset, size_t nmatches, int flags) } declare 377 { void Tcl_RegExpGetInfo(Tcl_RegExp regexp, Tcl_RegExpInfo *infoPtr) } declare 378 { - Tcl_Obj *Tcl_NewUnicodeObj(const Tcl_UniChar *unicode, int numChars) + Tcl_Obj *Tcl_NewUnicodeObj(const Tcl_UniChar *unicode, size_t numChars) } declare 379 { void Tcl_SetUnicodeObj(Tcl_Obj *objPtr, const Tcl_UniChar *unicode, - int numChars) + size_t numChars) } declare 380 { - int Tcl_GetCharLength(Tcl_Obj *objPtr) + size_t Tcl_GetCharLength(Tcl_Obj *objPtr) } declare 381 { - int Tcl_GetUniChar(Tcl_Obj *objPtr, int index) -} -declare 382 {deprecated {No longer in use, changed to macro}} { - Tcl_UniChar *Tcl_GetUnicode(Tcl_Obj *objPtr) + int Tcl_GetUniChar(Tcl_Obj *objPtr, size_t 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, int first, int last) -} -declare 384 {deprecated {Use Tcl_AppendStringsToObj}} { - void Tcl_AppendUnicodeToObj(Tcl_Obj *objPtr, const Tcl_UniChar *unicode, - int length) + Tcl_Obj *Tcl_GetRange(Tcl_Obj *objPtr, size_t first, size_t last) } +# Removed in 9.0 +#declare 384 { +# void Tcl_AppendUnicodeToObj(Tcl_Obj *objPtr, const Tcl_UniChar *unicode, +# size_t length) +#} declare 385 { int Tcl_RegExpMatchObj(Tcl_Interp *interp, Tcl_Obj *textObj, Tcl_Obj *patternObj) @@ -1377,7 +1431,7 @@ declare 389 { int Tcl_GetChannelNamesEx(Tcl_Interp *interp, const char *pattern) } declare 390 { - int Tcl_ProcObjCmd(ClientData clientData, Tcl_Interp *interp, + int Tcl_ProcObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) } declare 391 { @@ -1388,15 +1442,15 @@ declare 392 { } declare 393 { int Tcl_CreateThread(Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc *proc, - ClientData clientData, int stackSize, int flags) + void *clientData, size_t stackSize, int flags) } # Introduced in 8.3.2 declare 394 { - int Tcl_ReadRaw(Tcl_Channel chan, char *dst, int bytesToRead) + size_t Tcl_ReadRaw(Tcl_Channel chan, char *dst, size_t bytesToRead) } declare 395 { - int Tcl_WriteRaw(Tcl_Channel chan, const char *src, int srcLen) + size_t Tcl_WriteRaw(Tcl_Channel chan, const char *src, size_t srcLen) } declare 396 { Tcl_Channel Tcl_GetTopChannel(Tcl_Channel chan) @@ -1415,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) @@ -1431,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) @@ -1482,21 +1538,25 @@ declare 417 { declare 418 { int Tcl_IsChannelExisting(const char *channelName) } -declare 419 {deprecated {Use Tcl_UtfNcasecmp}} { - int Tcl_UniCharNcasecmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, - unsigned long numChars) -} -declare 420 {deprecated {Use Tcl_StringCaseMatch}} { - int Tcl_UniCharCaseMatch(const Tcl_UniChar *uniStr, - const Tcl_UniChar *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, +# size_t 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) @@ -1505,33 +1565,33 @@ declare 424 { void Tcl_InitObjHashTable(Tcl_HashTable *tablePtr) } declare 425 { - ClientData Tcl_CommandTraceInfo(Tcl_Interp *interp, const char *varName, + void *Tcl_CommandTraceInfo(Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *procPtr, - ClientData prevClientData) + void *prevClientData) } declare 426 { int Tcl_TraceCommand(Tcl_Interp *interp, const char *varName, int flags, - Tcl_CommandTraceProc *proc, ClientData clientData) + Tcl_CommandTraceProc *proc, void *clientData) } declare 427 { void Tcl_UntraceCommand(Tcl_Interp *interp, const char *varName, - int flags, Tcl_CommandTraceProc *proc, ClientData clientData) + int flags, Tcl_CommandTraceProc *proc, void *clientData) } declare 428 { - char *Tcl_AttemptAlloc(unsigned int size) + void *Tcl_AttemptAlloc(size_t size) } declare 429 { - char *Tcl_AttemptDbCkalloc(unsigned int size, const char *file, int line) + void *Tcl_AttemptDbCkalloc(size_t size, const char *file, int line) } declare 430 { - char *Tcl_AttemptRealloc(char *ptr, unsigned int size) + void *Tcl_AttemptRealloc(void *ptr, size_t size) } declare 431 { - char *Tcl_AttemptDbCkrealloc(char *ptr, unsigned int size, + void *Tcl_AttemptDbCkrealloc(void *ptr, size_t size, const char *file, int line) } declare 432 { - int Tcl_AttemptSetObjLength(Tcl_Obj *objPtr, int length) + int Tcl_AttemptSetObjLength(Tcl_Obj *objPtr, size_t length) } # TIP#10 (thread-aware channels) akupries @@ -1545,14 +1605,16 @@ declare 434 { } # 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, ClientData *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 { @@ -1614,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 { @@ -1653,7 +1715,7 @@ declare 464 { Tcl_Obj *const objv[]) } declare 465 { - ClientData Tcl_FSGetInternalRep(Tcl_Obj *pathPtr, + void *Tcl_FSGetInternalRep(Tcl_Obj *pathPtr, const Tcl_Filesystem *fsPtr) } declare 466 { @@ -1664,7 +1726,7 @@ declare 467 { } declare 468 { Tcl_Obj *Tcl_FSNewNativePath(const Tcl_Filesystem *fromFilesystem, - ClientData clientData) + void *clientData) } declare 469 { const void *Tcl_FSGetNativePath(Tcl_Obj *pathPtr) @@ -1679,20 +1741,20 @@ declare 472 { Tcl_Obj *Tcl_FSListVolumes(void) } declare 473 { - int Tcl_FSRegister(ClientData clientData, const Tcl_Filesystem *fsPtr) + int Tcl_FSRegister(void *clientData, const Tcl_Filesystem *fsPtr) } declare 474 { int Tcl_FSUnregister(const Tcl_Filesystem *fsPtr) } declare 475 { - ClientData Tcl_FSData(const Tcl_Filesystem *fsPtr) + void *Tcl_FSData(const Tcl_Filesystem *fsPtr) } declare 476 { const char *Tcl_FSGetTranslatedStringPath(Tcl_Interp *interp, 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) @@ -1709,7 +1771,7 @@ declare 480 { # TIP#56 (evaluate a parsed script) msofer declare 481 { int Tcl_EvalTokensStandard(Tcl_Interp *interp, Tcl_Token *tokenPtr, - int count) + size_t count) } # TIP#73 (access to current time) kbk @@ -1720,7 +1782,7 @@ declare 482 { # TIP#32 (object-enabled traces) kbk declare 483 { Tcl_Trace Tcl_CreateObjTrace(Tcl_Interp *interp, int level, int flags, - Tcl_CmdObjTraceProc *objProc, ClientData clientData, + Tcl_CmdObjTraceProc *objProc, void *clientData, Tcl_CmdObjTraceDeleteProc *delProc) } declare 484 { @@ -1818,7 +1880,7 @@ declare 505 { # dkf, API by Brent Welch? declare 506 { Tcl_Namespace *Tcl_CreateNamespace(Tcl_Interp *interp, const char *name, - ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc) + void *clientData, Tcl_NamespaceDeleteProc *deleteProc) } declare 507 { void Tcl_DeleteNamespace(Tcl_Namespace *nsPtr) @@ -1867,20 +1929,20 @@ 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 { void Tcl_LimitAddHandler(Tcl_Interp *interp, int type, - Tcl_LimitHandlerProc *handlerProc, ClientData clientData, + Tcl_LimitHandlerProc *handlerProc, void *clientData, Tcl_LimitHandlerDeleteProc *deleteProc) } declare 521 { void Tcl_LimitRemoveHandler(Tcl_Interp *interp, int type, - Tcl_LimitHandlerProc *handlerProc, ClientData clientData) + Tcl_LimitHandlerProc *handlerProc, void *clientData) } declare 522 { int Tcl_LimitReady(Tcl_Interp *interp) @@ -1993,12 +2055,12 @@ declare 551 { declare 552 { void Tcl_SetTimeProc(Tcl_GetTimeProc *getProc, Tcl_ScaleTimeProc *scaleProc, - ClientData clientData) + void *clientData) } declare 553 { void Tcl_QueryTimeProc(Tcl_GetTimeProc **getProc, Tcl_ScaleTimeProc **scaleProc, - ClientData *clientData) + void **clientData) } # TIP#218 (driver thread actions) davygrvy/akupries ChannelType ver 4 @@ -2089,8 +2151,8 @@ declare 574 { void Tcl_AppendObjToErrorInfo(Tcl_Interp *interp, Tcl_Obj *objPtr) } declare 575 { - void Tcl_AppendLimitedToObj(Tcl_Obj *objPtr, const char *bytes, int length, - int limit, const char *ellipsis) + void Tcl_AppendLimitedToObj(Tcl_Obj *objPtr, const char *bytes, + size_t length, size_t limit, const char *ellipsis) } declare 576 { Tcl_Obj *Tcl_Format(Tcl_Interp *interp, const char *format, int objc, @@ -2112,7 +2174,7 @@ declare 579 { # TIP #285 (script cancellation support) jmistachkin declare 580 { int Tcl_CancelEval(Tcl_Interp *interp, Tcl_Obj *resultObjPtr, - ClientData clientData, int flags) + void *clientData, int flags) } declare 581 { int Tcl_Canceled(Tcl_Interp *interp, int flags) @@ -2128,15 +2190,15 @@ declare 582 { declare 583 { Tcl_Command Tcl_NRCreateCommand(Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc *proc, - Tcl_ObjCmdProc *nreProc, ClientData clientData, + Tcl_ObjCmdProc *nreProc, void *clientData, Tcl_CmdDeleteProc *deleteProc) } declare 584 { int Tcl_NREvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags) } declare 585 { - int Tcl_NREvalObjv(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], - int flags) + int Tcl_NREvalObjv(Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[], int flags) } declare 586 { int Tcl_NRCmdSwap(Tcl_Interp *interp, Tcl_Command cmd, int objc, @@ -2144,14 +2206,14 @@ declare 586 { } declare 587 { void Tcl_NRAddCallback(Tcl_Interp *interp, Tcl_NRPostProc *postProcPtr, - ClientData data0, ClientData data1, ClientData data2, - ClientData data3) + void *data0, void *data1, void *data2, + void *data3) } # For use by NR extenders, to have a simple way to also provide a (required!) # classic objProc declare 588 { int Tcl_NRCallObjProc(Tcl_Interp *interp, Tcl_ObjCmdProc *objProc, - ClientData clientData, int objc, Tcl_Obj *const objv[]) + void *clientData, int objc, Tcl_Obj *const objv[]) } # TIP#316 (Tcl_StatBuf reader functions) dkf @@ -2242,15 +2304,15 @@ declare 610 { } declare 611 { int Tcl_ZlibInflate(Tcl_Interp *interp, int format, Tcl_Obj *data, - int buffersize, Tcl_Obj *gzipHeaderDictObj) + size_t buffersize, Tcl_Obj *gzipHeaderDictObj) } declare 612 { unsigned int Tcl_ZlibCRC32(unsigned int crc, const unsigned char *buf, - int len) + size_t len) } declare 613 { unsigned int Tcl_ZlibAdler32(unsigned int adler, const unsigned char *buf, - int len) + size_t len) } declare 614 { int Tcl_ZlibStreamInit(Tcl_Interp *interp, int mode, int format, @@ -2269,7 +2331,8 @@ declare 618 { int Tcl_ZlibStreamPut(Tcl_ZlibStream zshandle, Tcl_Obj *data, int flush) } declare 619 { - int Tcl_ZlibStreamGet(Tcl_ZlibStream zshandle, Tcl_Obj *data, int count) + int Tcl_ZlibStreamGet(Tcl_ZlibStream zshandle, Tcl_Obj *data, + size_t count) } declare 620 { int Tcl_ZlibStreamClose(Tcl_ZlibStream zshandle) @@ -2327,7 +2390,7 @@ declare 630 { declare 631 { Tcl_Channel Tcl_OpenTcpServerEx(Tcl_Interp *interp, const char *service, const char *host, unsigned int flags, Tcl_TcpAcceptProc *acceptProc, - ClientData callbackData) + void *callbackData) } # TIP #430 @@ -2352,7 +2415,7 @@ declare 636 { } declare 637 { char *Tcl_InitStringRep(Tcl_Obj *objPtr, const char *bytes, - unsigned int numBytes) + size_t numBytes) } declare 638 { Tcl_ObjIntRep *Tcl_FetchIntRep(Tcl_Obj *objPtr, const Tcl_ObjType *typePtr) @@ -2381,12 +2444,12 @@ declare 643 { # TIP#312 New Tcl_LinkArray() function declare 644 { int Tcl_LinkArray(Tcl_Interp *interp, const char *varName, void *addr, - int type, int size) + int type, size_t size) } declare 645 { int Tcl_GetIntForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr, - int endValue, int *indexPtr) + size_t endValue, size_t *indexPtr) } # TIP #548 @@ -2395,11 +2458,11 @@ declare 646 { } declare 647 { char *Tcl_UniCharToUtfDString(const int *uniStr, - int uniLength, Tcl_DString *dsPtr) + size_t uniLength, Tcl_DString *dsPtr) } declare 648 { int *Tcl_UtfToUniCharDString(const char *src, - int length, Tcl_DString *dsPtr) + size_t length, Tcl_DString *dsPtr) } # ----- BASELINE -- FOR -- 8.7.0 ----- # @@ -2418,27 +2481,28 @@ interface tclPlat ################################ # Windows specific functions -# Added in Tcl 8.1 +# Added in Tcl 8.1, Removed in Tcl 9.0 (converted to macro) -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 0 win { +# TCHAR *Tcl_WinUtfToTChar(const char *str, size_t len, Tcl_DString *dsPtr) +#} +#declare 1 win { +# char *Tcl_WinTCharToUtf(const TCHAR *str, size_t len, Tcl_DString *dsPtr) +#} ################################ # Mac OS X specific functions -declare 0 macosx { - int Tcl_MacOSXOpenBundleResources(Tcl_Interp *interp, - const char *bundleName, int hasResourceFile, - int maxPathLen, char *libraryPath) -} +# Removed in 9.0 +#declare 0 macosx { +# int Tcl_MacOSXOpenBundleResources(Tcl_Interp *interp, +# const char *bundleName, int hasResourceFile, +# size_t maxPathLen, char *libraryPath) +#} declare 1 macosx { 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) } ############################################################################## @@ -2446,9 +2510,6 @@ declare 1 macosx { # Public functions that are not accessible via the stubs table. export { - void Tcl_Main(int argc, char **argv, Tcl_AppInitProc *appInitProc) -} -export { void Tcl_MainEx(int argc, char **argv, Tcl_AppInitProc *appInitProc, Tcl_Interp *interp) } diff --git a/generic/tcl.h b/generic/tcl.h index 5de113d..eb6d2fe 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -48,30 +48,15 @@ extern "C" { * tools/tcl.hpj.in (not patchlevel, for windows installer) */ -#define TCL_MAJOR_VERSION 8 -#define TCL_MINOR_VERSION 7 +#define TCL_MAJOR_VERSION 9 +#define TCL_MINOR_VERSION 0 #define TCL_RELEASE_LEVEL TCL_ALPHA_RELEASE -#define TCL_RELEASE_SERIAL 4 +#define TCL_RELEASE_SERIAL 2 -#define TCL_VERSION "8.7" -#define TCL_PATCH_LEVEL "8.7a4" +#define TCL_VERSION "9.0" +#define TCL_PATCH_LEVEL "9.0a2" -#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. @@ -85,11 +70,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 @@ -120,32 +101,11 @@ extern "C" { #include <stdio.h> -/* - *---------------------------------------------------------------------------- - * Support for functions with a variable number of arguments. - * - * The following TCL_VARARGS* macros are to support old extensions - * written for older versions of Tcl where the macros permitted - * support for the varargs.h system as well as stdarg.h . - * - * New code should just directly be written to use stdarg.h conventions. - */ - -#include <stdarg.h> -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 -# define TCL_VARARGS(type, name) (type name, ...) -# define TCL_VARARGS_DEF(type, name) (type name, ...) -# define TCL_VARARGS_START(type, name, list) (va_start(list, name), name) -#endif /* !TCL_NO_DEPRECATED */ #if defined(__GNUC__) && (__GNUC__ > 2) # define TCL_FORMAT_PRINTF(a,b) __attribute__ ((__format__ (__printf__, a, b))) # define TCL_NORETURN __attribute__ ((noreturn)) # define TCL_NOINLINE __attribute__ ((noinline)) -# 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) # if defined(_MSC_VER) && (_MSC_VER >= 1310) @@ -241,33 +201,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 @@ -286,40 +220,10 @@ 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. */ -#ifndef _CLIENTDATA - typedef void *ClientData; -# define _CLIENTDATA -#endif +typedef void *ClientData; /* * Darwin specific configure overrides (to support fat compiles, where @@ -404,15 +308,7 @@ typedef unsigned TCL_WIDE_INT_TYPE Tcl_WideUInt; #define Tcl_DoubleAsWide(val) ((Tcl_WideInt)((double)(val))) #if defined(_WIN32) -# ifdef __BORLANDC__ - typedef struct stati64 Tcl_StatBuf; -# elif defined(_WIN64) || defined(_USE_64BIT_TIME_T) - typedef struct __stat64 Tcl_StatBuf; -# elif (defined(_MSC_VER) && (_MSC_VER < 1400)) || defined(_USE_32BIT_TIME_T) - typedef struct _stati64 Tcl_StatBuf; -# else - typedef struct _stat32i64 Tcl_StatBuf; -# endif /* _MSC_VER < 1400 */ + typedef struct __stat64 Tcl_StatBuf; #elif defined(__CYGWIN__) typedef struct { dev_t st_dev; @@ -425,10 +321,9 @@ typedef unsigned TCL_WIDE_INT_TYPE Tcl_WideUInt; dev_t st_rdev; /* Here is a 4-byte gap */ long long st_size; - struct {long tv_sec;} st_atim; - struct {long tv_sec;} st_mtim; - struct {long tv_sec;} st_ctim; - /* Here is a 4-byte gap */ + struct {long long tv_sec;} st_atim; + struct {long long tv_sec;} st_mtim; + struct {long long tv_sec;} st_ctim; } Tcl_StatBuf; #elif defined(HAVE_STRUCT_STAT64) && !defined(__APPLE__) typedef struct stat64 Tcl_StatBuf; @@ -456,17 +351,7 @@ typedef unsigned TCL_WIDE_INT_TYPE Tcl_WideUInt; * 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; +typedef struct Tcl_Interp Tcl_Interp; typedef struct Tcl_AsyncHandler_ *Tcl_AsyncHandler; typedef struct Tcl_Channel_ *Tcl_Channel; @@ -497,9 +382,9 @@ typedef struct Tcl_ZLibStream_ *Tcl_ZlibStream; */ #if defined _WIN32 -typedef unsigned (__stdcall Tcl_ThreadCreateProc) (ClientData clientData); +typedef unsigned (__stdcall Tcl_ThreadCreateProc) (void *clientData); #else -typedef void (Tcl_ThreadCreateProc) (ClientData clientData); +typedef void (Tcl_ThreadCreateProc) (void *clientData); #endif /* @@ -565,19 +450,18 @@ typedef void (Tcl_ThreadCreateProc) (ClientData clientData); */ typedef struct Tcl_RegExpIndices { - long start; /* Character offset of first character in + size_t start; /* Character offset of first character in * match. */ - long end; /* Character offset of first character after + size_t end; /* Character offset of first character after * the match. */ } Tcl_RegExpIndices; typedef struct Tcl_RegExpInfo { - int nsubs; /* Number of subexpressions in the compiled + size_t nsubs; /* Number of subexpressions in the compiled * expression. */ Tcl_RegExpIndices *matches; /* Array of nsubs match offset pairs. */ - long extendStart; /* The offset at which a subsequent match + size_t extendStart; /* The offset at which a subsequent match * might begin. */ - long reserved; /* Reserved for later use. */ } Tcl_RegExpInfo; /* @@ -615,10 +499,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(): @@ -630,27 +510,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. */ @@ -663,62 +522,60 @@ struct Tcl_Obj; */ typedef int (Tcl_AppInitProc) (Tcl_Interp *interp); -typedef int (Tcl_AsyncProc) (ClientData clientData, Tcl_Interp *interp, +typedef int (Tcl_AsyncProc) (void *clientData, Tcl_Interp *interp, int code); -typedef void (Tcl_ChannelProc) (ClientData clientData, int mask); -typedef void (Tcl_CloseProc) (ClientData data); -typedef void (Tcl_CmdDeleteProc) (ClientData clientData); -typedef int (Tcl_CmdProc) (ClientData clientData, Tcl_Interp *interp, +typedef void (Tcl_ChannelProc) (void *clientData, int mask); +typedef void (Tcl_CloseProc) (void *data); +typedef void (Tcl_CmdDeleteProc) (void *clientData); +typedef int (Tcl_CmdProc) (void *clientData, Tcl_Interp *interp, int argc, const char *argv[]); -typedef void (Tcl_CmdTraceProc) (ClientData clientData, Tcl_Interp *interp, +typedef void (Tcl_CmdTraceProc) (void *clientData, Tcl_Interp *interp, int level, char *command, Tcl_CmdProc *proc, - ClientData cmdClientData, int argc, const char *argv[]); -typedef int (Tcl_CmdObjTraceProc) (ClientData clientData, Tcl_Interp *interp, + void *cmdClientData, int argc, const char *argv[]); +typedef int (Tcl_CmdObjTraceProc) (void *clientData, Tcl_Interp *interp, int level, const char *command, Tcl_Command commandInfo, int objc, struct Tcl_Obj *const *objv); -typedef void (Tcl_CmdObjTraceDeleteProc) (ClientData clientData); +typedef void (Tcl_CmdObjTraceDeleteProc) (void *clientData); typedef void (Tcl_DupInternalRepProc) (struct Tcl_Obj *srcPtr, struct Tcl_Obj *dupPtr); -typedef int (Tcl_EncodingConvertProc) (ClientData clientData, const char *src, +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) (ClientData clientData); +#define Tcl_EncodingFreeProc Tcl_FreeProc typedef int (Tcl_EventProc) (Tcl_Event *evPtr, int flags); -typedef void (Tcl_EventCheckProc) (ClientData clientData, int flags); -typedef int (Tcl_EventDeleteProc) (Tcl_Event *evPtr, ClientData clientData); -typedef void (Tcl_EventSetupProc) (ClientData clientData, int flags); -typedef void (Tcl_ExitProc) (ClientData clientData); -typedef void (Tcl_FileProc) (ClientData clientData, int mask); -typedef void (Tcl_FileFreeProc) (ClientData clientData); +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); +#define Tcl_ExitProc Tcl_FreeProc +typedef void (Tcl_FileProc) (void *clientData, int mask); +#define Tcl_FileFreeProc Tcl_FreeProc typedef void (Tcl_FreeInternalRepProc) (struct Tcl_Obj *objPtr); -typedef void (Tcl_FreeProc) (char *blockPtr); -typedef void (Tcl_IdleProc) (ClientData clientData); -typedef void (Tcl_InterpDeleteProc) (ClientData clientData, +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) (ClientData clientData, Tcl_Interp *interp, - Tcl_Value *args, Tcl_Value *resultPtr); -typedef void (Tcl_NamespaceDeleteProc) (ClientData clientData); -typedef int (Tcl_ObjCmdProc) (ClientData clientData, Tcl_Interp *interp, +typedef void (Tcl_NamespaceDeleteProc) (void *clientData); +typedef int (Tcl_ObjCmdProc) (void *clientData, Tcl_Interp *interp, int objc, struct Tcl_Obj *const *objv); typedef int (Tcl_PackageInitProc) (Tcl_Interp *interp); typedef int (Tcl_PackageUnloadProc) (Tcl_Interp *interp, int flags); typedef void (Tcl_PanicProc) (const char *format, ...); -typedef void (Tcl_TcpAcceptProc) (ClientData callbackData, Tcl_Channel chan, +typedef void (Tcl_TcpAcceptProc) (void *callbackData, Tcl_Channel chan, char *address, int port); -typedef void (Tcl_TimerProc) (ClientData clientData); +typedef void (Tcl_TimerProc) (void *clientData); typedef int (Tcl_SetFromAnyProc) (Tcl_Interp *interp, struct Tcl_Obj *objPtr); typedef void (Tcl_UpdateStringProc) (struct Tcl_Obj *objPtr); -typedef char * (Tcl_VarTraceProc) (ClientData clientData, Tcl_Interp *interp, +typedef char * (Tcl_VarTraceProc) (void *clientData, Tcl_Interp *interp, const char *part1, const char *part2, int flags); -typedef void (Tcl_CommandTraceProc) (ClientData clientData, Tcl_Interp *interp, +typedef void (Tcl_CommandTraceProc) (void *clientData, Tcl_Interp *interp, const char *oldName, const char *newName, int flags); typedef void (Tcl_CreateFileHandlerProc) (int fd, int mask, Tcl_FileProc *proc, - ClientData clientData); + void *clientData); typedef void (Tcl_DeleteFileHandlerProc) (int fd); -typedef void (Tcl_AlertNotifierProc) (ClientData clientData); +typedef void (Tcl_AlertNotifierProc) (void *clientData); typedef void (Tcl_ServiceModeHookProc) (int mode); -typedef ClientData (Tcl_InitNotifierProc) (void); -typedef void (Tcl_FinalizeNotifierProc) (ClientData clientData); +typedef void *(Tcl_InitNotifierProc) (void); +typedef void (Tcl_FinalizeNotifierProc) (void *clientData); typedef void (Tcl_MainLoopProc) (void); /* @@ -776,19 +633,19 @@ typedef union Tcl_ObjIntRep { /* The internal representation: */ */ typedef struct Tcl_Obj { - int refCount; /* When 0 the object will be freed. */ + size_t refCount; /* When 0 the object will be freed. */ char *bytes; /* This points to the first byte of the * object's string representation. The array * 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 * Tcl_GetString to get a pointer to the byte * array as a readonly value. */ - int length; /* The number of bytes at *bytes, not + size_t length; /* The number of bytes at *bytes, not * including the terminating null. */ const Tcl_ObjType *typePtr; /* Denotes the object's type. Always * corresponds to the type of the object's @@ -800,20 +657,11 @@ 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. + * The following type contains the state needed by Tcl_SaveResult. It + * is typically allocated on the stack. */ -typedef struct Tcl_SavedResult { - char *result; - Tcl_FreeProc *freeProc; - Tcl_Obj *objResultPtr; - char *appendResult; - int appendAvl; - int appendUsed; - char resultSpace[200+1]; -} Tcl_SavedResult; +typedef Tcl_Obj *Tcl_SavedResult; /* *---------------------------------------------------------------------------- @@ -829,7 +677,7 @@ typedef struct Tcl_Namespace { * is an synonym. */ char *fullName; /* The namespace's fully qualified name. This * starts with ::. */ - ClientData clientData; /* Arbitrary value associated with this + void *clientData; /* Arbitrary value associated with this * namespace. */ Tcl_NamespaceDeleteProc *deleteProc; /* Function invoked when deleting the @@ -901,13 +749,13 @@ typedef struct Tcl_CmdInfo { * Tcl_SetCmdInfo does not modify this * field. */ Tcl_ObjCmdProc *objProc; /* Command's object-based function. */ - ClientData objClientData; /* ClientData for object proc. */ + void *objClientData; /* ClientData for object proc. */ Tcl_CmdProc *proc; /* Command's string-based function. */ - ClientData clientData; /* ClientData for string proc. */ + void *clientData; /* ClientData for string proc. */ Tcl_CmdDeleteProc *deleteProc; /* Function to call when command is * deleted. */ - ClientData deleteData; /* Value to pass to deleteProc (usually the + void *deleteData; /* Value to pass to deleteProc (usually the * same as clientData). */ Tcl_Namespace *namespacePtr;/* Points to the namespace that contains this * command. Note that Tcl_SetCmdInfo will not @@ -927,9 +775,9 @@ typedef struct Tcl_CmdInfo { typedef struct Tcl_DString { char *string; /* Points to beginning of string: either * staticSpace below or a malloced array. */ - int length; /* Number of non-NULL characters in the + size_t length; /* Number of non-NULL characters in the * string. */ - int spaceAvl; /* Total number of bytes available for the + size_t spaceAvl; /* Total number of bytes available for the * string and its terminating NULL char. */ char staticSpace[TCL_DSTRING_STATIC_SIZE]; /* Space to use in common case where string is @@ -938,14 +786,11 @@ 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 - * specified in the "tcl_precision" variable, and the number of bytes of - * buffer space required by Tcl_PrintDouble. + * produced by Tcl_PrintDouble, and the number of bytes of buffer space + * required by Tcl_PrintDouble. */ #define TCL_MAX_PREC 17 @@ -1035,10 +880,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 @@ -1067,17 +908,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: */ @@ -1110,7 +940,7 @@ typedef struct Tcl_DString { */ #ifndef TCL_HASH_TYPE -# define TCL_HASH_TYPE unsigned +# define TCL_HASH_TYPE size_t #endif typedef struct Tcl_HashKeyType Tcl_HashKeyType; @@ -1132,10 +962,8 @@ 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. */ - ClientData clientData; /* Application stores something here with + size_t hash; /* Hash value. */ + void *clientData; /* Application stores something here with * Tcl_SetHashValue. */ union { /* Key has one of these forms: */ char *oneWordValue; /* One-word value for key. */ @@ -1223,16 +1051,16 @@ struct Tcl_HashTable { Tcl_HashEntry *staticBuckets[TCL_SMALL_HASH_TABLE]; /* Bucket array used for small tables (to * avoid mallocs and frees). */ - int numBuckets; /* Total number of buckets allocated at + size_t numBuckets; /* Total number of buckets allocated at * **bucketPtr. */ - int numEntries; /* Total number of entries present in + size_t numEntries; /* Total number of entries present in * table. */ - int rebuildSize; /* Enlarge table when numEntries gets to be + size_t rebuildSize; /* Enlarge table when numEntries gets to be * this large. */ + size_t mask; /* Mask value used in hashing function. */ int downShift; /* Shift count used in hashing function. * Designed to use high-order bits of * randomized keys. */ - int mask; /* Mask value used in hashing function. */ int keyType; /* Type of keys used in this table. It's * either TCL_CUSTOM_KEYS, TCL_STRING_KEYS, * TCL_ONE_WORD_KEYS, or an integer giving the @@ -1253,7 +1081,7 @@ struct Tcl_HashTable { typedef struct Tcl_HashSearch { Tcl_HashTable *tablePtr; /* Table being searched. */ - int nextIndex; /* Index of next bucket to be enumerated after + size_t nextIndex; /* Index of next bucket to be enumerated after * present one. */ Tcl_HashEntry *nextEntryPtr;/* Next entry to be enumerated in the current * bucket. */ @@ -1294,7 +1122,7 @@ typedef struct Tcl_HashSearch { typedef struct { void *next; /* Search position for underlying hash * table. */ - unsigned int epoch; /* Epoch marker for dictionary being searched, + size_t epoch; /* Epoch marker for dictionary being searched, * or 0 if search has terminated. */ Tcl_Dict dictionaryPtr; /* Reference to dictionary being searched. */ } Tcl_DictSearch; @@ -1353,15 +1181,15 @@ 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) */ -typedef void (Tcl_GetTimeProc) (Tcl_Time *timebuf, ClientData clientData); -typedef void (Tcl_ScaleTimeProc) (Tcl_Time *timebuf, ClientData clientData); +typedef void (Tcl_GetTimeProc) (Tcl_Time *timebuf, void *clientData); +typedef void (Tcl_ScaleTimeProc) (Tcl_Time *timebuf, void *clientData); /* *---------------------------------------------------------------------------- @@ -1397,18 +1225,12 @@ typedef void (Tcl_ScaleTimeProc) (Tcl_Time *timebuf, ClientData clientData); * interface. */ -#define TCL_CLOSE2PROC ((Tcl_DriverCloseProc *) 1) +#define TCL_CLOSE2PROC NULL /* * 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) /* @@ -1422,40 +1244,38 @@ typedef void (Tcl_ScaleTimeProc) (Tcl_Time *timebuf, ClientData clientData); * Typedefs for the various operations in a channel type: */ -typedef int (Tcl_DriverBlockModeProc) (ClientData instanceData, int mode); -typedef int (Tcl_DriverCloseProc) (ClientData instanceData, - Tcl_Interp *interp); -typedef int (Tcl_DriverClose2Proc) (ClientData instanceData, +typedef int (Tcl_DriverBlockModeProc) (void *instanceData, int mode); +typedef void Tcl_DriverCloseProc; +typedef int (Tcl_DriverClose2Proc) (void *instanceData, Tcl_Interp *interp, int flags); -typedef int (Tcl_DriverInputProc) (ClientData instanceData, char *buf, +typedef int (Tcl_DriverInputProc) (void *instanceData, char *buf, int toRead, int *errorCodePtr); -typedef int (Tcl_DriverOutputProc) (ClientData instanceData, +typedef int (Tcl_DriverOutputProc) (void *instanceData, const char *buf, int toWrite, int *errorCodePtr); -typedef int (Tcl_DriverSeekProc) (ClientData instanceData, long offset, - int mode, int *errorCodePtr); -typedef int (Tcl_DriverSetOptionProc) (ClientData instanceData, +typedef void Tcl_DriverSeekProc; +typedef int (Tcl_DriverSetOptionProc) (void *instanceData, Tcl_Interp *interp, const char *optionName, const char *value); -typedef int (Tcl_DriverGetOptionProc) (ClientData instanceData, +typedef int (Tcl_DriverGetOptionProc) (void *instanceData, Tcl_Interp *interp, const char *optionName, Tcl_DString *dsPtr); -typedef void (Tcl_DriverWatchProc) (ClientData instanceData, int mask); -typedef int (Tcl_DriverGetHandleProc) (ClientData instanceData, - int direction, ClientData *handlePtr); -typedef int (Tcl_DriverFlushProc) (ClientData instanceData); -typedef int (Tcl_DriverHandlerProc) (ClientData instanceData, +typedef void (Tcl_DriverWatchProc) (void *instanceData, int mask); +typedef int (Tcl_DriverGetHandleProc) (void *instanceData, + int direction, void **handlePtr); +typedef int (Tcl_DriverFlushProc) (void *instanceData); +typedef int (Tcl_DriverHandlerProc) (void *instanceData, int interestMask); -typedef Tcl_WideInt (Tcl_DriverWideSeekProc) (ClientData instanceData, +typedef Tcl_WideInt (Tcl_DriverWideSeekProc) (void *instanceData, Tcl_WideInt offset, int mode, int *errorCodePtr); /* * TIP #218, Channel Thread Actions */ -typedef void (Tcl_DriverThreadActionProc) (ClientData instanceData, +typedef void (Tcl_DriverThreadActionProc) (void *instanceData, int action); /* * TIP #208, File Truncation (etc.) */ -typedef int (Tcl_DriverTruncateProc) (ClientData instanceData, +typedef int (Tcl_DriverTruncateProc) (void *instanceData, Tcl_WideInt length); /* @@ -1475,17 +1295,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; @@ -1503,9 +1320,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. */ @@ -1513,26 +1327,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 @@ -1628,7 +1431,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); @@ -1637,13 +1440,13 @@ typedef Tcl_Obj * (Tcl_FSLinkProc) (Tcl_Obj *pathPtr, Tcl_Obj *toPtr, typedef int (Tcl_FSLoadFileProc) (Tcl_Interp *interp, Tcl_Obj *pathPtr, Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr); typedef int (Tcl_FSPathInFilesystemProc) (Tcl_Obj *pathPtr, - ClientData *clientDataPtr); + void **clientDataPtr); typedef Tcl_Obj * (Tcl_FSFilesystemPathTypeProc) (Tcl_Obj *pathPtr); typedef Tcl_Obj * (Tcl_FSFilesystemSeparatorProc) (Tcl_Obj *pathPtr); -typedef void (Tcl_FSFreeInternalRepProc) (ClientData clientData); -typedef ClientData (Tcl_FSDupInternalRepProc) (ClientData clientData); -typedef Tcl_Obj * (Tcl_FSInternalToNormalizedProc) (ClientData clientData); -typedef ClientData (Tcl_FSCreateInternalRepProc) (Tcl_Obj *pathPtr); +#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); typedef struct Tcl_FSVersion_ *Tcl_FSVersion; @@ -1673,7 +1476,7 @@ typedef struct Tcl_FSVersion_ *Tcl_FSVersion; typedef struct Tcl_Filesystem { const char *typeName; /* The name of the filesystem. */ - int structureLength; /* Length of this structure, so future binary + size_t structureLength; /* Length of this structure, so future binary * compatibility can be assured. */ Tcl_FSVersion version; /* Version of the filesystem type. */ Tcl_FSPathInFilesystemProc *pathInFilesystemProc; @@ -1835,8 +1638,8 @@ typedef struct Tcl_Token { int type; /* Type of token, such as TCL_TOKEN_WORD; see * below for valid types. */ const char *start; /* First character in token. */ - int size; /* Number of bytes in token. */ - int numComponents; /* If this token is composed of other tokens, + size_t size; /* Number of bytes in token. */ + size_t numComponents; /* If this token is composed of other tokens, * this field tells how many of them there are * (including components of components, etc.). * The component tokens immediately follow @@ -1902,7 +1705,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 @@ -1950,7 +1753,7 @@ typedef struct Tcl_Token { typedef struct Tcl_Parse { const char *commentStart; /* Pointer to # that begins the first of one * or more comments preceding the command. */ - int commentSize; /* Number of bytes in comments (up through + size_t commentSize; /* Number of bytes in comments (up through * newline character that terminates the last * comment). If there were no comments, this * field is 0. */ @@ -2018,10 +1821,10 @@ 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. */ - ClientData clientData; /* Arbitrary value associated with encoding + void *clientData; /* Arbitrary value associated with encoding * type. Passed to conversion functions. */ int nullSize; /* Number of zero bytes that signify * end-of-string in this encoding. This number @@ -2116,14 +1919,14 @@ 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 -#define TCL_UTF_MAX 3 +#define TCL_UTF_MAX 4 #endif /* @@ -2169,8 +1972,8 @@ typedef struct Tcl_Config { * command- or time-limit is exceeded by an interpreter. */ -typedef void (Tcl_LimitHandlerProc) (ClientData clientData, Tcl_Interp *interp); -typedef void (Tcl_LimitHandlerDeleteProc) (ClientData clientData); +typedef void (Tcl_LimitHandlerProc) (void *clientData, Tcl_Interp *interp); +typedef void (Tcl_LimitHandlerDeleteProc) (void *clientData); #if 0 /* @@ -2208,7 +2011,7 @@ typedef struct { * depends on type.*/ const char *helpStr; /* Documentation message describing this * option. */ - ClientData clientData; /* Word to pass to function callbacks. */ + void *clientData; /* Word to pass to function callbacks. */ } Tcl_ArgvInfo; /* @@ -2231,9 +2034,9 @@ typedef struct { * argument types: */ -typedef int (Tcl_ArgvFuncProc)(ClientData clientData, Tcl_Obj *objPtr, +typedef int (Tcl_ArgvFuncProc)(void *clientData, Tcl_Obj *objPtr, void *dstPtr); -typedef int (Tcl_ArgvGenFuncProc)(ClientData clientData, Tcl_Interp *interp, +typedef int (Tcl_ArgvGenFuncProc)(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv, void *dstPtr); /* @@ -2306,19 +2109,19 @@ typedef int (Tcl_ArgvGenFuncProc)(ClientData clientData, Tcl_Interp *interp, #define TCL_TCPSERVER_REUSEPORT (1<<1) /* - * Constants for special int-typed values, see TIP #494 + * Constants for special size_t-typed values, see TIP #494 */ -#define TCL_IO_FAILURE (-1) -#define TCL_AUTO_LENGTH (-1) -#define TCL_INDEX_NONE (-1) +#define TCL_IO_FAILURE ((size_t)-1) +#define TCL_AUTO_LENGTH ((size_t)-1) +#define TCL_INDEX_NONE ((size_t)-1) /* *---------------------------------------------------------------------------- * Single public declaration for NRE. */ -typedef int (Tcl_NRPostProc) (ClientData data[], Tcl_Interp *interp, +typedef int (Tcl_NRPostProc) (void *data[], Tcl_Interp *interp, int result); /* @@ -2327,7 +2130,7 @@ typedef int (Tcl_NRPostProc) (ClientData data[], Tcl_Interp *interp, * stubs tables. */ -#define TCL_STUB_MAGIC ((int) 0xFCA3BACF) +#define TCL_STUB_MAGIC ((int) 0xFCA3BACB + (int) sizeof(void *)) /* * The following function is required to be defined in all stubs aware @@ -2341,9 +2144,9 @@ const char * Tcl_InitStubs(Tcl_Interp *interp, const char *version, const char * TclTomMathInitializeStubs(Tcl_Interp *interp, const char *version, int epoch, int revision); #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 *)0) +# define Tcl_ConsolePanic NULL #endif #ifdef USE_TCL_STUBS @@ -2377,12 +2180,20 @@ 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(int argc, char **argv, +EXTERN TCL_NORETURN void Tcl_MainEx(int argc, char **argv, Tcl_AppInitProc *appInitProc, Tcl_Interp *interp); EXTERN const char * Tcl_PkgInitStubsCheck(Tcl_Interp *interp, const char *version, int exact); EXTERN void Tcl_InitSubsystems(void); EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr); +EXTERN void Tcl_FindExecutable(const char *argv0); +EXTERN void Tcl_SetPanicProc( + TCL_NORETURN1 Tcl_PanicProc *panicProc); +EXTERN void Tcl_StaticPackage(Tcl_Interp *interp, + const char *pkgName, + Tcl_PackageInitProc *initProc, + Tcl_PackageInitProc *safeInitProc); +EXTERN Tcl_ExitProc *Tcl_SetExitProc(TCL_NORETURN1 Tcl_ExitProc *proc); #ifdef _WIN32 EXTERN int TclZipfs_AppHook(int *argc, wchar_t ***argv); #else @@ -2412,25 +2223,26 @@ EXTERN int 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, @@ -2438,16 +2250,6 @@ EXTERN int 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 @@ -2527,7 +2329,7 @@ EXTERN int TclZipfs_AppHook(int *argc, char ***argv); */ #define Tcl_GetHashValue(h) ((h)->clientData) -#define Tcl_SetHashValue(h, value) ((h)->clientData = (ClientData) (value)) +#define Tcl_SetHashValue(h, value) ((h)->clientData = (void *) (value)) #define Tcl_GetHashKey(tablePtr, h) \ ((void *) (((tablePtr)->keyType == TCL_ONE_WORD_KEYS || \ (tablePtr)->keyType == TCL_CUSTOM_PTR_KEYS) \ @@ -2539,45 +2341,11 @@ EXTERN int TclZipfs_AppHook(int *argc, char ***argv); * hash tables: */ -#undef Tcl_FindHashEntry #define Tcl_FindHashEntry(tablePtr, key) \ (*((tablePtr)->findProc))(tablePtr, (const char *)(key)) -#undef Tcl_CreateHashEntry #define Tcl_CreateHashEntry(tablePtr, key, newPtr) \ (*((tablePtr)->createProc))(tablePtr, (const char *)(key), newPtr) -/* - *---------------------------------------------------------------------------- - * 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 4a84255..9291826 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/tclAssembly.c b/generic/tclAssembly.c index 605758b..4783811 100644 --- a/generic/tclAssembly.c +++ b/generic/tclAssembly.c @@ -409,7 +409,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 +436,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}, @@ -858,7 +856,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 @@ -990,7 +988,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 +1075,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) { @@ -1090,8 +1088,8 @@ TclAssembleCode( #ifdef TCL_COMPILE_DEBUG if ((tclTraceCompile >= 2) && (envPtr->procPtr == NULL)) { - printf(" %4ld Assembling: ", - (long)(envPtr->codeNext - envPtr->codeStart)); + printf(" %4" TCL_Z_MODIFIER "d Assembling: ", + envPtr->codeNext - envPtr->codeStart); TclPrintSource(stdout, parsePtr->commandStart, TclMin(instLen, 55)); printf("\n"); @@ -1217,14 +1215,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,7 +1268,7 @@ 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 */ @@ -1543,7 +1541,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; @@ -1937,7 +1935,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)); @@ -2002,7 +2000,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 +2065,7 @@ DeleteMirrorJumpTable( Tcl_SetHashValue(entry, NULL); } Tcl_DeleteHashTable(jtHashPtr); - ckfree(jtPtr); + Tcl_Free(jtPtr); } /* @@ -2311,7 +2309,7 @@ FindLocalVar( * source code. */ Tcl_Obj* varNameObj; /* Name of the variable */ const char* varNameStr; - int varNameLen; + size_t varNameLen; int localVar; /* Index of the variable in the LVT */ if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &varNameObj) != TCL_OK) { @@ -2651,7 +2649,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 +2911,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 +3116,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); @@ -3929,8 +3927,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 +3967,8 @@ BuildExceptionRanges( /* Free temp storage */ - ckfree(catchIndices); - ckfree(catches); + Tcl_Free(catchIndices); + Tcl_Free(catches); return TCL_OK; } diff --git a/generic/tclAsync.c b/generic/tclAsync.c index c432e4f..8b0b61e 100644 --- a/generic/tclAsync.c +++ b/generic/tclAsync.c @@ -118,7 +118,7 @@ Tcl_AsyncCreate( 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->proc = proc; @@ -310,7 +310,7 @@ Tcl_AsyncDelete( } } Tcl_MutexUnlock(&tsdPtr->asyncMutex); - ckfree(asyncPtr); + Tcl_Free(asyncPtr); } /* diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 88e51be..e12381c 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 */ - ClientData clientData; /* Client data for the handler function */ -} OldMathFuncData; - -/* * This is the script cancellation struct and hash table. The hash table is * used to keep track of the information necessary to process script * cancellation requests, including the original interp, asynchronous handler @@ -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. */ ClientData 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(ClientData clientData); -#endif /* !defined(TCL_NO_DEPRECATED) */ static void ProcessUnexpectedResult(Tcl_Interp *interp, int returnCode); static int RewindCoroutine(CoroutineData *corPtr, int result); @@ -288,9 +272,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}, @@ -656,16 +637,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 @@ -698,25 +676,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; @@ -729,10 +705,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); @@ -765,12 +741,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; @@ -796,11 +766,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 */ @@ -834,7 +802,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; @@ -862,9 +830,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); @@ -911,12 +879,6 @@ Tcl_CreateInterp(void) #endif /* TCL_COMPILE_STATS */ /* - * Initialise the stub table pointer. - */ - - iPtr->stubTable = &tclStubs; - - /* * Initialize the ensemble error message rewriting support. */ @@ -963,7 +925,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; @@ -1093,7 +1055,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; @@ -1151,11 +1113,6 @@ 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 @@ -1177,11 +1134,11 @@ Tcl_CreateInterp(void) Tcl_PkgProvideEx(interp, "Tcl", TCL_PATCH_LEVEL, &tclStubs); 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)); } /* @@ -1191,10 +1148,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 @@ -1208,7 +1165,7 @@ DeleteOpCmdClientData( { TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)clientData; - ckfree(occdPtr); + Tcl_Free(occdPtr); } /* @@ -1326,7 +1283,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); @@ -1341,7 +1298,7 @@ TclHideUnsafeCommands( unsafePtr->ensembleNsName) != TCL_OK) { Tcl_Panic("problem making '%s' safe: %s", unsafePtr->ensembleNsName, - Tcl_GetString(Tcl_GetObjResult(interp))); + Tcl_GetStringResult(interp)); } } } @@ -1417,14 +1374,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); @@ -1473,7 +1430,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; } @@ -1513,14 +1470,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; @@ -1565,7 +1522,7 @@ Tcl_DeleteAssocData( if (dPtr->proc != NULL) { dPtr->proc(dPtr->clientData, interp); } - ckfree(dPtr); + Tcl_Free(dPtr); Tcl_DeleteHashEntry(hPtr); } @@ -1761,9 +1718,9 @@ DeleteInterpProc( if (cancelInfo != NULL) { if (cancelInfo->result != NULL) { - ckfree(cancelInfo->result); + Tcl_Free(cancelInfo->result); } - ckfree(cancelInfo); + Tcl_Free(cancelInfo); } Tcl_DeleteHashEntry(hPtr); @@ -1818,7 +1775,7 @@ DeleteInterpProc( Tcl_DeleteCommandFromToken(interp, (Tcl_Command)Tcl_GetHashValue(hPtr)); } Tcl_DeleteHashTable(hTablePtr); - ckfree(hTablePtr); + Tcl_Free(hTablePtr); } /* @@ -1839,10 +1796,10 @@ DeleteInterpProc( if (dPtr->proc != NULL) { dPtr->proc(dPtr->clientData, interp); } - ckfree(dPtr); + Tcl_Free(dPtr); } Tcl_DeleteHashTable(hTablePtr); - ckfree(hTablePtr); + Tcl_Free(hTablePtr); } /* @@ -1854,7 +1811,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); @@ -1863,10 +1820,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); @@ -1888,12 +1841,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); @@ -1911,8 +1858,8 @@ DeleteInterpProc( resPtr = iPtr->resolverPtr; while (resPtr) { nextResPtr = resPtr->nextPtr; - ckfree(resPtr->name); - ckfree(resPtr); + Tcl_Free(resPtr->name); + Tcl_Free(resPtr); resPtr = nextResPtr; } @@ -1939,13 +1886,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; /* @@ -1961,18 +1908,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; /* @@ -1991,7 +1938,7 @@ DeleteInterpProc( } Tcl_DeleteHashTable(iPtr->lineLAPtr); - ckfree(iPtr->lineLAPtr); + Tcl_Free(iPtr->lineLAPtr); iPtr->lineLAPtr = NULL; if (iPtr->lineLABCPtr->numEntries && !TclInExit()) { @@ -2004,7 +1951,7 @@ DeleteInterpProc( } Tcl_DeleteHashTable(iPtr->lineLABCPtr); - ckfree(iPtr->lineLABCPtr); + Tcl_Free(iPtr->lineLABCPtr); iPtr->lineLABCPtr = NULL; /* @@ -2015,7 +1962,7 @@ DeleteInterpProc( Tcl_DeleteHashTable(&iPtr->varTraces); Tcl_DeleteHashTable(&iPtr->varSearches); - ckfree(iPtr); + Tcl_Free(iPtr); } /* @@ -2119,7 +2066,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; } @@ -2485,7 +2432,7 @@ Tcl_CreateCommand( * infinite loop). */ - ckfree(Tcl_GetHashValue(hPtr)); + Tcl_Free(Tcl_GetHashValue(hPtr)); } if (!deleted) { @@ -2510,7 +2457,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; @@ -2568,7 +2515,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 @@ -2677,24 +2623,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. @@ -2730,7 +2659,7 @@ TclCreateObjCommandInNs( * infinite loop). */ - ckfree(Tcl_GetHashValue(hPtr)); + Tcl_Free(Tcl_GetHashValue(hPtr)); } if (!deleted) { @@ -2755,7 +2684,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; @@ -2903,13 +2832,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. */ @@ -2989,7 +2911,7 @@ TclRenameCommand( } cmdNsPtr = cmdPtr->nsPtr; - TclNewObj(oldFullName); + oldFullName = Tcl_NewObj(); Tcl_IncrRefCount(oldFullName); Tcl_GetCommandFullName(interp, cmd, oldFullName); @@ -3519,7 +3441,7 @@ Tcl_DeleteCommandFromToken( CommandTrace *nextPtr = tracePtr->nextPtr; if (tracePtr->refCount-- <= 1) { - ckfree(tracePtr); + Tcl_Free(tracePtr); } tracePtr = nextPtr; } @@ -3571,10 +3493,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); @@ -3713,7 +3635,7 @@ CallCommandTraces( oldName, newName, flags); cmdPtr->flags &= ~tracePtr->flags; if (tracePtr->refCount-- <= 1) { - ckfree(tracePtr); + Tcl_Free(tracePtr); } } @@ -3845,374 +3767,13 @@ 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. */ - ClientData 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)); - memcpy(data->argTypes, argTypes, numArgs * sizeof(Tcl_ValueType)); - data->clientData = clientData; - - Tcl_DStringInit(&bigName); - TclDStringAppendLiteral(&bigName, "::tcl::mathfunc::"); - Tcl_DStringAppend(&bigName, name, -1); - - Tcl_CreateObjCommand(interp, Tcl_DStringValue(&bigName), - OldMathFuncProc, data, OldMathFuncDeleteProc); - Tcl_DStringFree(&bigName); -} - -/* - *---------------------------------------------------------------------- - * - * OldMathFuncProc -- - * - * Dispatch to a math function created with Tcl_CreateMathFunc - * - * Results: - * Returns a standard Tcl result. - * - * Side effects: - * Whatever the math function does. - * - *---------------------------------------------------------------------- - */ - -static int -OldMathFuncProc( - ClientData clientData, /* Pointer to OldMathFuncData describing the - * function being called */ - Tcl_Interp *interp, /* Tcl interpreter */ - int objc, /* Actual parameter count */ - Tcl_Obj *const *objv) /* Parameter vector */ -{ - Tcl_Obj *valuePtr; - OldMathFuncData *dataPtr = (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 TclGetNumberFromObj? */ - valuePtr = objv[j]; - result = Tcl_GetDoubleFromObj(NULL, valuePtr, &d); -#ifdef ACCEPT_NAN - if (result != TCL_OK) { - const Tcl_ObjIntRep *irPtr - = TclFetchIntRep(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( - ClientData 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, - ClientData *clientDataPtr) -{ - Tcl_Obj *cmdNameObj; - Command *cmdPtr; - - /* - * Get the command that implements the math function. - */ - - TclNewLiteralStringObj(cmdNameObj, "tcl::mathfunc::"); - Tcl_AppendToObj(cmdNameObj, name, -1); - Tcl_IncrRefCount(cmdNameObj); - cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdNameObj); - Tcl_DecrRefCount(cmdNameObj); - - /* - * Report unknown functions. - */ - - if (cmdPtr == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "unknown math function \"%s\"", name)); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "MATHFUNC", name, NULL); - *numArgsPtr = -1; - *argTypesPtr = NULL; - *procPtr = NULL; - *clientDataPtr = NULL; - return TCL_ERROR; + Tcl_Free(cmdPtr); } - - /* - * 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_DecrRefCount(script); - Tcl_RestoreInterpState(interp, state); - - return result; -} -#endif /* !defined(TCL_NO_DEPRECATED) */ - -/* - *---------------------------------------------------------------------- - * * TclInterpReady -- * * Check if an interpreter is ready to eval commands or scripts, i.e., if @@ -4223,7 +3784,7 @@ Tcl_ListMathFuncs( * otherwise. * * Side effects: - * The interpreters object and string results are cleared. + * The interpreter's result is cleared. * *---------------------------------------------------------------------- */ @@ -4235,8 +3796,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); @@ -4385,7 +3946,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 @@ -4493,7 +4054,7 @@ Tcl_CancelEval( if (resultObjPtr != NULL) { result = TclGetStringFromObj(resultObjPtr, &cancelInfo->length); - cancelInfo->result = (char *)ckrealloc(cancelInfo->result,cancelInfo->length); + cancelInfo->result = (char *)Tcl_Realloc(cancelInfo->result,cancelInfo->length); memcpy(cancelInfo->result, result, cancelInfo->length); TclDecrRefCount(resultObjPtr); /* Discard their result object. */ } else { @@ -4820,30 +4381,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; @@ -5003,7 +4540,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]; @@ -5159,8 +4696,8 @@ TEOV_RunEnterTraces( { Interp *iPtr = (Interp *) interp; Command *cmdPtr = *cmdPtrPtr; - unsigned int newEpoch, cmdEpoch = cmdPtr->cmdEpoch; - int length, traceCode = TCL_OK; + size_t length, newEpoch, cmdEpoch = cmdPtr->cmdEpoch; + int traceCode = TCL_OK; const char *command = TclGetStringFromObj(commandPtr, &length); /* @@ -5212,7 +4749,7 @@ TEOV_RunLeaveTraces( Tcl_Obj *commandPtr = (Tcl_Obj *)data[1]; Command *cmdPtr = (Command *)data[2]; Tcl_Obj **objv = (Tcl_Obj **)data[3]; - int length; + size_t length; const char *command = TclGetStringFromObj(commandPtr, &length); if (!(cmdPtr->flags & CMD_DYING)) { @@ -5295,63 +4832,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 */ - /* *---------------------------------------------------------------------- * @@ -5378,7 +4865,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 @@ -5393,7 +4880,7 @@ 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 @@ -5424,7 +4911,8 @@ TclEvalEx( Tcl_Obj **objv, **objvSpace; int *expand, *lines, *lineSpace; Tcl_Token *tokenPtr; - int commandLength, bytesLeft, expandRequested, code = TCL_OK; + int bytesLeft, expandRequested, code = TCL_OK; + 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); @@ -5458,7 +4946,7 @@ TclEvalEx( } } - if (numBytes < 0) { + if (numBytes == TCL_INDEX_NONE) { numBytes = strlen(script); } Tcl_ResetResult(interp); @@ -5575,9 +5063,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; @@ -5663,8 +5151,8 @@ 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; @@ -5691,10 +5179,10 @@ TclEvalEx( objv += objIdx+1; if (copy != stackObjArray) { - ckfree(copy); + Tcl_Free(copy); } if (lcopy != linesStack) { - ckfree(lcopy); + Tcl_Free(lcopy); } } @@ -5739,9 +5227,9 @@ TclEvalEx( } objectsUsed = 0; if (objvSpace != stackObjArray) { - ckfree(objvSpace); + Tcl_Free(objvSpace); objvSpace = stackObjArray; - ckfree(lineSpace); + Tcl_Free(lineSpace); lineSpace = linesStack; } @@ -5751,7 +5239,7 @@ TclEvalEx( */ if (expand != expandStack) { - ckfree(expand); + Tcl_Free(expand); expand = expandStack; } } @@ -5817,11 +5305,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; @@ -5985,7 +5473,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; @@ -6045,7 +5533,7 @@ TclArgumentRelease( continue; } - ckfree(cfwPtr); + Tcl_Free(cfwPtr); Tcl_DeleteHashEntry(hPtr); } } @@ -6078,7 +5566,7 @@ TclArgumentBCEnter( void *codePtr, CmdFrame *cfPtr, int cmd, - int pc) + size_t pc) { ExtCmdLoc *eclPtr; int word; @@ -6127,7 +5615,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]; @@ -6205,7 +5693,7 @@ TclArgumentBCRelease( Tcl_DeleteHashEntry(hPtr); } - ckfree(cfwPtr); + Tcl_Free(cfwPtr); cfwPtr = nextPtr; } @@ -6287,83 +5775,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, -1, 0); - - /* - * For backwards compatibility with old C code that predates the object - * system in Tcl 8.0, we have to mirror the object result back into the - * string result (some callers may expect it there). - */ - - (void) Tcl_GetStringResult(interp); - return code; -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_EvalObj, Tcl_GlobalEvalObj -- - * - * These functions are deprecated but we keep them around for backwards - * compatibility reasons. - * - * Results: - * See the functions they call. - * - * Side effects: - * See the functions they call. - * - *---------------------------------------------------------------------- - */ - -#undef Tcl_EvalObj -int -Tcl_EvalObj( - Tcl_Interp *interp, - Tcl_Obj *objPtr) -{ - return Tcl_EvalObjEx(interp, objPtr, 0); -} -#undef Tcl_GlobalEvalObj -int -Tcl_GlobalEvalObj( - Tcl_Interp *interp, - Tcl_Obj *objPtr) -{ - return Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL); -} -#endif /* TCL_NO_DEPRECATED */ - -/* - *---------------------------------------------------------------------- - * * Tcl_EvalObjEx, TclEvalObjEx -- * * Execute Tcl commands stored in a Tcl object. These commands are @@ -6554,7 +5965,7 @@ TclNREvalObjEx( */ const char *script; - int numSrcBytes; + size_t numSrcBytes; /* * Now we check if we have data about invisible continuation lines for @@ -6608,7 +6019,7 @@ TEOEx_ByteCodeCallback( } if ((result != TCL_OK) && (result != TCL_ERROR) && !allowExceptions) { const char *script; - int numSrcBytes; + size_t numSrcBytes; ProcessUnexpectedResult(interp, result); result = TCL_ERROR; @@ -6746,9 +6157,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; } @@ -6775,9 +6183,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; } @@ -6803,14 +6208,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; } } @@ -7128,12 +6525,6 @@ Tcl_ExprString( Tcl_DecrRefCount(resultPtr); } } - - /* - * Force the string rep of the interp result. - */ - - (void) Tcl_GetStringResult(interp); return code; } @@ -7156,82 +6547,17 @@ Tcl_ExprString( *---------------------------------------------------------------------- */ -#undef Tcl_AddObjErrorInfo void Tcl_AppendObjToErrorInfo( Tcl_Interp *interp, /* Interpreter to which error information * pertains. */ Tcl_Obj *objPtr) /* Message to record. */ { - const char *message = TclGetString(objPtr); + size_t length; + const char *message = TclGetStringFromObj(objPtr, &length); + Interp *iPtr = (Interp *) interp; Tcl_IncrRefCount(objPtr); - Tcl_AddObjErrorInfo(interp, message, objPtr->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 @@ -7240,20 +6566,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); @@ -7272,39 +6585,42 @@ 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. * * Results: * A standard Tcl return result. An error message or other result may be - * left in the interp's result. + * left in the interp. * * Side effects: * Depends on what was done by the command. * - *--------------------------------------------------------------------------- + *---------------------------------------------------------------------- */ int -Tcl_VarEvalVA( - Tcl_Interp *interp, /* Interpreter in which to evaluate command */ - va_list argList) /* Variable argument list. */ +Tcl_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); @@ -7324,77 +6640,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 @@ -7892,7 +7137,7 @@ ExprAbsFunc( goto unChanged; } else if (l == 0) { if (TclHasStringRep(objv[1])) { - int numBytes; + size_t numBytes; const char *bytes = TclGetStringFromObj(objv[1], &numBytes); while (numBytes) { @@ -9506,7 +8751,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; } @@ -9565,7 +8810,7 @@ NRCoroutineExitCallback( */ Tcl_DeleteHashTable(corPtr->lineLABCPtr); - ckfree(corPtr->lineLABCPtr); + Tcl_Free(corPtr->lineLABCPtr); corPtr->lineLABCPtr = NULL; RESTORE_CONTEXT(corPtr->caller); @@ -9960,7 +9205,7 @@ InjectHandler( * I don't think this is reachable... */ - Tcl_ListObjAppendElement(NULL, listPtr, Tcl_NewWideIntObj(nargs)); + Tcl_ListObjAppendElement(NULL, listPtr, Tcl_NewIntObj(nargs)); } Tcl_ListObjAppendElement(NULL, listPtr, Tcl_GetObjResult(interp)); } @@ -10179,7 +9424,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, @@ -10201,7 +9446,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 f53c707..3d12e24 100644 --- a/generic/tclBinary.c +++ b/generic/tclBinary.c @@ -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 @@ -64,7 +64,7 @@ static int FormatNumber(Tcl_Interp *interp, int type, 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, @@ -73,7 +73,7 @@ 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 length, int type); + size_t length, int type); /* Binary ensemble commands */ static int BinaryFormatCmd(ClientData clientData, Tcl_Interp *interp, @@ -266,13 +266,13 @@ const Tcl_ObjType tclByteArrayType = { * fewer mallocs. */ -typedef struct ByteArray { - unsigned int bad; /* Index of the character that is a nonbyte. +typedef struct { + size_t bad; /* Index of the character that is a nonbyte. * If all characters are bytes, bad = used, * though then we should never read it. */ - unsigned int used; /* The number of bytes used in the byte + size_t used; /* The number of bytes used in the byte * array. */ - unsigned int allocated; /* The amount of space actually allocated + 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 @@ -283,8 +283,8 @@ typedef struct ByteArray { (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) @@ -316,8 +316,7 @@ Tcl_Obj * Tcl_NewByteArrayObj( const unsigned char *bytes, /* The array of bytes used to initialize the * new object. */ - int length) /* Length of the array of bytes, which must be - * >= 0. */ + size_t length) /* Length of the array of bytes */ { #ifdef TCL_MEM_DEBUG return Tcl_DbNewByteArrayObj(bytes, length, "unknown", 0); @@ -360,8 +359,7 @@ Tcl_Obj * Tcl_DbNewByteArrayObj( const unsigned char *bytes, /* The array of bytes used to initialize the * new object. */ - int length, /* Length of the array of bytes, which must be - * >= 0. */ + size_t length, /* Length of the array of bytes. */ 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 @@ -378,7 +376,7 @@ Tcl_Obj * Tcl_DbNewByteArrayObj( const unsigned char *bytes, /* The array of bytes used to initialize the * new object. */ - int length, /* Length of the array of bytes, which must be + size_t length, /* Length of the array of bytes, which must be * >= 0. */ TCL_UNUSED(const char *) /*file*/, TCL_UNUSED(int) /*line*/) @@ -410,7 +408,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 length > 0. */ - int length) /* Length of the array of bytes, which must + size_t length) /* Length of the array of bytes, which must * be >= 0. */ { ByteArray *byteArrayPtr; @@ -421,10 +419,7 @@ Tcl_SetByteArrayObj( } TclInvalidateStringRep(objPtr); - if (length < 0) { - length = 0; - } - byteArrayPtr = (ByteArray *)ckalloc(BYTEARRAY_SIZE(length)); + byteArrayPtr = (ByteArray *)Tcl_Alloc(BYTEARRAY_SIZE(length)); byteArrayPtr->bad = length; byteArrayPtr->used = length; byteArrayPtr->allocated = length; @@ -458,7 +453,7 @@ unsigned char * TclGetBytesFromObj( Tcl_Interp *interp, /* For error reporting */ Tcl_Obj *objPtr, /* Value to extract from */ - int *lengthPtr) /* If non-NULL, filled with length of the + size_t *lengthPtr) /* If non-NULL, filled with length of the * array of bytes in the ByteArray object. */ { ByteArray *baPtr; @@ -478,7 +473,7 @@ TclGetBytesFromObj( TclUtfToUCS4(nonbyte, &ucs4); Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "expected byte sequence but character %d " + "expected byte sequence but character %" TCL_Z_MODIFIER "u " "was '%1s' (U+%06X)", baPtr->bad, nonbyte, ucs4)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "BYTES", NULL); } @@ -517,23 +512,35 @@ Tcl_GetByteArrayFromObj( int *lengthPtr) /* If non-NULL, filled with length of the * array of bytes in the ByteArray object. */ { - ByteArray *baPtr; - const Tcl_ObjIntRep *irPtr; - unsigned char *result = TclGetBytesFromObj(NULL, objPtr, lengthPtr); + size_t numBytes = 0; + unsigned char *bytes = TclGetBytesFromObj(NULL, objPtr, &numBytes); - if (result) { - return result; - } + if (bytes == NULL) { + ByteArray *baPtr; + const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objPtr, &tclByteArrayType); - irPtr = TclFetchIntRep(objPtr, &tclByteArrayType); - assert(irPtr != NULL); + assert(irPtr != NULL); - baPtr = GET_BYTEARRAY(irPtr); + baPtr = GET_BYTEARRAY(irPtr); + bytes = baPtr->bytes; + numBytes = baPtr->used; + } - if (lengthPtr != NULL) { - *lengthPtr = baPtr->used; + /* Macro TclGetByteArrayFromObj passes NULL for lengthPtr as + * a trick to get around changing size. */ + if (lengthPtr) { + if (numBytes > INT_MAX) { + /* Caller asked for an int length, but true length is outside + * the int range. This case will be developed out of existence + * in Tcl 9. As interim measure, fail. */ + + *lengthPtr = 0; + return NULL; + } else { + *lengthPtr = (int) numBytes; + } } - return baPtr->bytes; + return bytes; } /* @@ -561,15 +568,11 @@ Tcl_GetByteArrayFromObj( unsigned char * Tcl_SetByteArrayLength( Tcl_Obj *objPtr, /* The ByteArray object. */ - int length) /* New length for internal byte array. */ + size_t length) /* New length for internal byte array. */ { ByteArray *byteArrayPtr; - unsigned newLength; Tcl_ObjIntRep *irPtr; - assert(length >= 0); - newLength = (unsigned int)length; - if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayLength"); } @@ -587,15 +590,15 @@ Tcl_SetByteArrayLength( } byteArrayPtr = GET_BYTEARRAY(irPtr); - if (newLength > byteArrayPtr->allocated) { - byteArrayPtr = (ByteArray *)ckrealloc(byteArrayPtr, BYTEARRAY_SIZE(newLength)); - byteArrayPtr->allocated = newLength; + if (length > byteArrayPtr->allocated) { + byteArrayPtr = (ByteArray *)Tcl_Realloc(byteArrayPtr, BYTEARRAY_SIZE(length)); + byteArrayPtr->allocated = length; SET_BYTEARRAY(irPtr, byteArrayPtr); } TclInvalidateStringRep(objPtr); objPtr->typePtr = &properByteArrayType; - byteArrayPtr->bad = newLength; - byteArrayPtr->used = newLength; + byteArrayPtr->bad = length; + byteArrayPtr->used = length; return byteArrayPtr->bytes; } @@ -634,11 +637,11 @@ SetByteArrayFromAny( return TCL_OK; } - src = TclGetString(objPtr); - length = bad = objPtr->length; + src = TclGetStringFromObj(objPtr, &length); + bad = length; srcEnd = src + length; - byteArrayPtr = (ByteArray *)ckalloc(BYTEARRAY_SIZE(length)); + byteArrayPtr = (ByteArray *)Tcl_Alloc(BYTEARRAY_SIZE(length)); for (dst = byteArrayPtr->bytes; src < srcEnd; ) { src += TclUtfToUniChar(src, &ch); if ((bad == length) && (ch > 255)) { @@ -683,14 +686,14 @@ static void FreeByteArrayInternalRep( Tcl_Obj *objPtr) /* Object with internal rep to free. */ { - ckfree(GET_BYTEARRAY(TclFetchIntRep(objPtr, &tclByteArrayType))); + Tcl_Free(GET_BYTEARRAY(TclFetchIntRep(objPtr, &tclByteArrayType))); } static void FreeProperByteArrayInternalRep( Tcl_Obj *objPtr) /* Object with internal rep to free. */ { - ckfree(GET_BYTEARRAY(TclFetchIntRep(objPtr, &properByteArrayType))); + Tcl_Free(GET_BYTEARRAY(TclFetchIntRep(objPtr, &properByteArrayType))); } /* @@ -715,14 +718,14 @@ DupByteArrayInternalRep( 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_ObjIntRep ir; srcArrayPtr = GET_BYTEARRAY(TclFetchIntRep(srcPtr, &tclByteArrayType)); length = srcArrayPtr->used; - copyArrayPtr = (ByteArray *)ckalloc(BYTEARRAY_SIZE(length)); + copyArrayPtr = (ByteArray *)Tcl_Alloc(BYTEARRAY_SIZE(length)); copyArrayPtr->bad = srcArrayPtr->bad; copyArrayPtr->used = length; copyArrayPtr->allocated = length; @@ -744,7 +747,7 @@ DupProperByteArrayInternalRep( srcArrayPtr = GET_BYTEARRAY(TclFetchIntRep(srcPtr, &properByteArrayType)); length = srcArrayPtr->used; - copyArrayPtr = (ByteArray *)ckalloc(BYTEARRAY_SIZE(length)); + copyArrayPtr = (ByteArray *)Tcl_Alloc(BYTEARRAY_SIZE(length)); copyArrayPtr->bad = length; copyArrayPtr->used = length; copyArrayPtr->allocated = length; @@ -779,21 +782,18 @@ UpdateStringOfByteArray( const Tcl_ObjIntRep *irPtr = TclFetchIntRep(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); @@ -833,16 +833,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_ObjIntRep *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"); } @@ -854,8 +854,6 @@ TclAppendBytesToByteArray( return; } - length = (unsigned int) len; - irPtr = TclFetchIntRep(objPtr, &properByteArrayType); if (irPtr == NULL) { irPtr = TclFetchIntRep(objPtr, &tclByteArrayType); @@ -869,18 +867,18 @@ TclAppendBytesToByteArray( } byteArrayPtr = GET_BYTEARRAY(irPtr); - if (length > INT_MAX - byteArrayPtr->used) { - Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); + if (len > UINT_MAX - byteArrayPtr->used) { + Tcl_Panic("max size for a Tcl value (%u bytes) exceeded", UINT_MAX); } - needed = byteArrayPtr->used + length; + needed = byteArrayPtr->used + len; /* * If we need to, resize the allocated space in the byte array. */ if (needed > byteArrayPtr->allocated) { ByteArray *ptr = NULL; - unsigned int attempt; + size_t attempt; if (needed <= INT_MAX/2) { /* @@ -888,19 +886,19 @@ TclAppendBytesToByteArray( */ attempt = 2 * needed; - ptr = (ByteArray *)attemptckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt)); + 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); + size_t limit = UINT_MAX - needed; + size_t extra = len + TCL_MIN_GROWTH; + size_t growth = (extra > limit) ? limit : extra; attempt = needed + growth; - ptr = (ByteArray *)attemptckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt)); + ptr = (ByteArray *)Tcl_AttemptRealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt)); } if (ptr == NULL) { /* @@ -908,7 +906,7 @@ TclAppendBytesToByteArray( */ attempt = needed; - ptr = (ByteArray *)ckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt)); + ptr = (ByteArray *)Tcl_Realloc(byteArrayPtr, BYTEARRAY_SIZE(attempt)); } byteArrayPtr = ptr; byteArrayPtr->allocated = attempt; @@ -916,9 +914,9 @@ 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; } @@ -979,7 +977,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 @@ -991,7 +989,8 @@ BinaryFormatCmd( * cursor has visited.*/ const char *errorString; const char *errorValue, *str; - int offset, size, length; + int offset, size; + size_t length; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "formatString ?arg ...?"); @@ -1030,7 +1029,7 @@ BinaryFormatCmd( goto badIndex; } if (count == BINARY_ALL) { - Tcl_GetByteArrayFromObj(objv[arg], &count); + (void)TclGetByteArrayFromObj(objv[arg], &count); } else if (count == BINARY_NOCOUNT) { count = 1; } @@ -1102,7 +1101,7 @@ BinaryFormatCmd( if (count == BINARY_ALL) { count = listc; - } else if (count > listc) { + } else if (count > (size_t)listc) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "number of elements in list does not match count", -1)); @@ -1126,16 +1125,16 @@ BinaryFormatCmd( if (count == BINARY_NOCOUNT) { count = 1; } - if ((count > offset) || (count == BINARY_ALL)) { + if ((count > (size_t)offset) || (count == BINARY_ALL)) { count = offset; } - if (offset > length) { + if (offset > (int)length) { length = offset; } offset -= count; break; case '@': - if (offset > length) { + if (offset > (int)length) { length = offset; } if (count == BINARY_ALL) { @@ -1151,7 +1150,7 @@ BinaryFormatCmd( goto badField; } } - if (offset > length) { + if (offset > (int)length) { length = offset; } if (length == 0) { @@ -1194,8 +1193,8 @@ BinaryFormatCmd( char pad = (char) (cmd == 'a' ? '\0' : ' '); unsigned char *bytes; - bytes = Tcl_GetByteArrayFromObj(objv[arg++], &length); - + bytes = TclGetByteArrayFromObj(objv[arg], &length); + arg++; if (count == BINARY_ALL) { count = length; } else if (count == BINARY_NOCOUNT) { @@ -1228,7 +1227,7 @@ BinaryFormatCmd( value = 0; errorString = "binary"; if (cmd == 'B') { - for (offset = 0; offset < count; offset++) { + for (offset = 0; (size_t)offset < count; offset++) { value <<= 1; if (str[offset] == '1') { value |= 1; @@ -1243,7 +1242,7 @@ BinaryFormatCmd( } } } else { - for (offset = 0; offset < count; offset++) { + for (offset = 0; (size_t)offset < count; offset++) { value >>= 1; if (str[offset] == '1') { value |= 128; @@ -1290,7 +1289,7 @@ BinaryFormatCmd( value = 0; errorString = "hexadecimal"; if (cmd == 'H') { - for (offset = 0; offset < count; offset++) { + for (offset = 0; (size_t)offset < count; offset++) { value <<= 4; if (!isxdigit(UCHAR(str[offset]))) { /* INTL: digit */ errorValue = str; @@ -1311,7 +1310,7 @@ BinaryFormatCmd( } } } else { - for (offset = 0; offset < count; offset++) { + for (offset = 0; (size_t)offset < count; offset++) { value >>= 4; if (!isxdigit(UCHAR(str[offset]))) { /* INTL: digit */ @@ -1382,7 +1381,7 @@ BinaryFormatCmd( } } arg++; - for (i = 0; i < count; i++) { + for (i = 0; (size_t)i < count; i++) { if (FormatNumber(interp, cmd, listv[i], &cursor) != TCL_OK) { Tcl_DecrRefCount(resultPtr); return TCL_ERROR; @@ -1404,7 +1403,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; @@ -1484,7 +1483,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 @@ -1493,7 +1492,8 @@ BinaryScanCmd( unsigned char *buffer; /* Start of result buffer. */ const char *errorString; const char *str; - int offset, size, length, i; + int offset, size, i; + size_t length = 0; Tcl_Obj *valuePtr, *elementPtr; Tcl_HashTable numberCacheHash; @@ -1506,7 +1506,7 @@ BinaryScanCmd( } numberCachePtr = &numberCacheHash; Tcl_InitHashTable(numberCachePtr, TCL_ONE_WORD_KEYS); - buffer = Tcl_GetByteArrayFromObj(objv[1], &length); + buffer = TclGetByteArrayFromObj(objv[1], &length); format = TclGetString(objv[2]); arg = 3; offset = 0; @@ -1531,7 +1531,7 @@ BinaryScanCmd( if (count == BINARY_NOCOUNT) { count = 1; } - if (count > (length - offset)) { + if (count > length - offset) { goto done; } } @@ -1590,7 +1590,7 @@ BinaryScanCmd( if (count == BINARY_NOCOUNT) { count = 1; } - if (count > (length - offset) * 8) { + if (count > (size_t)(length - offset) * 8) { goto done; } } @@ -1600,7 +1600,7 @@ BinaryScanCmd( dest = TclGetString(valuePtr); if (cmd == 'b') { - for (i = 0; i < count; i++) { + for (i = 0; (size_t)i < count; i++) { if (i % 8) { value >>= 1; } else { @@ -1609,7 +1609,7 @@ BinaryScanCmd( *dest++ = (char) ((value & 1) ? '1' : '0'); } } else { - for (i = 0; i < count; i++) { + for (i = 0; (size_t)i < count; i++) { if (i % 8) { value <<= 1; } else { @@ -1655,7 +1655,7 @@ BinaryScanCmd( dest = TclGetString(valuePtr); if (cmd == 'h') { - for (i = 0; i < count; i++) { + for (i = 0; (size_t)i < count; i++) { if (i % 2) { value >>= 4; } else { @@ -1664,7 +1664,7 @@ BinaryScanCmd( *dest++ = hexdigit[value & 0xF]; } } else { - for (i = 0; i < count; i++) { + for (i = 0; (size_t)i < count; i++) { if (i % 2) { value <<= 4; } else { @@ -1721,7 +1721,7 @@ BinaryScanCmd( goto badIndex; } if (count == BINARY_NOCOUNT) { - if ((length - offset) < size) { + if ((length - offset) < (size_t)size) { goto done; } valuePtr = ScanNumber(buffer+offset, cmd, flags, @@ -1736,7 +1736,7 @@ BinaryScanCmd( } TclNewObj(valuePtr); src = buffer + offset; - for (i = 0; i < count; i++) { + for (i = 0; (size_t)i < count; i++) { elementPtr = ScanNumber(src, cmd, flags, &numberCachePtr); src += size; Tcl_ListObjAppendElement(NULL, valuePtr, elementPtr); @@ -1757,7 +1757,7 @@ BinaryScanCmd( if (count == BINARY_NOCOUNT) { count = 1; } - if ((count == BINARY_ALL) || (count > (length - offset))) { + if ((count == BINARY_ALL) || (count > length - offset)) { offset = length; } else { offset += count; @@ -1767,7 +1767,7 @@ BinaryScanCmd( if (count == BINARY_NOCOUNT) { count = 1; } - if ((count == BINARY_ALL) || (count > offset)) { + if ((count == BINARY_ALL) || (count > (size_t)offset)) { offset = 0; } else { offset -= count; @@ -1851,7 +1851,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 */ { /* @@ -2017,7 +2017,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)) { @@ -2551,7 +2551,7 @@ 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"); @@ -2559,7 +2559,7 @@ BinaryEncodeHex( } TclNewObj(resultObj); - data = Tcl_GetByteArrayFromObj(objv[1], &count); + data = TclGetByteArrayFromObj(objv[1], &count); cursor = Tcl_SetByteArrayLength(resultObj, count * 2); for (offset = 0; offset < count; ++offset) { *cursor++ = HexDigits[(data[offset] >> 4) & 0x0F]; @@ -2595,7 +2595,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 }; @@ -2674,8 +2675,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; } @@ -2720,8 +2721,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 }; @@ -2763,7 +2765,7 @@ BinaryEncode64( } TclNewObj(resultObj); - data = Tcl_GetByteArrayFromObj(objv[objc - 1], &count); + data = TclGetByteArrayFromObj(objv[objc - 1], &count); if (count > 0) { unsigned char *cursor = NULL; @@ -2840,11 +2842,11 @@ BinaryEncodeUu( { Tcl_Obj *resultObj; unsigned char *data, *start, *cursor; - int offset, count, rawLength, n, i, j, bits, index; + int rawLength, n, i, bits, index; 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 }; @@ -2878,7 +2880,7 @@ BinaryEncodeUu( objv[i + 1], &wrapcharlen); { const unsigned char *p = wrapchar; - int numBytes = wrapcharlen; + size_t numBytes = wrapcharlen; while (numBytes) { switch (*p) { @@ -2916,7 +2918,7 @@ BinaryEncodeUu( TclNewObj(resultObj); offset = 0; - data = Tcl_GetByteArrayFromObj(objv[objc - 1], &count); + data = TclGetByteArrayFromObj(objv[objc - 1], &count); rawLength = (lineLength - 1) * 3 / 4; start = cursor = Tcl_SetByteArrayLength(resultObj, (lineLength + wrapcharlen) * @@ -2989,7 +2991,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 }; @@ -3129,8 +3132,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; @@ -3164,7 +3167,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 }; @@ -3304,8 +3308,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 f761521..5951cf0 100644 --- a/generic/tclCkalloc.c +++ b/generic/tclCkalloc.c @@ -33,7 +33,7 @@ * "memory tag" command is invoked, to hold the current tag. */ -typedef struct MemTag { +typedef struct { size_t refCount; /* Number of mem_headers referencing this * tag. */ char string[1]; /* Actual size of string will be as large as @@ -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; @@ -247,12 +247,12 @@ ValidateMemory( guard_failed = TRUE; fflush(stdout); byte &= 0xFF; - fprintf(stderr, "low guard byte %d is 0x%x \t%c\n", (int)idx, byte, + fprintf(stderr, "low guard byte %" TCL_Z_MODIFIER "u is 0x%x \t%c\n", idx, byte, (isprint(UCHAR(byte)) ? byte : ' ')); /* INTL: bytes */ } } if (guard_failed) { - TclDumpMemoryInfo((ClientData) stderr, 0); + TclDumpMemoryInfo(stderr, 0); fprintf(stderr, "low guard failed at %p, %s %d\n", memHeaderP->body, file, line); fflush(stderr); /* In case name pointer is bad. */ @@ -268,13 +268,13 @@ ValidateMemory( guard_failed = TRUE; fflush(stdout); byte &= 0xFF; - fprintf(stderr, "hi guard byte %d is 0x%x \t%c\n", (int)idx, byte, + fprintf(stderr, "hi guard byte %" TCL_Z_MODIFIER "u is 0x%x \t%c\n", idx, byte, (isprint(UCHAR(byte)) ? byte : ' ')); /* INTL: bytes */ } } if (guard_failed) { - TclDumpMemoryInfo((ClientData) stderr, 0); + TclDumpMemoryInfo(stderr, 0); fprintf(stderr, "high guard failed at %p, %s %d\n", memHeaderP->body, file, line); fflush(stderr); /* In case name pointer is bad. */ @@ -378,7 +378,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, panicing if there isn't @@ -387,15 +387,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) { @@ -412,8 +412,8 @@ Tcl_DbCkalloc( } if (result == NULL) { fflush(stdout); - TclDumpMemoryInfo((ClientData) stderr, 0); - Tcl_Panic("unable to alloc %u bytes, %s line %d", size, file, line); + TclDumpMemoryInfo(stderr, 0); + Tcl_Panic("unable to alloc %" TCL_Z_MODIFIER "u bytes, %s line %d", size, file, line); } /* @@ -459,7 +459,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); } @@ -483,9 +483,9 @@ Tcl_DbCkalloc( return result->body; } -char * +void * Tcl_AttemptDbCkalloc( - unsigned int size, + size_t size, const char *file, int line) { @@ -502,7 +502,7 @@ Tcl_AttemptDbCkalloc( } if (result == NULL) { fflush(stdout); - TclDumpMemoryInfo((ClientData) stderr, 0); + TclDumpMemoryInfo(stderr, 0); return NULL; } @@ -548,7 +548,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); } @@ -575,7 +575,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. @@ -584,7 +584,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__. * *---------------------------------------------------------------------- @@ -592,7 +592,7 @@ Tcl_AttemptDbCkalloc( void Tcl_DbCkfree( - char *ptr, + void *ptr, const char *file, int line) { @@ -613,7 +613,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); } @@ -657,7 +657,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 @@ -667,10 +667,10 @@ Tcl_DbCkfree( *-------------------------------------------------------------------- */ -char * +void * Tcl_DbCkrealloc( - char *ptr, - unsigned int size, + void *ptr, + size_t size, const char *file, int line) { @@ -692,16 +692,16 @@ Tcl_DbCkrealloc( if (copySize > memp->length) { copySize = memp->length; } - newPtr = Tcl_DbCkalloc(size, file, line); + newPtr = (char *)Tcl_DbCkalloc(size, file, line); memcpy(newPtr, ptr, copySize); Tcl_DbCkfree(ptr, file, line); return newPtr; } -char * +void * Tcl_AttemptDbCkrealloc( - char *ptr, - unsigned int size, + void *ptr, + size_t size, const char *file, int line) { @@ -723,7 +723,7 @@ Tcl_AttemptDbCkrealloc( if (copySize > memp->length) { copySize = memp->length; } - newPtr = Tcl_AttemptDbCkalloc(size, file, line); + newPtr = (char *)Tcl_AttemptDbCkalloc(size, file, line); if (newPtr == NULL) { return NULL; } @@ -750,38 +750,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); } @@ -1047,11 +1047,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 @@ -1064,22 +1064,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; } @@ -1095,16 +1096,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*/) { @@ -1122,31 +1123,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; } @@ -1162,18 +1164,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*/) { @@ -1194,14 +1196,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 ba85fec..dbd24a8 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -100,7 +100,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 @@ -275,9 +275,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]); @@ -1917,7 +1917,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) { @@ -2034,13 +2034,13 @@ TzsetIfNecessary(void) || strcmp(tzIsNow, tzWas) != 0)) { tzset(); if (tzWas != NULL && tzWas != INT2PTR(-1)) { - ckfree(tzWas); + Tcl_Free(tzWas); } - tzWas = (char *)ckalloc(strlen(tzIsNow) + 1); + tzWas = (char *)Tcl_Alloc(strlen(tzIsNow) + 1); strcpy(tzWas, tzIsNow); } else if (tzIsNow == NULL && tzWas != NULL) { tzset(); - if (tzWas != INT2PTR(-1)) ckfree(tzWas); + if (tzWas != INT2PTR(-1)) Tcl_Free(tzWas); tzWas = NULL; } Tcl_MutexUnlock(&clockMutex); @@ -2071,8 +2071,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 7973154..15669be 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -134,142 +134,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(ClientData), - 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; - - TclListObjGetElements(interp, caseObjv[0], &caseObjc, &newObjv); - caseObjv = newObjv; - } - - for (i = 0; i < caseObjc; i += 2) { - int patObjc, j; - const char **patObjv; - const char *pat, *p; - - if (i == caseObjc-1) { - Tcl_ResetResult(interp); - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "extra case pattern with no body", -1)); - return TCL_ERROR; - } - - /* - * Check for special case of single pattern (no list) with no - * backslash sequences. - */ - - pat = TclGetString(caseObjv[i]); - for (p = pat; *p != '\0'; p++) { - if (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 @@ -548,7 +412,7 @@ 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 (objc == 2) { @@ -567,7 +431,7 @@ EncodingConvertfromObjCmd( /* * Convert the string into a byte array in 'ds' */ - bytesPtr = (char *) Tcl_GetByteArrayFromObj(data, &length); + bytesPtr = (char *) TclGetByteArrayFromObj(data, &length); Tcl_ExternalToUtfDString(encoding, bytesPtr, length, &ds); /* @@ -610,7 +474,7 @@ 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 */ /* TODO - ADJUST OBJ INDICES WHEN ENSEMBLIFYING THIS */ @@ -1828,7 +1692,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); @@ -2080,7 +1944,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); diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index da8dc65..5a8ef22 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -35,7 +35,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. */ @@ -520,7 +520,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"); @@ -630,7 +630,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 @@ -691,7 +691,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); @@ -742,7 +742,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); @@ -969,9 +969,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) { @@ -1376,7 +1375,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 @@ -1886,7 +1885,7 @@ InfoProcsCmd( } else { simpleProcOK: if (specificNsInPattern) { - TclNewObj(elemObjPtr); + elemObjPtr = Tcl_NewObj(); Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, elemObjPtr); } else { @@ -1907,15 +1906,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); @@ -2143,7 +2142,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. */ @@ -2181,7 +2180,8 @@ Tcl_JoinObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { - int length, listLen; + size_t length; + int listLen; Tcl_Obj *resObjPtr = NULL, *joinObjPtr, **elemPtrs; if ((objc < 2) || (objc > 3)) { @@ -2218,7 +2218,7 @@ Tcl_JoinObjCmd( } else { int i; - TclNewObj(resObjPtr); + resObjPtr = Tcl_NewObj(); for (i = 0; i < listLen; i++) { if (i > 0) { @@ -2399,7 +2399,8 @@ Tcl_LinsertObjCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *listPtr; - int index, len, result; + size_t index; + int len, result; if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "list index ?element ...?"); @@ -2421,7 +2422,7 @@ Tcl_LinsertObjCmd( if (result != TCL_OK) { return result; } - if (index > len) { + if (index + 1 > (size_t)len + 1) { index = len; } @@ -2435,7 +2436,7 @@ Tcl_LinsertObjCmd( listPtr = TclListObjCopy(NULL, listPtr); } - if ((objc == 4) && (index == len)) { + if ((objc == 4) && (index == (size_t)len)) { /* * Special case: insert one element at the end of the list. */ @@ -2664,7 +2665,8 @@ Tcl_LrangeObjCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { - int listLen, first, last, result; + int listLen, result; + size_t first, last; if (objc != 4) { Tcl_WrongNumArgs(interp, 1, objv, "list first last"); @@ -2714,8 +2716,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. @@ -2731,8 +2733,8 @@ Tcl_LremoveObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int i, idxc; - int listLen, *idxv, prevIdx, first, num; + int i, idxc, listLen, prevIdx, first, num; + size_t *idxv; Tcl_Obj *listObj; /* @@ -2754,11 +2756,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; } } @@ -2769,7 +2771,7 @@ Tcl_LremoveObjCmd( */ if (idxc > 1) { - qsort(idxv, idxc, sizeof(int), LremoveIndexCompare); + qsort(idxv, idxc, sizeof(size_t), LremoveIndexCompare); } /* @@ -2821,7 +2823,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; } @@ -2960,7 +2962,8 @@ Tcl_LreplaceObjCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *listPtr; - int first, last, listLen, numToDelete, result; + size_t first, last; + int listLen, numToDelete, result; if (objc < 4) { Tcl_WrongNumArgs(interp, 1, objv, @@ -2991,15 +2994,14 @@ Tcl_LreplaceObjCmd( if (first == TCL_INDEX_NONE) { first = 0; - } - if (first > listLen) { + } else if (first > (size_t)listLen) { first = listLen; } - if (last >= listLen) { + if (last + 1 > (size_t)listLen) { last = listLen - 1; } - if (first <= last) { + if (first + 1 <= last + 1) { numToDelete = last - first + 1; } else { numToDelete = 0; @@ -3140,10 +3142,11 @@ Tcl_LsearchObjCmd( Tcl_Obj *const objv[]) /* Argument values. */ { const char *bytes, *patternBytes; - int i, match, index, result=TCL_OK, listc, length, elemLen, bisect; + int i, match, index, result=TCL_OK, listc, bisect; + size_t length = 0, elemLen, start, groupSize, groupOffset, lower, upper; int allocatedIndexVector = 0; - int dataType, isIncreasing, lower, upper, start, groupSize, groupOffset; - Tcl_WideInt patWide, objWide; + int dataType, isIncreasing; + Tcl_WideInt patWide, objWide, wide; int allMatches, inlineReturn, negatedMatch, returnSubindices, noCase; double patDouble, objDouble; SortInfo sortInfo; @@ -3299,11 +3302,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", @@ -3311,6 +3314,7 @@ Tcl_LsearchObjCmd( result = TCL_ERROR; goto done; } + groupSize = wide; i++; break; case LSEARCH_INDEX: { /* -index */ @@ -3470,7 +3474,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)); @@ -3510,11 +3514,11 @@ 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 { - TclNewIntObj(itemPtr, TCL_INDEX_NONE); + TclNewIndexObj(itemPtr, TCL_INDEX_NONE); Tcl_SetObjResult(interp, itemPtr); } goto done; @@ -3645,7 +3649,7 @@ Tcl_LsearchObjCmd( * our first match might not be the first occurrence. * Consider: 0 0 0 1 1 1 2 2 2 * - * To maintain consistancy with standard lsearch semantics, we + * To maintain consistency with standard lsearch semantics, we * must find the leftmost occurrence of the pattern in the * list. Thus we don't just stop searching here. This * variation means that a search always makes log n @@ -3719,8 +3723,7 @@ Tcl_LsearchObjCmd( if (noCase) { match = (TclUtfCasecmp(bytes, patternBytes) == 0); } else { - match = (memcmp(bytes, patternBytes, - (size_t) length) == 0); + match = (memcmp(bytes, patternBytes, length) == 0); } } break; @@ -3804,10 +3807,11 @@ Tcl_LsearchObjCmd( } else if (returnSubindices) { int j; - TclNewIntObj(itemPtr, i+groupOffset); + TclNewIndexObj(itemPtr, i+groupOffset); for (j=0 ; j<sortInfo.indexc ; j++) { Tcl_Obj *elObj; - TclNewIntObj(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); @@ -3827,16 +3831,17 @@ Tcl_LsearchObjCmd( if (returnSubindices) { int j; - TclNewIntObj(itemPtr, index+groupOffset); + TclNewIndexObj(itemPtr, index+groupOffset); for (j=0 ; j<sortInfo.indexc ; j++) { Tcl_Obj *elObj; - TclNewIntObj(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); } else { Tcl_Obj *elObj; - TclNewIntObj(elObj, index); + TclNewIndexObj(elObj, index); Tcl_SetObjResult(interp, elObj); } } else if (index < 0) { @@ -3981,9 +3986,11 @@ Tcl_LsortObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument values. */ { - int i, j, index, indices, length, nocase = 0, indexc; + int i, index, indices, length, nocase = 0, indexc; int sortMode = SORTMODE_ASCII; - int group, groupSize, groupOffset, idx, allocatedIndexVector = 0; + int group, allocatedIndexVector = 0; + size_t j, idx, groupSize, groupOffset; + Tcl_WideInt wide; Tcl_Obj *resultPtr, *cmdPtr, **listObjPtrs, *listObj, *indexPtr; size_t elmArrSize; SortElement *elementArray = NULL, *elementPtr; @@ -4087,7 +4094,7 @@ Tcl_LsortObjCmd( * options is done. */ - for (j=0 ; j<sortindex ; j++) { + for (j=0 ; j<(size_t)sortindex ; j++) { int encoded = 0; int result = TclIndexEncode(interp, indexv[j], TCL_INDEX_NONE, TCL_INDEX_NONE, &encoded); @@ -4102,7 +4109,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 "d)", j)); sortInfo.resultCode = TCL_ERROR; goto done; } @@ -4135,11 +4142,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", @@ -4147,6 +4154,7 @@ Tcl_LsortObjCmd( sortInfo.resultCode = TCL_ERROR; goto done; } + groupSize = wide; group = 1; i++; break; @@ -4179,7 +4187,7 @@ Tcl_LsortObjCmd( allocatedIndexVector = 1; /* Cannot use indexc field, as it * might be decreased by 1 later. */ } - for (j=0 ; j<sortInfo.indexc ; j++) { + for (j=0 ; j<(size_t)sortInfo.indexc ; j++) { /* Prescreened values, no errors or out of range possible */ TclIndexEncode(NULL, indexv[j], TCL_INDEX_NONE, TCL_INDEX_NONE, &sortInfo.indexv[j]); @@ -4254,7 +4262,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)); @@ -4314,7 +4322,7 @@ Tcl_LsortObjCmd( elmArrSize = length * sizeof(SortElement); if (elmArrSize <= MAXCALLOC) { - elementArray = (SortElement *)ckalloc(elmArrSize); + elementArray = (SortElement *)Tcl_Alloc(elmArrSize); } else { elementArray = (SortElement *)malloc(elmArrSize); } @@ -4420,7 +4428,7 @@ Tcl_LsortObjCmd( idx = elementPtr->payload.index; for (j = 0; j < groupSize; j++) { if (indices) { - TclNewIntObj(objPtr, idx + j - groupOffset); + TclNewIndexObj(objPtr, idx + j - groupOffset); newArray[i++] = objPtr; Tcl_IncrRefCount(objPtr); } else { @@ -4432,7 +4440,7 @@ Tcl_LsortObjCmd( } } else if (indices) { for (i=0; elementPtr != NULL ; elementPtr = elementPtr->nextPtr) { - TclNewIntObj(objPtr, elementPtr->payload.index); + TclNewIndexObj(objPtr, elementPtr->payload.index); newArray[i++] = objPtr; Tcl_IncrRefCount(objPtr); } @@ -4458,7 +4466,7 @@ Tcl_LsortObjCmd( } if (elementArray) { if (elmArrSize <= MAXCALLOC) { - ckfree((char *)elementArray); + Tcl_Free(elementArray); } else { free((char *)elementArray); } diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index c47490a..d5828cd 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -127,8 +127,8 @@ Tcl_RegexpObjCmd( 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; @@ -146,7 +146,7 @@ Tcl_RegexpObjCmd( indices = 0; about = 0; cflags = TCL_REG_ADVANCED; - offset = 0; + offset = TCL_INDEX_START; all = 0; doinline = 0; @@ -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) { @@ -261,8 +261,8 @@ Tcl_RegexpObjCmd( 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,9 +306,9 @@ 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 (Tcl_GetUniChar(objPtr, offset-1) == '\n') { eflags = 0; @@ -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,25 +381,25 @@ Tcl_RegexpObjCmd( * match instead of the first character after the match. */ - if (end >= offset) { + if (end + 1 >= offset + 1) { end--; } } else { - start = -1; - end = -1; + start = TCL_INDEX_NONE; + end = TCL_INDEX_NONE; } - TclNewIntObj(objs[0], start); - TclNewIntObj(objs[1], end); + TclNewIndexObj(objs[0], start); + TclNewIndexObj(objs[1], end); newPtr = Tcl_NewListObj(2, objs); } else { - if (i <= info.nsubs) { + if (i <= (int)info.nsubs) { 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; } } @@ -487,8 +487,9 @@ Tcl_RegsubObjCmd( 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, numParts; + size_t idx, wlen, wsublen = 0, offset, numMatches; + size_t start, end, subStart, subEnd; Tcl_RegExp regExpr; Tcl_RegExpInfo info; Tcl_Obj *resultPtr, *subPtr, *objPtr, *startIndex = NULL; @@ -507,11 +508,11 @@ Tcl_RegsubObjCmd( 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; @@ -546,11 +547,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 +568,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 +582,16 @@ Tcl_RegsubObjCmd( objv += idx; if (startIndex) { - int stringLength = Tcl_GetCharLength(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 +599,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 ? Tcl_UniCharNcasecmp : Tcl_UniCharNcmp; + strCmpFn = nocase ? TclUniCharNcasecmp : TclUniCharNcmp; - wsrc = Tcl_GetUnicodeFromObj(objv[0], &slen); - wstring = Tcl_GetUnicodeFromObj(objv[1], &wlen); - wsubspec = Tcl_GetUnicodeFromObj(objv[2], &wsublen); + wsrc = TclGetUnicodeFromObj(objv[0], &slen); + wstring = TclGetUnicodeFromObj(objv[1], &wlen); + wsubspec = TclGetUnicodeFromObj(objv[2], &wsublen); wend = wstring + wlen - (slen ? slen - 1 : 0); result = TCL_OK; @@ -622,8 +624,8 @@ Tcl_RegsubObjCmd( resultPtr = Tcl_NewUnicodeObj(wstring, 0); Tcl_IncrRefCount(resultPtr); for (; wstring < wend; wstring++) { - Tcl_AppendUnicodeToObj(resultPtr, wsubspec, wsublen); - Tcl_AppendUnicodeToObj(resultPtr, wstring, 1); + TclAppendUnicodeToObj(resultPtr, wsubspec, wsublen); + TclAppendUnicodeToObj(resultPtr, wstring, 1); numMatches++; } wlen = 0; @@ -633,21 +635,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 = Tcl_NewUnicodeObj(wstring, 0); Tcl_IncrRefCount(resultPtr); } if (p != wstring) { - Tcl_AppendUnicodeToObj(resultPtr, p, wstring - p); + TclAppendUnicodeToObj(resultPtr, p, wstring - p); p = wstring + slen; } else { p += slen; } wstring = p - 1; - Tcl_AppendUnicodeToObj(resultPtr, wsubspec, wsublen); + TclAppendUnicodeToObj(resultPtr, wsubspec, wsublen); numMatches++; } } @@ -699,14 +700,14 @@ Tcl_RegsubObjCmd( } else { objPtr = objv[1]; } - wstring = Tcl_GetUnicodeFromObj(objPtr, &wlen); + wstring = TclGetUnicodeFromObj(objPtr, &wlen); if (objv[2] == objv[0]) { subPtr = Tcl_DuplicateObj(objv[2]); } else { subPtr = objv[2]; } if (!command) { - wsubspec = Tcl_GetUnicodeFromObj(subPtr, &wsublen); + wsubspec = TclGetUnicodeFromObj(subPtr, &wsublen); } result = TCL_OK; @@ -744,13 +745,13 @@ Tcl_RegsubObjCmd( if (numMatches == 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. */ - Tcl_AppendUnicodeToObj(resultPtr, wstring, offset); + TclAppendUnicodeToObj(resultPtr, wstring, offset); } } numMatches++; @@ -763,7 +764,7 @@ Tcl_RegsubObjCmd( Tcl_RegExpGetInfo(regExpr, &info); start = info.matches[0].start; end = info.matches[0].end; - Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, start); + TclAppendUnicodeToObj(resultPtr, wstring + offset, start); /* * In command-prefix mode, the substitutions are added as quoted @@ -778,17 +779,17 @@ Tcl_RegsubObjCmd( Tcl_ListObjGetElements(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)) { + 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 +809,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 +827,7 @@ Tcl_RegsubObjCmd( * the user code. */ - wstring = Tcl_GetUnicodeFromObj(objPtr, &wlen); + wstring = TclGetUnicodeFromObj(objPtr, &wlen); offset += end; if (end == 0 || start == end) { @@ -838,7 +839,7 @@ Tcl_RegsubObjCmd( */ if (offset < wlen) { - Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, 1); + TclAppendUnicodeToObj(resultPtr, wstring + offset, 1); } offset++; } @@ -867,7 +868,7 @@ Tcl_RegsubObjCmd( idx = ch - '0'; } else if ((ch == '\\') || (ch == '&')) { *wsrc = ch; - Tcl_AppendUnicodeToObj(resultPtr, wfirstChar, + TclAppendUnicodeToObj(resultPtr, wfirstChar, wsrc - wfirstChar + 1); *wsrc = '\\'; wfirstChar = wsrc + 2; @@ -881,15 +882,15 @@ Tcl_RegsubObjCmd( } if (wfirstChar != wsrc) { - Tcl_AppendUnicodeToObj(resultPtr, wfirstChar, + TclAppendUnicodeToObj(resultPtr, wfirstChar, wsrc - wfirstChar); } if (idx <= info.nsubs) { subStart = info.matches[idx].start; subEnd = info.matches[idx].end; - if ((subStart >= 0) && (subEnd >= 0)) { - Tcl_AppendUnicodeToObj(resultPtr, + if ((subStart != TCL_INDEX_NONE) && (subEnd != TCL_INDEX_NONE)) { + TclAppendUnicodeToObj(resultPtr, wstring + offset + subStart, subEnd - subStart); } } @@ -901,7 +902,7 @@ Tcl_RegsubObjCmd( } if (wfirstChar != wsrc) { - Tcl_AppendUnicodeToObj(resultPtr, wfirstChar, wsrc - wfirstChar); + TclAppendUnicodeToObj(resultPtr, wfirstChar, wsrc - wfirstChar); } if (end == 0) { @@ -911,7 +912,7 @@ Tcl_RegsubObjCmd( */ if (offset < wlen) { - Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, 1); + TclAppendUnicodeToObj(resultPtr, wstring + offset, 1); } offset++; } else { @@ -923,7 +924,7 @@ Tcl_RegsubObjCmd( */ if (offset < wlen) { - Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, 1); + TclAppendUnicodeToObj(resultPtr, wstring + offset, 1); } offset++; } @@ -948,7 +949,7 @@ Tcl_RegsubObjCmd( resultPtr = objv[1]; Tcl_IncrRefCount(resultPtr); } else if (offset < wlen) { - Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, wlen - offset); + TclAppendUnicodeToObj(resultPtr, wstring + offset, wlen - offset); } if (objc == 4) { if (Tcl_ObjSetVar2(interp, objv[3], NULL, resultPtr, @@ -1179,7 +1180,7 @@ 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) { @@ -1194,7 +1195,7 @@ Tcl_SplitObjCmd( stringPtr = TclGetStringFromObj(objv[1], &stringLen); end = stringPtr + stringLen; - TclNewObj(listPtr); + listPtr = Tcl_NewObj(); if (stringLen == 0) { /* @@ -1243,7 +1244,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 +1253,7 @@ Tcl_SplitObjCmd( Tcl_ListObjAppendElement(NULL, listPtr, objPtr); } else { const char *element, *p, *splitEnd; - int splitLen; + size_t splitLen; int splitChar; /* @@ -1307,7 +1308,7 @@ StringFirstCmd( 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 +1317,9 @@ StringFirstCmd( } if (objc == 4) { - int size = Tcl_GetCharLength(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; } } @@ -1351,7 +1352,7 @@ StringLastCmd( 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 +1361,9 @@ StringLastCmd( } if (objc == 4) { - int size = Tcl_GetCharLength(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; } } @@ -1395,7 +1396,7 @@ StringIndexCmd( 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,12 +1407,12 @@ StringIndexCmd( * Get the char length to calculate what 'end' means. */ - length = Tcl_GetCharLength(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)) { + if ((index != TCL_INDEX_NONE) && (index + 1 <= end + 1)) { int ch = Tcl_GetUniChar(objv[1], index); if (ch == -1) { @@ -1430,11 +1431,11 @@ 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 ((ch >= 0xD800) && (end < 3)) { + end += Tcl_UniCharToUtf(-1, buf + end); } - Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, length)); + Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, end)); } } return TCL_OK; @@ -1465,8 +1466,8 @@ StringInsertCmd( 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) { @@ -1479,8 +1480,8 @@ StringInsertCmd( return TCL_ERROR; } - if (index < 0) { - index = 0; + if (index == TCL_INDEX_NONE) { + index = TCL_INDEX_START; } if (index > length) { index = length; @@ -1524,7 +1525,9 @@ StringIsCmd( { 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, index, length3; + size_t failat = 0; + size_t length1, length2; Tcl_Obj *objPtr, *failVarObj = NULL; Tcl_WideInt w; @@ -1619,11 +1622,9 @@ StringIsCmd( string1 = TclGetStringFromObj(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: @@ -1643,7 +1644,8 @@ StringIsCmd( */ const char *elemStart, *nextElem; - int lenRemain, elemSize; + int lenRemain; + size_t elemSize; const char *p; string1 = TclGetStringFromObj(objPtr, &length1); @@ -1811,7 +1813,7 @@ StringIsCmd( * well-formed lists. */ - if (TCL_OK == TclListObjLength(NULL, objPtr, &length2)) { + if (TCL_OK == TclListObjLength(NULL, objPtr, &length3)) { break; } @@ -1823,7 +1825,8 @@ StringIsCmd( */ const char *elemStart, *nextElem; - int lenRemain, elemSize; + size_t lenRemain; + size_t elemSize; const char *p; string1 = TclGetStringFromObj(objPtr, &length1); @@ -1907,7 +1910,7 @@ StringIsCmd( str_is_done: if ((result == 0) && (failVarObj != NULL)) { - TclNewIntObj(objPtr, failat); + TclNewIndexObj(objPtr, failat); if (Tcl_ObjSetVar2(interp, failVarObj, NULL, objPtr, TCL_LEAVE_ERR_MSG) == NULL) { return TCL_ERROR; } @@ -1955,11 +1958,11 @@ StringMapCmd( 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"); @@ -1996,8 +1999,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. */ @@ -2006,7 +2009,7 @@ StringMapCmd( return TCL_OK; } - mapElemc *= 2; + mapElemc = 2 * i; mapWithDict = 1; /* @@ -2017,15 +2020,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 (TclListObjGetElements(interp, objv[objc-2], &mapElemc, + int i; + if (TclListObjGetElements(interp, objv[objc-2], &i, &mapElemv) != TCL_OK) { return TCL_ERROR; } + mapElemc = i; if (mapElemc == 0) { /* * empty charMap, just return whatever string was given. @@ -2057,7 +2062,7 @@ StringMapCmd( } else { sourceObj = objv[objc-1]; } - ustring1 = Tcl_GetUnicodeFromObj(sourceObj, &length1); + ustring1 = TclGetUnicodeFromObj(sourceObj, &length1); if (length1 == 0) { /* * Empty input string, just stop now. @@ -2067,7 +2072,7 @@ StringMapCmd( } end = ustring1 + length1; - strCmpFn = (nocase ? Tcl_UniCharNcasecmp : Tcl_UniCharNcmp); + strCmpFn = (nocase ? TclUniCharNcasecmp : TclUniCharNcmp); /* * Force result to be Unicode @@ -2083,10 +2088,11 @@ StringMapCmd( * larger strings. */ - int mapLen, u2lc; + size_t mapLen; + int u2lc; Tcl_UniChar *mapString; - ustring2 = Tcl_GetUnicodeFromObj(mapElemv[0], &length2); + ustring2 = TclGetUnicodeFromObj(mapElemv[0], &length2); p = ustring1; if ((length2 > length1) || (length2 == 0)) { /* @@ -2095,28 +2101,29 @@ StringMapCmd( ustring1 = end; } else { - mapString = Tcl_GetUnicodeFromObj(mapElemv[1], &mapLen); + mapString = TclGetUnicodeFromObj(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) { - Tcl_AppendUnicodeToObj(resultPtr, p, ustring1-p); + TclAppendUnicodeToObj(resultPtr, p, ustring1-p); p = ustring1 + length2; } else { p += length2; } ustring1 = p - 1; - Tcl_AppendUnicodeToObj(resultPtr, mapString, mapLen); + TclAppendUnicodeToObj(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 @@ -2125,13 +2132,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] = Tcl_GetUnicodeFromObj(mapElemv[index], + mapStrings[index] = TclGetUnicodeFromObj(mapElemv[index], mapLens+index); if (nocase && ((index % 2) == 0)) { u2lc[index/2] = Tcl_UniCharToLower(*mapStrings[index]); @@ -2148,14 +2155,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. */ - Tcl_AppendUnicodeToObj(resultPtr, p, ustring1-p); + TclAppendUnicodeToObj(resultPtr, p, ustring1-p); p = ustring1 + length2; } else { p += length2; @@ -2171,7 +2178,7 @@ StringMapCmd( * Append the map value to the unicode string. */ - Tcl_AppendUnicodeToObj(resultPtr, + TclAppendUnicodeToObj(resultPtr, mapStrings[index+1], mapLens[index+1]); break; } @@ -2188,7 +2195,7 @@ StringMapCmd( * Put the rest of the unmapped chars onto result. */ - Tcl_AppendUnicodeToObj(resultPtr, p, ustring1 - p); + TclAppendUnicodeToObj(resultPtr, p, ustring1 - p); } Tcl_SetObjResult(interp, resultPtr); done: @@ -2234,7 +2241,7 @@ StringMatchCmd( } if (objc == 4) { - int length; + size_t length; const char *string = TclGetStringFromObj(objv[1], &length); if ((length > 1) && @@ -2278,7 +2285,7 @@ StringRangeCmd( 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"); @@ -2290,20 +2297,20 @@ StringRangeCmd( * 'end' refers to the last character, not one past it. */ - length = Tcl_GetCharLength(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 (first < 0) { - first = 0; + if (first == TCL_INDEX_NONE) { + first = TCL_INDEX_START; } - if (last >= length) { - last = length; + if (last + 1 >= end + 1) { + last = end; } - if (last >= first) { + if (last + 1 >= first + 1) { Tcl_SetObjResult(interp, Tcl_GetRange(objv[1], first, last)); } return TCL_OK; @@ -2390,15 +2397,14 @@ StringRplcCmd( 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 = Tcl_GetCharLength(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) { @@ -2411,10 +2417,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 @@ -2425,10 +2430,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; } @@ -2501,7 +2506,7 @@ StringStartCmd( { int ch; const char *p, *string; - int cur, index, length, numChars; + size_t numChars, length, cur, index; Tcl_Obj *obj; if (objc != 3) { @@ -2510,20 +2515,20 @@ StringStartCmd( } string = TclGetStringFromObj(objv[1], &length); - numChars = Tcl_NumUtfChars(string, length); - if (TclGetIntForIndexM(interp, objv[2], numChars-1, &index) != TCL_OK) { + numChars = Tcl_NumUtfChars(string, length) - 1; + if (TclGetIntForIndexM(interp, objv[2], numChars, &index) != TCL_OK) { return TCL_ERROR; } - string = TclGetStringFromObj(objv[1], &length); - if (index >= numChars) { - index = numChars - 1; + string = TclGetString(objv[1]); + if (index + 1 > numChars + 1) { + index = numChars; } cur = 0; - if (index > 0) { + if (index + 1 > 1) { p = Tcl_UtfAtIndex(string, index); TclUtfToUCS4(p, &ch); - for (cur = index; cur >= 0; cur--) { + for (cur = index; cur != TCL_INDEX_NONE; cur--) { int delta = 0; const char *next; @@ -2542,7 +2547,7 @@ StringStartCmd( cur += 1; } } - TclNewIntObj(obj, cur); + TclNewIndexObj(obj, cur); Tcl_SetObjResult(interp, obj); return TCL_OK; } @@ -2573,7 +2578,7 @@ StringEndCmd( { int ch; const char *p, *end, *string; - int cur, index, length, numChars; + size_t length, numChars, cur, index; Tcl_Obj *obj; if (objc != 3) { @@ -2582,15 +2587,15 @@ StringEndCmd( } string = TclGetStringFromObj(objv[1], &length); - numChars = Tcl_NumUtfChars(string, length); - if (TclGetIntForIndexM(interp, objv[2], numChars-1, &index) != TCL_OK) { + numChars = Tcl_NumUtfChars(string, length) - 1; + if (TclGetIntForIndexM(interp, objv[2], numChars, &index) != TCL_OK) { return TCL_ERROR; } string = TclGetStringFromObj(objv[1], &length); - if (index < 0) { - index = 0; + if (index == TCL_INDEX_NONE) { + index = TCL_INDEX_START; } - if (index < numChars) { + if (index + 1 <= numChars + 1) { p = Tcl_UtfAtIndex(string, index); end = string+length; for (cur = index; p < end; cur++) { @@ -2603,9 +2608,9 @@ StringEndCmd( cur++; } } else { - cur = numChars; + cur = numChars + 1; } - TclNewIntObj(obj, cur); + TclNewIndexObj(obj, cur); Tcl_SetObjResult(interp, obj); return TCL_OK; } @@ -2642,7 +2647,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: @@ -2737,7 +2743,8 @@ TclStringCmpOpts( int *nocase, int *reqlength) { - int i, length; + int i; + size_t length; const char *string; *reqlength = -1; @@ -2836,6 +2843,7 @@ StringCatCmd( * *---------------------------------------------------------------------- */ + static int StringBytesCmd( TCL_UNUSED(ClientData), @@ -2843,7 +2851,7 @@ StringBytesCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int length; + size_t length; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "string"); @@ -2914,7 +2922,7 @@ StringLowerCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int length1, length2; + size_t length1, length2; const char *string1; char *string2; @@ -2932,7 +2940,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; @@ -2940,7 +2948,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; @@ -2950,10 +2958,10 @@ 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; } @@ -2999,7 +3007,7 @@ StringUpperCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int length1, length2; + size_t length1, length2; const char *string1; char *string2; @@ -3017,7 +3025,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; @@ -3025,8 +3033,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; @@ -3035,10 +3043,10 @@ 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; } @@ -3084,7 +3092,7 @@ StringTitleCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int length1, length2; + size_t length1, length2; const char *string1; char *string2; @@ -3102,7 +3110,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; @@ -3110,8 +3118,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; @@ -3120,10 +3128,10 @@ 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; } @@ -3170,7 +3178,7 @@ StringTrimCmd( 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); @@ -3217,7 +3225,8 @@ StringTrimLCmd( 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); @@ -3263,7 +3272,8 @@ StringTrimRCmd( 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); @@ -3462,8 +3472,9 @@ TclNRSwitchObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int i,j, index, mode, foundmode, splitObjs, numMatchesSaved; - int noCase, patternLength; + int i, index, mode, foundmode, splitObjs, numMatchesSaved; + int noCase; + size_t patternLength, j; const char *pattern; Tcl_Obj *stringObj, *indexVarObj, *matchVarObj; Tcl_Obj *const *savedObjv = objv; @@ -3774,11 +3785,11 @@ TclNRSwitchObjCmd( if (indexVarObj != NULL) { Tcl_Obj *rangeObjAry[2]; - if (info.matches[j].end > 0) { - TclNewIntObj(rangeObjAry[0], info.matches[j].start); - TclNewIntObj(rangeObjAry[1], info.matches[j].end-1); + if (info.matches[j].end + 1 > 1) { + TclNewIndexObj(rangeObjAry[0], info.matches[j].start); + TclNewIndexObj(rangeObjAry[1], info.matches[j].end-1); } else { - TclNewIntObj(rangeObjAry[1], TCL_INDEX_NONE); + TclNewIndexObj(rangeObjAry[1], TCL_INDEX_NONE); rangeObjAry[0] = rangeObjAry[1]; } @@ -3871,7 +3882,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 { @@ -3885,7 +3896,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; @@ -3894,7 +3905,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... @@ -3928,14 +3939,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. @@ -3950,12 +3961,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); @@ -4152,14 +4163,14 @@ Tcl_TimeRateObjCmd( Tcl_Obj *objPtr; int result, i; Tcl_Obj *calibrate = NULL, *direct = NULL; - TclWideMUInt count = 0; /* Holds repetition count */ + Tcl_WideUInt count = 0; /* Holds repetition count */ Tcl_WideInt maxms = WIDE_MIN; /* Maximal running time (in milliseconds) */ - TclWideMUInt maxcnt = WIDE_MAX; + Tcl_WideUInt maxcnt = WIDE_MAX; /* Maximal count of iterations. */ - TclWideMUInt threshold = 1; /* Current threshold for check time (faster + Tcl_WideUInt threshold = 1; /* Current threshold for check time (faster * repeat count without time check) */ - TclWideMUInt maxIterTm = 1; /* Max time of some iteration as max + Tcl_WideUInt maxIterTm = 1; /* Max time of some iteration as max * threshold, additionally avoiding divide to * zero (i.e., never < 1) */ unsigned short factor = 50; /* Factor (4..50) limiting threshold to avoid @@ -4533,13 +4544,13 @@ Tcl_TimeRateObjCmd( { Tcl_Obj *objarr[8], **objs = objarr; - TclWideMUInt usec, val; + Tcl_WideUInt usec, val; int digits; /* * Absolute execution time in microseconds or in wide clicks. */ - usec = (TclWideMUInt)(middle - start); + usec = (Tcl_WideUInt)(middle - start); #ifdef TCL_WIDE_CLICKS /* @@ -4569,7 +4580,7 @@ Tcl_TimeRateObjCmd( * Estimate the time of overhead (microsecs). */ - TclWideMUInt curOverhead = overhead * count; + Tcl_WideUInt curOverhead = overhead * count; if (usec > curOverhead) { usec -= curOverhead; @@ -4723,7 +4734,7 @@ TclNRTryObjCmd( return TCL_ERROR; } bodyObj = objv[1]; - TclNewObj(handlersObj); + handlersObj = Tcl_NewObj(); bodyShared = 0; haveHandlers = 0; for (i=2 ; i<objc ; i++) { @@ -4789,7 +4800,7 @@ TclNRTryObjCmd( if (Tcl_ListObjLength(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); @@ -5329,7 +5340,7 @@ TclListLines( 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 beee208..7412e2f 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -390,9 +390,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(int)); infoPtr->varLists[0]->numVars = 2; infoPtr->varLists[0]->varIndexes[0] = keyVar; infoPtr->varLists[0]->varIndexes[1] = valVar; @@ -686,8 +686,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)); } /* @@ -891,12 +891,13 @@ TclCompileConcatCmd( Tcl_Obj **objs; const char *bytes; int len; + size_t slen; Tcl_ListObjGetElements(NULL, listObj, &len, &objs); objPtr = Tcl_ConcatObj(len, objs); Tcl_DecrRefCount(listObj); - bytes = TclGetStringFromObj(objPtr, &len); - PushLiteral(envPtr, bytes, len); + bytes = TclGetStringFromObj(objPtr, &slen); + PushLiteral(envPtr, bytes, slen); Tcl_DecrRefCount(objPtr); return TCL_OK; } @@ -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; @@ -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; @@ -1573,7 +1576,7 @@ CompileDictEachCmd( } Tcl_DStringFree(&buffer); if (numVars != 2) { - ckfree(argv); + Tcl_Free((void *)argv); return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr); } @@ -1581,7 +1584,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); @@ -1789,7 +1792,7 @@ TclCompileDictUpdateCmd( * that are to be used. */ - duiPtr = (DictUpdateInfo *)ckalloc(offsetof(DictUpdateInfo, varIndices) + sizeof(int) * numVars); + duiPtr = (DictUpdateInfo *)Tcl_Alloc(offsetof(DictUpdateInfo, varIndices) + sizeof(int) * numVars); duiPtr->length = numVars; keyTokenPtrs = (Tcl_Token **)TclStackAlloc(interp, sizeof(Tcl_Token *) * numVars); tokenPtr = TokenAfter(dictVarTokenPtr); @@ -1872,8 +1875,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 +1886,7 @@ TclCompileDictUpdateCmd( */ failedUpdateInfoAssembly: - ckfree(duiPtr); + Tcl_Free(duiPtr); TclStackFree(interp, keyTokenPtrs); issueFallback: return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, envPtr); @@ -2234,8 +2237,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; } @@ -2272,7 +2275,7 @@ DupDictUpdateInfo( dui1Ptr = (DictUpdateInfo *)clientData; len = offsetof(DictUpdateInfo, varIndices) + sizeof(int) * dui1Ptr->length; - dui2Ptr = (DictUpdateInfo *)ckalloc(len); + dui2Ptr = (DictUpdateInfo *)Tcl_Alloc(len); memcpy(dui2Ptr, dui1Ptr, len); return dui2Ptr; } @@ -2281,7 +2284,7 @@ static void FreeDictUpdateInfo( ClientData clientData) { - ckfree(clientData); + Tcl_Free(clientData); } static void @@ -2292,7 +2295,7 @@ PrintDictUpdateInfo( TCL_UNUSED(unsigned int)) { DictUpdateInfo *duiPtr = (DictUpdateInfo *)clientData; - int i; + size_t i; for (i=0 ; i<duiPtr->length ; i++) { if (i) { @@ -2310,7 +2313,7 @@ DisassembleDictUpdateInfo( TCL_UNUSED(unsigned int)) { DictUpdateInfo *duiPtr = (DictUpdateInfo *)clientData; - int i; + size_t i; Tcl_Obj *variables; TclNewObj(variables); @@ -2722,7 +2725,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 */ @@ -2756,7 +2759,7 @@ CompileEachloopCmd( goto done; } - varListPtr = (ForeachVarList *)ckalloc(offsetof(ForeachVarList, varIndexes) + varListPtr = (ForeachVarList *)Tcl_Alloc(offsetof(ForeachVarList, varIndexes) + numVars * sizeof(int)); varListPtr->numVars = numVars; infoPtr->varLists[i/2] = varListPtr; @@ -2765,11 +2768,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 = TclGetStringFromObj(varNameObj, &length); + varIndex = LocalScalar(bytes, length, envPtr); if (varIndex < 0) { code = TCL_ERROR; goto done; @@ -2892,7 +2897,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,7 +2906,7 @@ DupForeachInfo( for (i = 0; i < numLists; i++) { srcListPtr = srcPtr->varLists[i]; numVars = srcListPtr->numVars; - dupListPtr = (ForeachVarList *)ckalloc(offsetof(ForeachVarList, varIndexes) + dupListPtr = (ForeachVarList *)Tcl_Alloc(offsetof(ForeachVarList, varIndexes) + numVars * sizeof(int)); dupListPtr->numVars = numVars; for (j = 0; j < numVars; j++) { @@ -2943,9 +2948,9 @@ FreeForeachInfo( for (i = 0; i < numLists; i++) { listPtr = infoPtr->varLists[i]; - ckfree(listPtr); + Tcl_Free(listPtr); } - ckfree(infoPtr); + Tcl_Free(infoPtr); } /* @@ -3149,7 +3154,8 @@ 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. @@ -3172,7 +3178,7 @@ TclCompileFormatCmd( return TCL_ERROR; } - objv = (Tcl_Obj **)ckalloc((parsePtr->numWords-2) * sizeof(Tcl_Obj *)); + objv = (Tcl_Obj **)Tcl_Alloc((parsePtr->numWords-2) * sizeof(Tcl_Obj *)); for (i=0 ; i+2 < parsePtr->numWords ; i++) { tokenPtr = TokenAfter(tokenPtr); TclNewObj(objv[i]); @@ -3187,12 +3193,12 @@ TclCompileFormatCmd( * the format is broken). Do the format now. */ - tmpObj = Tcl_Format(interp, Tcl_GetString(formatObj), + tmpObj = Tcl_Format(interp, TclGetString(formatObj), 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); @@ -3222,7 +3228,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 +3237,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') { @@ -3264,7 +3270,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 @@ -3364,7 +3370,7 @@ TclLocalScalarFromToken( int TclLocalScalar( const char *bytes, - int numBytes, + size_t numBytes, CompileEnv *envPtr) { Tcl_Token token[2] = {{TCL_TOKEN_SIMPLE_WORD, NULL, 0, 1}, @@ -3415,9 +3421,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 +3499,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 cebd8f5..f3428d1 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,8 @@ TclCompileIfCmd( * determined. */ Tcl_Token *tokenPtr, *testTokenPtr; int jumpIndex = 0; /* Avoid compiler warning. */ - int jumpFalseDist, numWords, wordIdx, numBytes, j, code; + size_t numBytes; + int jumpFalseDist, numWords, wordIdx, j, code; const char *word; int realCond = 1; /* Set to 0 for static conditions: * "if 0 {..}" */ @@ -497,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); @@ -2056,7 +2057,8 @@ TclCompileRegexpCmd( DefineLineInformation; /* TIP #280 */ Tcl_Token *varTokenPtr; /* Pointer to the Tcl_Token representing the * parse of the RE or string. */ - int i, len, nocase, exact, sawLast, simple; + size_t len; + int i, nocase, exact, sawLast, simple; const char *str; /* @@ -2096,7 +2098,7 @@ TclCompileRegexpCmd( sawLast++; i++; break; - } else if ((len > 1) && (strncmp(str, "-nocase", len) == 0)) { + } else if ((len > 1) && (strncmp(str,"-nocase", len) == 0)) { nocase = 1; } else { /* @@ -2242,7 +2244,8 @@ TclCompileRegsubCmd( Tcl_Obj *patternObj = NULL, *replacementObj = NULL; Tcl_DString pattern; const char *bytes; - int len, exact, quantified, result = TCL_ERROR; + int exact, quantified, result = TCL_ERROR; + size_t len; if (parsePtr->numWords < 5 || parsePtr->numWords > 6) { return TCL_ERROR; @@ -2320,7 +2323,7 @@ TclCompileRegsubCmd( */ len = Tcl_DStringLength(&pattern) - 2; - if (len > 0) { + if (len + 2 > 2) { goto isSimpleGlob; } @@ -2606,7 +2609,7 @@ TclCompileSyntaxError( CompileEnv *envPtr) { Tcl_Obj *msg = Tcl_GetObjResult(interp); - int numBytes; + size_t numBytes; const char *bytes = TclGetStringFromObj(msg, &numBytes); TclErrorStackResetIf(interp, bytes, numBytes); @@ -2832,7 +2835,8 @@ IndexTailVarIfKnown( { Tcl_Obj *tailPtr; const char *tailName, *p; - int len, n = varTokenPtr->numComponents; + int n = varTokenPtr->numComponents; + size_t len; Tcl_Token *lastTokenPtr; int full, localIndex; diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c index 26698a8..60b6a3b 100644 --- a/generic/tclCompCmdsSZ.c +++ b/generic/tclCompCmdsSZ.c @@ -252,7 +252,7 @@ TclCompileStringCatCmd( } else { Tcl_DecrRefCount(obj); if (folded) { - int len; + size_t len; const char *bytes = TclGetStringFromObj(folded, &len); PushLiteral(envPtr, bytes, len); @@ -270,7 +270,7 @@ TclCompileStringCatCmd( wordTokenPtr = TokenAfter(wordTokenPtr); } if (folded) { - int len; + size_t len; const char *bytes = TclGetStringFromObj(folded, &len); PushLiteral(envPtr, bytes, len); @@ -791,7 +791,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) { @@ -887,9 +888,9 @@ TclCompileStringLenCmd( */ char buf[TCL_INTEGER_SPACE]; - int len = Tcl_GetCharLength(objPtr); + size_t len = Tcl_GetCharLength(objPtr); - len = sprintf(buf, "%d", len); + len = sprintf(buf, "%" TCL_Z_MODIFIER "d", len); PushLiteral(envPtr, buf, len); } else { SetLineInformation(1); @@ -914,6 +915,7 @@ TclCompileStringMapCmd( Tcl_Obj *mapObj, **objv; const char *bytes; int len; + size_t slen; /* * We only handle the case: @@ -949,13 +951,13 @@ TclCompileStringMapCmd( * correct semantics for mapping. */ - bytes = TclGetStringFromObj(objv[0], &len); - if (len == 0) { + bytes = TclGetStringFromObj(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 = TclGetStringFromObj(objv[1], &slen); + PushLiteral(envPtr, bytes, slen); CompileWord(envPtr, stringTokenPtr, interp, 2); OP(STR_MAP); } @@ -1508,7 +1510,7 @@ void TclSubstCompile( Tcl_Interp *interp, const char *bytes, - int numBytes, + size_t numBytes, int flags, int line, CompileEnv *envPtr) @@ -1539,7 +1541,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; @@ -1570,7 +1573,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) { @@ -1609,8 +1613,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); } } @@ -1668,8 +1672,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); @@ -1684,8 +1688,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); @@ -1694,12 +1698,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); } /* @@ -1711,8 +1715,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); @@ -1721,8 +1725,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; } @@ -1842,7 +1846,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; /* @@ -1933,7 +1937,7 @@ TclCompileSwitchCmd( if (numWords == 1) { const char *bytes; - int maxLen, numBytes; + size_t maxLen, numBytes; int bline; /* TIP #280: line of the pattern/action list, * and start of list for when tracking the * location. This list comes immediately after @@ -1950,10 +1954,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; @@ -1991,10 +1995,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) { @@ -2012,9 +2016,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++) { /* @@ -2073,11 +2077,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; } @@ -2376,7 +2380,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)); @@ -2548,7 +2552,7 @@ DupJumptableInfo( ClientData 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; @@ -2570,7 +2574,7 @@ FreeJumptableInfo( JumptableInfo *jtPtr = (JumptableInfo *)clientData; Tcl_DeleteHashTable(&jtPtr->hashTable); - ckfree(jtPtr); + Tcl_Free(jtPtr); } static void @@ -2909,7 +2913,7 @@ TclCompileTryCmd( goto failedToCompile; } if (objc > 0) { - int len; + size_t len; const char *varname = TclGetStringFromObj(objv[0], &len); resultVarIndices[i] = LocalScalar(varname, len, envPtr); @@ -2921,7 +2925,7 @@ TclCompileTryCmd( resultVarIndices[i] = -1; } if (objc == 2) { - int len; + size_t len; const char *varname = TclGetStringFromObj(objv[1], &len); optionVarIndices[i] = LocalScalar(varname, len, envPtr); @@ -3040,6 +3044,7 @@ IssueTryClausesInstructions( DefineLineInformation; /* TIP #280 */ int range, resultVar, optionsVar; int i, j, len, forwardsNeedFixing = 0, trapZero = 0, afterBody = 0; + size_t slen; int *addrsToFix, *forwardsToFix, notCodeJumpSource, notECJumpSource; int *noError; char buf[TCL_INTEGER_SPACE]; @@ -3125,8 +3130,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 = TclGetStringFromObj(matchClauses[i], &slen); + PushLiteral(envPtr, p, slen); OP( STR_EQ); JUMP4( JUMP_FALSE, notECJumpSource); } else { @@ -3253,6 +3258,7 @@ IssueTryClausesFinallyInstructions( int trapZero = 0, afterBody = 0, finalOK, finalError, noFinalError; int *addrsToFix, *forwardsToFix, notCodeJumpSource, notECJumpSource; char buf[TCL_INTEGER_SPACE]; + size_t slen; resultVar = AnonymousLocal(envPtr); optionsVar = AnonymousLocal(envPtr); @@ -3336,8 +3342,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 = TclGetStringFromObj(matchClauses[i], &slen); + PushLiteral(envPtr, p, slen); OP( STR_EQ); JUMP4( JUMP_FALSE, notECJumpSource); } else { @@ -3662,7 +3668,7 @@ TclCompileUnsetCmd( } if (varCount == 0) { const char *bytes; - int len; + size_t len; bytes = TclGetStringFromObj(leadingWord, &len); if (i == 1 && len == 11 && !strncmp("-nocomplain", bytes, 11)) { diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c index aabd764..bf677da 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 { @@ -509,16 +509,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); /* @@ -544,7 +544,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. @@ -556,7 +556,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. */ @@ -579,7 +579,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 @@ -623,7 +623,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 @@ -631,7 +631,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"; @@ -675,7 +675,7 @@ ParseExpr( do { if (size <= UINT_MAX/sizeof(OpNode)) { - newPtr = (OpNode *)attemptckrealloc(nodes, size * sizeof(OpNode)); + newPtr = (OpNode *)Tcl_AttemptRealloc(nodes, size * sizeof(OpNode)); } } while ((newPtr == NULL) && ((size -= (size - nodesUsed) / 2) > nodesUsed)); @@ -710,12 +710,12 @@ ParseExpr( switch (lexeme) { 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: @@ -744,16 +744,16 @@ ParseExpr( } else { 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') { @@ -1385,7 +1385,7 @@ ParseExpr( */ if (nodes != NULL) { - ckfree(nodes); + Tcl_Free(nodes); } if (interp == NULL) { @@ -1414,13 +1414,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) ? "" : "..."); @@ -1442,7 +1442,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, @@ -1479,7 +1479,7 @@ ParseExpr( static void ConvertTreeToTokens( const char *start, - int numBytes, + size_t numBytes, OpNode *nodes, Tcl_Token *tokenPtr, Tcl_Parse *parsePtr) @@ -1568,7 +1568,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 { @@ -1585,7 +1585,7 @@ ConvertTreeToTokens( subExprTokenPtr->numComponents++; subExprTokenPtr++; memcpy(subExprTokenPtr, tokenPtr, - (size_t) toCopy * sizeof(Tcl_Token)); + toCopy * sizeof(Tcl_Token)); parsePtr->numTokens += toCopy + 1; } @@ -1827,7 +1827,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 @@ -1843,7 +1843,7 @@ Tcl_ParseExpr( TclNewObj(litList); TclNewObj(funcList); - if (numBytes < 0) { + if (numBytes == TCL_INDEX_NONE) { numBytes = (start ? strlen(start) : 0); } @@ -1863,7 +1863,7 @@ Tcl_ParseExpr( Tcl_FreeParse(exprParsePtr); TclStackFree(interp, exprParsePtr); - ckfree(opTree); + Tcl_Free(opTree); return code; } @@ -1884,17 +1884,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; Tcl_UniChar ch = 0; Tcl_Obj *literal = NULL; unsigned char byte; @@ -2102,6 +2101,7 @@ ParseLexeme( */ if (!TclIsBareword(*start) || *start == '_') { + size_t scanned; if (Tcl_UtfCharComplete(start, numBytes)) { scanned = TclUtfToUniChar(start, &ch); } else { @@ -2151,7 +2151,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. */ { @@ -2192,7 +2192,7 @@ TclCompileExpr( TclStackFree(interp, parsePtr); Tcl_DecrRefCount(funcList); Tcl_DecrRefCount(litList); - ckfree(opTree); + Tcl_Free(opTree); } /* @@ -2302,7 +2302,7 @@ CompileExprTree( case FUNCTION: { Tcl_DString cmdName; const char *p; - int length; + size_t length; Tcl_DStringInit(&cmdName); TclDStringAppendLiteral(&cmdName, "tcl::mathfunc::"); @@ -2461,7 +2461,7 @@ CompileExprTree( Tcl_Obj *literal = *litObjv; if (optimize) { - int length; + size_t length; const char *bytes = TclGetStringFromObj(literal, &length); int idx = TclRegisterLiteral(envPtr, bytes, length, 0); Tcl_Obj *objPtr = TclFetchLiteral(envPtr, idx); @@ -2520,9 +2520,9 @@ CompileExprTree( if (TclHasStringRep(objPtr)) { Tcl_Obj *tableValue; - int numBytes; + size_t numBytes; const char *bytes - = Tcl_GetStringFromObj(objPtr, &numBytes); + = TclGetStringFromObj(objPtr, &numBytes); idx = TclRegisterLiteral(envPtr, bytes, numBytes, 0); tableValue = TclFetchLiteral(envPtr, idx); diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 2ab92da..85f785f 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 @@ -803,8 +785,7 @@ TclSetByteCodeFromAny( } #endif - stringPtr = TclGetString(objPtr); - length = objPtr->length; + stringPtr = TclGetStringFromObj(objPtr, &length); /* * TIP #280: Pick up the CmdFrame in which the BC compiler was invoked and @@ -870,8 +851,8 @@ TclSetByteCodeFromAny( * instruction generator boundaries. */ - if (iPtr->extra.optimizer) { - (iPtr->extra.optimizer)(&compEnv); + if (iPtr->optimizer) { + (iPtr->optimizer)(&compEnv); } /* @@ -1152,12 +1133,12 @@ CleanupByteCode( } } - if (codePtr->localCachePtr && (--codePtr->localCachePtr->refCount == 0)) { + if (codePtr->localCachePtr && (codePtr->localCachePtr->refCount-- <= 1)) { TclFreeLocalCache(interp, codePtr->localCachePtr); } TclHandleRelease(codePtr->interpHandle); - ckfree(codePtr); + Tcl_Free(codePtr); } /* @@ -1341,7 +1322,7 @@ CompileSubstObj( } if (codePtr == NULL) { CompileEnv compEnv; - int numBytes; + size_t numBytes; const char *bytes = TclGetStringFromObj(objPtr, &numBytes); /* TODO: Check for more TIP 280 */ @@ -1410,14 +1391,14 @@ ReleaseCmdWordData( 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); } /* @@ -1444,14 +1425,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; @@ -1496,7 +1477,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; @@ -1651,7 +1632,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) { @@ -1681,20 +1662,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); @@ -1760,7 +1741,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); @@ -1803,7 +1784,7 @@ TclWordKnownAtCompileTime( static int ExpandRequested( Tcl_Token *tokenPtr, - int numWords) + size_t numWords) { /* Determine whether any words of the command require expansion */ while (numWords--) { @@ -1821,18 +1802,18 @@ CompileCmdLiteral( Tcl_Obj *cmdObj, CompileEnv *envPtr) { - int numBytes; const char *bytes; Command *cmdPtr; int cmdLitIdx, extraLiteralFlags = LITERAL_CMD_NAME; + 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 = TclGetStringFromObj(cmdObj, &length); + cmdLitIdx = TclRegisterLiteral(envPtr, bytes, length, extraLiteralFlags); if (cmdPtr && TclRoutineHasName(cmdPtr)) { TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, cmdLitIdx), cmdPtr); @@ -1845,11 +1826,12 @@ TclCompileInvocation( Tcl_Interp *interp, Tcl_Token *tokenPtr, Tcl_Obj *cmdObj, - int numWords, + size_t numWords, CompileEnv *envPtr) { DefineLineInformation; - int wordIdx = 0, depth = TclGetStackDepth(envPtr); + size_t wordIdx = 0; + int depth = TclGetStackDepth(envPtr); if (cmdObj) { CompileCmdLiteral(interp, cmdObj, envPtr); @@ -2013,7 +1995,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; } @@ -2132,8 +2114,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; @@ -2147,7 +2129,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. */ @@ -2180,13 +2162,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; @@ -2199,7 +2181,7 @@ TclCompileScript( Tcl_LogCommandInfo(interp, script, parsePtr->commandStart, parsePtr->term + 1 - parsePtr->commandStart); TclCompileSyntaxError(interp, envPtr); - ckfree(parsePtr); + Tcl_Free(parsePtr); return; } @@ -2275,7 +2257,7 @@ TclCompileScript( Tcl_FreeParse(parsePtr); } while (numBytes > 0); - ckfree(parsePtr); + Tcl_Free(parsePtr); } if (lastCmdIdx == -1) { @@ -2334,8 +2316,8 @@ TclCompileVarSubst( CompileEnv *envPtr) { const char *p, *name = tokenPtr[1].start; - int nameBytes = tokenPtr[1].size; - int i, localVar, localVarName = 1; + size_t i, nameBytes = tokenPtr[1].size; + int localVar, localVarName = 1; /* * Determine how the variable name should be handled: if it contains any @@ -2409,7 +2391,8 @@ TclCompileTokens( Tcl_DString textBuffer; /* Holds concatenated chars from adjacent * TCL_TOKEN_TEXT, TCL_TOKEN_BS tokens. */ char buffer[4] = ""; - int i, numObjsToConcat, length, adjust; + int i, numObjsToConcat, adjust; + size_t length; unsigned char *entryCodeNext = envPtr->codeNext; #define NUM_STATIC_POS 20 int isLiteral, maxNumCL, numCL; @@ -2444,7 +2427,7 @@ TclCompileTokens( if (isLiteral) { maxNumCL = NUM_STATIC_POS; - clPosition = (int *)ckalloc(maxNumCL * sizeof(int)); + clPosition = (int *)Tcl_Alloc(maxNumCL * sizeof(int)); } adjust = 0; @@ -2485,7 +2468,7 @@ TclCompileTokens( if (numCL >= maxNumCL) { maxNumCL *= 2; - clPosition = (int *)ckrealloc(clPosition, + clPosition = (int *)Tcl_Realloc(clPosition, maxNumCL * sizeof(int)); } clPosition[numCL] = clPos; @@ -2543,7 +2526,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); } } @@ -2590,7 +2573,7 @@ TclCompileTokens( */ if (maxNumCL) { - ckfree(clPosition); + Tcl_Free(clPosition); } TclCheckStackDepth(depth+1, envPtr); } @@ -2800,7 +2783,7 @@ PreventCycle( * can be sure we do not have any lingering cycles hiding in * the intrep. */ - int numBytes; + size_t numBytes; const char *bytes = TclGetStringFromObj(objPtr, &numBytes); Tcl_Obj *copyPtr = Tcl_NewStringObj(bytes, numBytes); @@ -2858,7 +2841,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; @@ -3003,7 +2986,7 @@ 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*/ @@ -3029,7 +3012,7 @@ TclFindCompiledLocal( LocalCache *cachePtr = envPtr->iPtr->varFramePtr->localCachePtr; const char *localName; Tcl_Obj **varNamePtr; - int len; + size_t len; if (!cachePtr || !name) { return -1; @@ -3038,8 +3021,7 @@ TclFindCompiledLocal( varNamePtr = &cachePtr->varName0; for (i=0; i < cachePtr->numVars; varNamePtr++, i++) { if (*varNamePtr) { - localName = TclGetString(*varNamePtr); - len = (*varNamePtr)->length; + localName = TclGetStringFromObj(*varNamePtr, &len); if ((len == nameBytes) && !strncmp(name, localName, len)) { return i; } @@ -3057,7 +3039,7 @@ TclFindCompiledLocal( char *localName = localPtr->name; if ((nameBytes == localPtr->nameLength) && - (strncmp(name, localName, nameBytes) == 0)) { + (strncmp(name,localName,nameBytes) == 0)) { return i; } } @@ -3071,7 +3053,7 @@ TclFindCompiledLocal( if (create || (name == NULL)) { localVar = procPtr->numCompiledLocals; - localPtr = (CompiledLocal *)ckalloc(offsetof(CompiledLocal, name) + nameBytes + 1); + localPtr = (CompiledLocal *)Tcl_Alloc(offsetof(CompiledLocal, name) + nameBytes + 1); if (procPtr->firstLocalPtr == NULL) { procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr; } else { @@ -3135,14 +3117,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->codeStart isn't a ckalloc'd pointer, so we must code a - * ckrealloc equivalent for ourselves. + * envPtr->codeStart isn't a Tcl_Alloc'd pointer, so we must code a + * Tcl_Realloc equivalent for ourselves. */ - unsigned char *newPtr = (unsigned char *)ckalloc(newBytes); + unsigned char *newPtr = (unsigned char *)Tcl_Alloc(newBytes); memcpy(newPtr, envPtr->codeStart, currBytes); envPtr->codeStart = newPtr; @@ -3202,14 +3184,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; @@ -3327,16 +3309,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; @@ -3405,17 +3387,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); @@ -3518,11 +3500,11 @@ TclAddLoopBreakFixup( auxPtr->allocBreakTargets *= 2; auxPtr->allocBreakTargets += 2; if (auxPtr->breakTargets) { - auxPtr->breakTargets = (unsigned int *)ckrealloc(auxPtr->breakTargets, + auxPtr->breakTargets = (unsigned int *)Tcl_Realloc(auxPtr->breakTargets, sizeof(int) * auxPtr->allocBreakTargets); } else { auxPtr->breakTargets = - (unsigned int *)ckalloc(sizeof(int) * auxPtr->allocBreakTargets); + (unsigned int *)Tcl_Alloc(sizeof(int) * auxPtr->allocBreakTargets); } } auxPtr->breakTargets[auxPtr->numBreakTargets - 1] = CurrentOffset(envPtr); @@ -3544,11 +3526,11 @@ TclAddLoopContinueFixup( auxPtr->allocContinueTargets *= 2; auxPtr->allocContinueTargets += 2; if (auxPtr->continueTargets) { - auxPtr->continueTargets = (unsigned int *)ckrealloc(auxPtr->continueTargets, + auxPtr->continueTargets = (unsigned int *)Tcl_Realloc(auxPtr->continueTargets, sizeof(int) * auxPtr->allocContinueTargets); } else { auxPtr->continueTargets = - (unsigned int *)ckalloc(sizeof(int) * auxPtr->allocContinueTargets); + (unsigned int *)Tcl_Alloc(sizeof(int) * auxPtr->allocContinueTargets); } } auxPtr->continueTargets[auxPtr->numContinueTargets - 1] = @@ -3710,12 +3692,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; } @@ -3771,14 +3753,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 +3842,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 +3881,7 @@ TclFreeJumpFixupArray( * free. */ { if (fixupArrayPtr->mallocedArray) { - ckfree(fixupArrayPtr->fixup); + Tcl_Free(fixupArrayPtr->fixup); } } @@ -3999,7 +3981,7 @@ TclFixupForwardJump( { unsigned char *jumpPc, *p; int firstCmd, lastCmd, firstRange, lastRange, k; - unsigned numBytes; + size_t numBytes; if (jumpDist <= distThreshold) { jumpPc = envPtr->codeStart + jumpFixupPtr->codeOffset; diff --git a/generic/tclCompile.h b/generic/tclCompile.h index 21a27f7..7e2fd55 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -87,7 +87,7 @@ typedef enum { * to a catch PC offset. */ } ExceptionRangeType; -typedef struct ExceptionRange { +typedef struct { ExceptionRangeType type; /* The kind of ExceptionRange. */ int nestingLevel; /* Static depth of the exception range. Used * to find the most deeply-nested range @@ -162,7 +162,7 @@ typedef struct ExceptionAux { * source offset is not monotonic. */ -typedef struct CmdLocation { +typedef struct { int codeOffset; /* Offset of first byte of command code. */ int numCodeBytes; /* Number of bytes for command's code. */ int srcOffset; /* Offset of first char of the command. */ @@ -180,8 +180,8 @@ typedef struct CmdLocation { * frame and associated information, like the path of a sourced file. */ -typedef struct ECL { - int srcOffset; /* Command location to find the entry. */ +typedef struct { + size_t srcOffset; /* Command location to find the entry. */ int nline; /* Number of words in the command */ int *line; /* Line information for all words in the * command. */ @@ -190,7 +190,7 @@ typedef struct ECL { * lines. */ } ECL; -typedef struct ExtCmdLoc { +typedef struct { int type; /* Context type. */ int start; /* Starting line for compiled script. Needed * for the extended recompile check in @@ -217,9 +217,9 @@ typedef struct ExtCmdLoc { * the AuxData structure. */ -typedef ClientData (AuxDataDupProc) (ClientData clientData); -typedef void (AuxDataFreeProc) (ClientData clientData); -typedef void (AuxDataPrintProc)(ClientData clientData, +typedef void *(AuxDataDupProc) (void *clientData); +typedef void (AuxDataFreeProc) (void *clientData); +typedef void (AuxDataPrintProc)(void *clientData, Tcl_Obj *appendObj, struct ByteCode *codePtr, unsigned int pcOffset); @@ -417,7 +417,7 @@ typedef struct ByteCode { * procs are specific to an interpreter so the * code emitted will depend on the * interpreter. */ - unsigned int compileEpoch; /* Value of iPtr->compileEpoch when this + size_t compileEpoch; /* Value of iPtr->compileEpoch when this * ByteCode was compiled. Used to invalidate * code when, e.g., commands with compile * procs are redefined. */ @@ -425,11 +425,11 @@ typedef struct ByteCode { * compiled. If the code is executed if a * different namespace, it must be * recompiled. */ - unsigned int nsEpoch; /* Value of nsPtr->resolverEpoch when this + size_t nsEpoch; /* Value of nsPtr->resolverEpoch when this * ByteCode was compiled. Used to invalidate * code when new namespace resolution rules * are put into effect. */ - unsigned int refCount; /* Reference count: set 1 when created plus 1 + size_t refCount; /* Reference count: set 1 when created plus 1 * for each execution of the code currently * active. This structure can be freed when * refCount becomes zero. */ @@ -536,320 +536,298 @@ typedef struct ByteCode { * Opcodes for the Tcl bytecode instructions. These must correspond to the * entries in the table of instruction descriptions, tclInstructionTable, in * tclCompile.c. Also, the order and number of the expression opcodes (e.g., - * INST_LOR) must match the entries in the array operatorStrings in + * INST_BITOR) must match the entries in the array operatorStrings in * 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 - -/* The last opcode */ -#define LAST_INST_OPCODE 194 +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, + + /* The last opcode */ + LAST_INST_OPCODE +}; /* * Table describing the Tcl bytecode instructions: their name (for displaying @@ -887,7 +865,7 @@ typedef enum InstOperandType { typedef struct InstructionDesc { const char *name; /* Name of instruction. */ - int numBytes; /* Total number of bytes for instruction. */ + size_t numBytes; /* Total number of bytes for instruction. */ int stackEffect; /* The worst-case balance stack effect of the * instruction, used for stack requirements * computations. The value INT_MIN signals @@ -1045,7 +1023,7 @@ MODULE_SCOPE const AuxDataType tclJumptableInfoType; */ typedef struct { - int length; /* Size of array */ + size_t length; /* Size of array */ int varIndices[TCLFLEXARRAY]; /* Array of variable indices to manage when * processing the start and end of a [dict * update]. There is really more than one @@ -1100,15 +1078,15 @@ MODULE_SCOPE void TclCompileCmdWord(Tcl_Interp *interp, Tcl_Token *tokenPtr, int 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, 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); @@ -1117,13 +1095,13 @@ MODULE_SCOPE void TclCompileTokens(Tcl_Interp *interp, CompileEnv *envPtr); MODULE_SCOPE void TclCompileVarSubst(Tcl_Interp *interp, Tcl_Token *tokenPtr, CompileEnv *envPtr); -MODULE_SCOPE int TclCreateAuxData(ClientData clientData, +MODULE_SCOPE int TclCreateAuxData(void *clientData, const AuxDataType *typePtr, CompileEnv *envPtr); MODULE_SCOPE int 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, unsigned int hash, int *newPtr, + size_t length, size_t hash, int *newPtr, Namespace *nsPtr, int flags, LiteralEntry **globalPtrPtr); MODULE_SCOPE void TclDeleteExecEnv(ExecEnv *eePtr); @@ -1137,8 +1115,8 @@ MODULE_SCOPE ExceptionRange * TclGetExceptionRangeForPc(unsigned char *pc, MODULE_SCOPE void TclExpandJumpFixupArray(JumpFixupArray *fixupArrayPtr); MODULE_SCOPE int TclNRExecuteByteCode(Tcl_Interp *interp, ByteCode *codePtr); -MODULE_SCOPE Tcl_Obj * TclFetchLiteral(CompileEnv *envPtr, unsigned int index); -MODULE_SCOPE int TclFindCompiledLocal(const char *name, int nameChars, +MODULE_SCOPE Tcl_Obj * TclFetchLiteral(CompileEnv *envPtr, size_t index); +MODULE_SCOPE int TclFindCompiledLocal(const char *name, size_t nameChars, int create, CompileEnv *envPtr); MODULE_SCOPE int TclFixupForwardJump(CompileEnv *envPtr, JumpFixup *jumpFixupPtr, int jumpDist, @@ -1146,13 +1124,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, @@ -1167,7 +1145,7 @@ 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 int TclLocalScalar(const char *bytes, size_t numBytes, CompileEnv *envPtr); MODULE_SCOPE int TclLocalScalarFromToken(Tcl_Token *tokenPtr, CompileEnv *envPtr); @@ -1179,9 +1157,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, @@ -1191,16 +1169,16 @@ MODULE_SCOPE void TclReleaseByteCode(ByteCode *codePtr); MODULE_SCOPE void TclReleaseLiteral(Tcl_Interp *interp, Tcl_Obj *objPtr); MODULE_SCOPE void TclInvalidateCmdLiteral(Tcl_Interp *interp, const char *name, Namespace *nsPtr); -MODULE_SCOPE int TclSingleOpCmd(ClientData clientData, +MODULE_SCOPE int TclSingleOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int TclSortingOpCmd(ClientData clientData, +MODULE_SCOPE int TclSortingOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int TclVariadicOpCmd(ClientData clientData, +MODULE_SCOPE int TclVariadicOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int TclNoIdentOpCmd(ClientData clientData, +MODULE_SCOPE int TclNoIdentOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); #ifdef TCL_COMPILE_DEBUG @@ -1211,12 +1189,12 @@ 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(ClientData clientData, +MODULE_SCOPE int TclPushProcCallFrame(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int isLambda); @@ -1231,7 +1209,7 @@ MODULE_SCOPE int TclPushProcCallFrame(ClientData clientData, /* * Simplified form to access AuxData. * - * ClientData TclFetchAuxData(CompileEng *envPtr, int index); + * void *TclFetchAuxData(CompileEng *envPtr, int index); */ #define TclFetchAuxData(envPtr, index) \ @@ -1550,7 +1528,7 @@ MODULE_SCOPE int TclPushProcCallFrame(ClientData clientData, * these macros are: * * static void PushLiteral(CompileEnv *envPtr, - * const char *string, int length); + * const char *string, size_t length); * static void PushStringLiteral(CompileEnv *envPtr, * const char *string); */ @@ -1558,7 +1536,7 @@ MODULE_SCOPE int TclPushProcCallFrame(ClientData clientData, #define PushLiteral(envPtr, string, length) \ TclEmitPush(TclRegisterLiteral(envPtr, string, length, 0), (envPtr)) #define PushStringLiteral(envPtr, string) \ - PushLiteral(envPtr, string, (int) (sizeof(string "") - 1)) + PushLiteral(envPtr, string, sizeof(string "") - 1) /* * Macro to advance to the next token; it is more mnemonic than the address @@ -1574,7 +1552,7 @@ MODULE_SCOPE int TclPushProcCallFrame(ClientData clientData, * Macro to get the offset to the next instruction to be issued. The ANSI C * "prototype" for this macro is: * - * static int CurrentOffset(CompileEnv *envPtr); + * static ptrdiff_t CurrentOffset(CompileEnv *envPtr); */ #define CurrentOffset(envPtr) \ @@ -1826,8 +1804,8 @@ MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, const char **args, int *argsi); FILE *tclDTraceDebugLog = NULL; \ void TclDTraceOpenDebugLog(void) { \ char n[35]; \ - sprintf(n, "/tmp/tclDTraceDebug-%lu.log", \ - (unsigned long) getpid()); \ + sprintf(n, "/tmp/tclDTraceDebug-%" TCL_Z_MODIFIER "u.log", \ + (size_t) getpid()); \ tclDTraceDebugLog = fopen(n, "a"); \ } diff --git a/generic/tclConfig.c b/generic/tclConfig.c index 3bdcd38..6a0155f 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; @@ -199,7 +199,8 @@ QueryConfigObjCmd( QCCD *cdPtr = (QCCD *)clientData; Tcl_Obj *pkgName = cdPtr->pkg; Tcl_Obj *pDB, *pkgDict, *val, *listPtr; - int n, index; + size_t n = 0; + int index, m; static const char *const subcmdStrings[] = { "get", "list", NULL }; @@ -258,7 +259,7 @@ 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 *) TclGetByteArrayFromObj(val, &n); value = Tcl_ExternalToUtfDString(venc, value, n, &conv); Tcl_SetObjResult(interp, Tcl_NewStringObj(value, Tcl_DStringLength(&conv))); @@ -271,8 +272,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 +282,7 @@ QueryConfigObjCmd( return TCL_ERROR; } - if (n) { + if (m) { Tcl_DictSearch s; Tcl_Obj *key; int done; @@ -330,9 +331,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); } /* 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 7f659eb..01d7782 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) @@ -2761,7 +2761,7 @@ TclClockOldscanObjCmd( return TCL_ERROR; } - yyInput = Tcl_GetString( objv[1] ); + yyInput = TclGetString(objv[1]); dateInfo.dateStart = yyInput; yyHaveDate = 0; @@ -2848,16 +2848,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()); @@ -2866,7 +2866,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)); } @@ -2875,29 +2875,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 9ea6838..b15d548 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -59,28 +59,28 @@ 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(unsigned int size); +EXTERN void * Tcl_Alloc(size_t size); /* 4 */ -EXTERN void Tcl_Free(char *ptr); +EXTERN void Tcl_Free(void *ptr); /* 5 */ -EXTERN char * Tcl_Realloc(char *ptr, unsigned int size); +EXTERN void * Tcl_Realloc(void *ptr, size_t size); /* 6 */ -EXTERN char * Tcl_DbCkalloc(unsigned int size, const char *file, +EXTERN void * Tcl_DbCkalloc(size_t 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, unsigned int size, +EXTERN void * Tcl_DbCkrealloc(void *ptr, size_t 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, ClientData clientData); + Tcl_FileProc *proc, void *clientData); #endif /* UNIX */ #ifdef MAC_OSX_TCL /* MACOSX */ /* 9 */ EXTERN void Tcl_CreateFileHandler(int fd, int mask, - Tcl_FileProc *proc, ClientData clientData); + Tcl_FileProc *proc, void *clientData); #endif /* MACOSX */ #if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */ /* 10 */ @@ -103,7 +103,7 @@ EXTERN int Tcl_AppendAllObjTypes(Tcl_Interp *interp, EXTERN void Tcl_AppendStringsToObj(Tcl_Obj *objPtr, ...); /* 16 */ EXTERN void Tcl_AppendToObj(Tcl_Obj *objPtr, const char *bytes, - int length); + size_t length); /* 17 */ EXTERN Tcl_Obj * Tcl_ConcatObj(int objc, Tcl_Obj *const objv[]); /* 18 */ @@ -118,27 +118,21 @@ 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 boolValue, const char *file, - int line); +/* Slot 22 is reserved */ /* 23 */ EXTERN Tcl_Obj * Tcl_DbNewByteArrayObj(const unsigned char *bytes, - int length, const char *file, int line); + size_t length, const char *file, int line); /* 24 */ EXTERN Tcl_Obj * Tcl_DbNewDoubleObj(double doubleValue, const char *file, int line); /* 25 */ EXTERN Tcl_Obj * Tcl_DbNewListObj(int 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 */ -EXTERN Tcl_Obj * Tcl_DbNewStringObj(const char *bytes, int length, +EXTERN Tcl_Obj * Tcl_DbNewStringObj(const char *bytes, size_t length, const char *file, int line); /* 29 */ EXTERN Tcl_Obj * Tcl_DuplicateObj(Tcl_Obj *objPtr); @@ -159,11 +153,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); @@ -174,7 +164,7 @@ 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); /* 42 */ @@ -200,58 +190,41 @@ EXTERN int Tcl_ListObjLength(Tcl_Interp *interp, EXTERN int Tcl_ListObjReplace(Tcl_Interp *interp, Tcl_Obj *listPtr, int first, int count, int objc, Tcl_Obj *const objv[]); -/* 49 */ -TCL_DEPRECATED("No longer in use, changed to macro") -Tcl_Obj * Tcl_NewBooleanObj(int boolValue); +/* Slot 49 is reserved */ /* 50 */ EXTERN Tcl_Obj * Tcl_NewByteArrayObj(const unsigned char *bytes, - int length); + size_t length); /* 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(int 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, int length); -/* 57 */ -TCL_DEPRECATED("No longer in use, changed to macro") -void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int boolValue); +EXTERN Tcl_Obj * Tcl_NewStringObj(const char *bytes, size_t length); +/* Slot 57 is reserved */ /* 58 */ -EXTERN unsigned char * Tcl_SetByteArrayLength(Tcl_Obj *objPtr, int length); +EXTERN unsigned char * Tcl_SetByteArrayLength(Tcl_Obj *objPtr, + size_t length); /* 59 */ EXTERN void Tcl_SetByteArrayObj(Tcl_Obj *objPtr, - const unsigned char *bytes, int length); + const unsigned char *bytes, size_t length); /* 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, int 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, int length); +EXTERN void Tcl_SetObjLength(Tcl_Obj *objPtr, size_t length); /* 65 */ EXTERN void Tcl_SetStringObj(Tcl_Obj *objPtr, const char *bytes, - int 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); + size_t length); +/* Slot 66 is reserved */ +/* Slot 67 is reserved */ /* 68 */ EXTERN void Tcl_AllowExceptions(Tcl_Interp *interp); /* 69 */ @@ -261,7 +234,7 @@ EXTERN void Tcl_AppendElement(Tcl_Interp *interp, EXTERN void Tcl_AppendResult(Tcl_Interp *interp, ...); /* 71 */ EXTERN Tcl_AsyncHandler Tcl_AsyncCreate(Tcl_AsyncProc *proc, - ClientData clientData); + void *clientData); /* 72 */ EXTERN void Tcl_AsyncDelete(Tcl_AsyncHandler async); /* 73 */ @@ -270,35 +243,29 @@ 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, const char *optionList); /* 79 */ EXTERN void Tcl_CallWhenDeleted(Tcl_Interp *interp, - Tcl_InterpDeleteProc *proc, - ClientData clientData); + Tcl_InterpDeleteProc *proc, void *clientData); /* 80 */ EXTERN void Tcl_CancelIdleCall(Tcl_IdleProc *idleProc, - ClientData clientData); -/* 81 */ -EXTERN int Tcl_Close(Tcl_Interp *interp, Tcl_Channel chan); + void *clientData); +/* Slot 81 is reserved */ /* 82 */ EXTERN int Tcl_CommandComplete(const char *cmd); /* 83 */ EXTERN char * Tcl_Concat(int argc, const char *const *argv); /* 84 */ -EXTERN int Tcl_ConvertElement(const char *src, char *dst, +EXTERN size_t Tcl_ConvertElement(const char *src, char *dst, int flags); /* 85 */ -EXTERN int Tcl_ConvertCountedElement(const char *src, - int length, char *dst, int flags); +EXTERN size_t Tcl_ConvertCountedElement(const char *src, + size_t length, char *dst, int flags); /* 86 */ EXTERN int Tcl_CreateAlias(Tcl_Interp *childInterp, const char *childCmd, Tcl_Interp *target, @@ -311,58 +278,52 @@ EXTERN int Tcl_CreateAliasObj(Tcl_Interp *childInterp, Tcl_Obj *const objv[]); /* 88 */ EXTERN Tcl_Channel Tcl_CreateChannel(const Tcl_ChannelType *typePtr, - const char *chanName, - ClientData instanceData, int mask); + const char *chanName, void *instanceData, + int mask); /* 89 */ EXTERN void Tcl_CreateChannelHandler(Tcl_Channel chan, int mask, - Tcl_ChannelProc *proc, ClientData clientData); + Tcl_ChannelProc *proc, void *clientData); /* 90 */ EXTERN void Tcl_CreateCloseHandler(Tcl_Channel chan, - Tcl_CloseProc *proc, ClientData clientData); + Tcl_CloseProc *proc, void *clientData); /* 91 */ EXTERN Tcl_Command Tcl_CreateCommand(Tcl_Interp *interp, const char *cmdName, Tcl_CmdProc *proc, - ClientData clientData, + void *clientData, Tcl_CmdDeleteProc *deleteProc); /* 92 */ EXTERN void Tcl_CreateEventSource(Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, - ClientData clientData); + void *clientData); /* 93 */ EXTERN void Tcl_CreateExitHandler(Tcl_ExitProc *proc, - ClientData clientData); + 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, - ClientData clientData); +/* Slot 95 is reserved */ /* 96 */ EXTERN Tcl_Command Tcl_CreateObjCommand(Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc *proc, - ClientData clientData, + void *clientData, Tcl_CmdDeleteProc *deleteProc); /* 97 */ EXTERN Tcl_Interp * Tcl_CreateChild(Tcl_Interp *interp, const char *name, int isSafe); /* 98 */ EXTERN Tcl_TimerToken Tcl_CreateTimerHandler(int milliseconds, - Tcl_TimerProc *proc, ClientData clientData); + Tcl_TimerProc *proc, void *clientData); /* 99 */ EXTERN Tcl_Trace Tcl_CreateTrace(Tcl_Interp *interp, int level, - Tcl_CmdTraceProc *proc, - ClientData clientData); + Tcl_CmdTraceProc *proc, void *clientData); /* 100 */ EXTERN void Tcl_DeleteAssocData(Tcl_Interp *interp, const char *name); /* 101 */ EXTERN void Tcl_DeleteChannelHandler(Tcl_Channel chan, - Tcl_ChannelProc *proc, ClientData clientData); + Tcl_ChannelProc *proc, void *clientData); /* 102 */ EXTERN void Tcl_DeleteCloseHandler(Tcl_Channel chan, - Tcl_CloseProc *proc, ClientData clientData); + Tcl_CloseProc *proc, void *clientData); /* 103 */ EXTERN int Tcl_DeleteCommand(Tcl_Interp *interp, const char *cmdName); @@ -371,14 +332,14 @@ EXTERN int Tcl_DeleteCommandFromToken(Tcl_Interp *interp, Tcl_Command command); /* 105 */ EXTERN void Tcl_DeleteEvents(Tcl_EventDeleteProc *proc, - ClientData clientData); + void *clientData); /* 106 */ EXTERN void Tcl_DeleteEventSource(Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, - ClientData clientData); + void *clientData); /* 107 */ EXTERN void Tcl_DeleteExitHandler(Tcl_ExitProc *proc, - ClientData clientData); + void *clientData); /* 108 */ EXTERN void Tcl_DeleteHashEntry(Tcl_HashEntry *entryPtr); /* 109 */ @@ -393,16 +354,14 @@ EXTERN void Tcl_DeleteTimerHandler(Tcl_TimerToken token); EXTERN void Tcl_DeleteTrace(Tcl_Interp *interp, Tcl_Trace trace); /* 114 */ EXTERN void Tcl_DontCallWhenDeleted(Tcl_Interp *interp, - Tcl_InterpDeleteProc *proc, - ClientData clientData); + Tcl_InterpDeleteProc *proc, void *clientData); /* 115 */ EXTERN int Tcl_DoOneEvent(int flags); /* 116 */ -EXTERN void Tcl_DoWhenIdle(Tcl_IdleProc *proc, - ClientData clientData); +EXTERN void Tcl_DoWhenIdle(Tcl_IdleProc *proc, void *clientData); /* 117 */ EXTERN char * Tcl_DStringAppend(Tcl_DString *dsPtr, - const char *bytes, int length); + const char *bytes, size_t length); /* 118 */ EXTERN char * Tcl_DStringAppendElement(Tcl_DString *dsPtr, const char *element); @@ -419,7 +378,8 @@ EXTERN void Tcl_DStringInit(Tcl_DString *dsPtr); EXTERN void Tcl_DStringResult(Tcl_Interp *interp, Tcl_DString *dsPtr); /* 124 */ -EXTERN void Tcl_DStringSetLength(Tcl_DString *dsPtr, int length); +EXTERN void Tcl_DStringSetLength(Tcl_DString *dsPtr, + size_t length); /* 125 */ EXTERN void Tcl_DStringStartSublist(Tcl_DString *dsPtr); /* 126 */ @@ -428,16 +388,13 @@ 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(ClientData clientData, +EXTERN void Tcl_EventuallyFree(void *clientData, Tcl_FreeProc *freeProc); /* 133 */ EXTERN TCL_NORETURN void Tcl_Exit(int status); @@ -470,16 +427,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 void 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, @@ -493,7 +447,7 @@ EXTERN int Tcl_GetAliasObj(Tcl_Interp *interp, const char **targetCmdPtr, int *objcPtr, Tcl_Obj ***objv); /* 150 */ -EXTERN ClientData Tcl_GetAssocData(Tcl_Interp *interp, +EXTERN void * Tcl_GetAssocData(Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc **procPtr); /* 151 */ @@ -503,9 +457,9 @@ EXTERN Tcl_Channel Tcl_GetChannel(Tcl_Interp *interp, EXTERN int Tcl_GetChannelBufferSize(Tcl_Channel chan); /* 153 */ EXTERN int Tcl_GetChannelHandle(Tcl_Channel chan, int direction, - ClientData *handlePtr); + void **handlePtr); /* 154 */ -EXTERN ClientData Tcl_GetChannelInstanceData(Tcl_Channel chan); +EXTERN void * Tcl_GetChannelInstanceData(Tcl_Channel chan); /* 155 */ EXTERN int Tcl_GetChannelMode(Tcl_Channel chan); /* 156 */ @@ -515,7 +469,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); @@ -539,42 +493,33 @@ EXTERN Tcl_Obj * Tcl_GetObjResult(Tcl_Interp *interp); /* 167 */ EXTERN int Tcl_GetOpenFile(Tcl_Interp *interp, const char *chanID, int forWriting, - int checkUsage, ClientData *filePtr); + 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, ClientData *filePtr); + int checkUsage, void **filePtr); #endif /* MACOSX */ /* 168 */ EXTERN Tcl_PathType Tcl_GetPathType(const char *path); /* 169 */ -EXTERN int Tcl_Gets(Tcl_Channel chan, Tcl_DString *dsPtr); +EXTERN size_t Tcl_Gets(Tcl_Channel chan, Tcl_DString *dsPtr); /* 170 */ -EXTERN int Tcl_GetsObj(Tcl_Channel chan, Tcl_Obj *objPtr); +EXTERN size_t Tcl_GetsObj(Tcl_Channel chan, Tcl_Obj *objPtr); /* 171 */ EXTERN int Tcl_GetServiceMode(void); /* 172 */ 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, @@ -600,11 +545,11 @@ EXTERN int Tcl_LinkVar(Tcl_Interp *interp, const char *varName, void *addr, int type); /* Slot 188 is reserved */ /* 189 */ -EXTERN Tcl_Channel Tcl_MakeFileChannel(ClientData handle, int mode); +EXTERN Tcl_Channel Tcl_MakeFileChannel(void *handle, int mode); /* 190 */ EXTERN int Tcl_MakeSafe(Tcl_Interp *interp); /* 191 */ -EXTERN Tcl_Channel Tcl_MakeTcpClientChannel(ClientData tcpSocket); +EXTERN Tcl_Channel Tcl_MakeTcpClientChannel(void *tcpSocket); /* 192 */ EXTERN char * Tcl_Merge(int argc, const char *const *argv); /* 193 */ @@ -633,9 +578,9 @@ EXTERN Tcl_Channel Tcl_OpenTcpClient(Tcl_Interp *interp, int port, EXTERN Tcl_Channel Tcl_OpenTcpServer(Tcl_Interp *interp, int port, const char *host, Tcl_TcpAcceptProc *acceptProc, - ClientData callbackData); + void *callbackData); /* 201 */ -EXTERN void Tcl_Preserve(ClientData data); +EXTERN void Tcl_Preserve(void *data); /* 202 */ EXTERN void Tcl_PrintDouble(Tcl_Interp *interp, double value, char *dst); @@ -647,7 +592,8 @@ EXTERN const char * Tcl_PosixError(Tcl_Interp *interp); EXTERN void Tcl_QueueEvent(Tcl_Event *evPtr, Tcl_QueuePosition position); /* 206 */ -EXTERN int Tcl_Read(Tcl_Channel chan, char *bufPtr, int toRead); +EXTERN size_t Tcl_Read(Tcl_Channel chan, char *bufPtr, + size_t toRead); /* 207 */ EXTERN void Tcl_ReapDetachedProcs(void); /* 208 */ @@ -671,20 +617,18 @@ EXTERN int Tcl_RegExpExec(Tcl_Interp *interp, Tcl_RegExp regexp, EXTERN int Tcl_RegExpMatch(Tcl_Interp *interp, const char *text, const char *pattern); /* 215 */ -EXTERN void Tcl_RegExpRange(Tcl_RegExp regexp, int index, +EXTERN void Tcl_RegExpRange(Tcl_RegExp regexp, size_t index, const char **startPtr, const char **endPtr); /* 216 */ -EXTERN void Tcl_Release(ClientData clientData); +EXTERN void Tcl_Release(void *clientData); /* 217 */ EXTERN void Tcl_ResetResult(Tcl_Interp *interp); /* 218 */ -EXTERN int Tcl_ScanElement(const char *src, int *flagPtr); +EXTERN size_t Tcl_ScanElement(const char *src, int *flagPtr); /* 219 */ -EXTERN int Tcl_ScanCountedElement(const char *src, int length, - int *flagPtr); -/* 220 */ -TCL_DEPRECATED("") -int Tcl_SeekOld(Tcl_Channel chan, int offset, int mode); +EXTERN size_t Tcl_ScanCountedElement(const char *src, + size_t length, int *flagPtr); +/* Slot 220 is reserved */ /* 221 */ EXTERN int Tcl_ServiceAll(void); /* 222 */ @@ -692,7 +636,7 @@ EXTERN int Tcl_ServiceEvent(int flags); /* 223 */ EXTERN void Tcl_SetAssocData(Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc *proc, - ClientData clientData); + void *clientData); /* 224 */ EXTERN void Tcl_SetChannelBufferSize(Tcl_Channel chan, int sz); /* 225 */ @@ -709,14 +653,10 @@ EXTERN void Tcl_SetErrno(int err); EXTERN void Tcl_SetErrorCode(Tcl_Interp *interp, ...); /* 229 */ EXTERN void Tcl_SetMaxBlockTime(const Tcl_Time *timePtr); -/* 230 */ -EXTERN void Tcl_SetPanicProc( - TCL_NORETURN1 Tcl_PanicProc *panicProc); +/* Slot 230 is reserved */ /* 231 */ EXTERN int Tcl_SetRecursionLimit(Tcl_Interp *interp, int 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 */ @@ -727,10 +667,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, @@ -748,84 +685,55 @@ EXTERN int Tcl_SplitList(Tcl_Interp *interp, /* 243 */ EXTERN void Tcl_SplitPath(const char *path, int *argcPtr, const char ***argvPtr); -/* 244 */ -EXTERN void Tcl_StaticPackage(Tcl_Interp *interp, - const char *pkgName, - Tcl_PackageInitProc *initProc, - Tcl_PackageInitProc *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, - ClientData 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, - Tcl_VarTraceProc *proc, - ClientData clientData); + Tcl_VarTraceProc *proc, void *clientData); /* 249 */ EXTERN char * Tcl_TranslateFileName(Tcl_Interp *interp, const char *name, Tcl_DString *bufferPtr); /* 250 */ -EXTERN int Tcl_Ungets(Tcl_Channel chan, const char *str, - int len, int atHead); +EXTERN size_t Tcl_Ungets(Tcl_Channel chan, const char *str, + size_t len, int atHead); /* 251 */ EXTERN void Tcl_UnlinkVar(Tcl_Interp *interp, const char *varName); /* 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, - ClientData clientData); +/* Slot 255 is reserved */ /* 256 */ EXTERN void Tcl_UntraceVar2(Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, - ClientData clientData); + void *clientData); /* 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") -ClientData Tcl_VarTraceInfo(Tcl_Interp *interp, - const char *varName, int flags, - Tcl_VarTraceProc *procPtr, - ClientData prevClientData); +/* Slot 261 is reserved */ /* 262 */ -EXTERN ClientData Tcl_VarTraceInfo2(Tcl_Interp *interp, +EXTERN void * Tcl_VarTraceInfo2(Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *procPtr, - ClientData prevClientData); + void *prevClientData); /* 263 */ -EXTERN int Tcl_Write(Tcl_Channel chan, const char *s, int slen); +EXTERN size_t Tcl_Write(Tcl_Channel chan, const char *s, + size_t slen); /* 264 */ EXTERN void Tcl_WrongNumArgs(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], const char *message); @@ -833,47 +741,25 @@ EXTERN void Tcl_WrongNumArgs(Tcl_Interp *interp, int objc, EXTERN int Tcl_DumpActiveMemory(const char *fileName); /* 266 */ EXTERN void Tcl_ValidateAllMemory(const char *file, int line); -/* 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); @@ -882,7 +768,7 @@ EXTERN void Tcl_InitMemory(Tcl_Interp *interp); /* 281 */ EXTERN Tcl_Channel Tcl_StackChannel(Tcl_Interp *interp, const Tcl_ChannelType *typePtr, - ClientData instanceData, int mask, + void *instanceData, int mask, Tcl_Channel prevChan); /* 282 */ EXTERN int Tcl_UnstackChannel(Tcl_Interp *interp, @@ -899,15 +785,14 @@ EXTERN void Tcl_AppendObjToObj(Tcl_Obj *objPtr, EXTERN Tcl_Encoding Tcl_CreateEncoding(const Tcl_EncodingType *typePtr); /* 288 */ EXTERN void Tcl_CreateThreadExitHandler(Tcl_ExitProc *proc, - ClientData clientData); + void *clientData); /* 289 */ EXTERN void Tcl_DeleteThreadExitHandler(Tcl_ExitProc *proc, - ClientData clientData); -/* 290 */ -EXTERN void Tcl_DiscardResult(Tcl_SavedResult *statePtr); + void *clientData); +/* Slot 290 is reserved */ /* 291 */ EXTERN int Tcl_EvalEx(Tcl_Interp *interp, const char *script, - int numBytes, int flags); + size_t numBytes, int flags); /* 292 */ EXTERN int Tcl_EvalObjv(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags); @@ -919,18 +804,18 @@ EXTERN TCL_NORETURN void Tcl_ExitThread(int status); /* 295 */ EXTERN int Tcl_ExternalToUtf(Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, - int srcLen, int flags, + size_t srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, - int dstLen, int *srcReadPtr, + size_t dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); /* 296 */ EXTERN char * Tcl_ExternalToUtfDString(Tcl_Encoding encoding, - const char *src, int srcLen, + const char *src, size_t srcLen, Tcl_DString *dsPtr); /* 297 */ EXTERN void Tcl_FinalizeThread(void); /* 298 */ -EXTERN void Tcl_FinalizeNotifier(ClientData clientData); +EXTERN void Tcl_FinalizeNotifier(void *clientData); /* 299 */ EXTERN void Tcl_FreeEncoding(Tcl_Encoding encoding); /* 300 */ @@ -944,16 +829,16 @@ EXTERN void Tcl_GetEncodingNames(Tcl_Interp *interp); /* 304 */ EXTERN int Tcl_GetIndexFromObjStruct(Tcl_Interp *interp, Tcl_Obj *objPtr, const void *tablePtr, - int offset, const char *msg, int flags, + size_t offset, const char *msg, int flags, int *indexPtr); /* 305 */ EXTERN void * Tcl_GetThreadData(Tcl_ThreadDataKey *keyPtr, - int size); + size_t size); /* 306 */ EXTERN Tcl_Obj * Tcl_GetVar2Ex(Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 307 */ -EXTERN ClientData Tcl_InitNotifier(void); +EXTERN void * Tcl_InitNotifier(void); /* 308 */ EXTERN void Tcl_MutexLock(Tcl_Mutex *mutexPtr); /* 309 */ @@ -964,16 +849,12 @@ EXTERN void Tcl_ConditionNotify(Tcl_Condition *condPtr); EXTERN void Tcl_ConditionWait(Tcl_Condition *condPtr, Tcl_Mutex *mutexPtr, const Tcl_Time *timePtr); /* 312 */ -EXTERN int Tcl_NumUtfChars(const char *src, int length); +EXTERN size_t Tcl_NumUtfChars(const char *src, size_t length); /* 313 */ -EXTERN int Tcl_ReadChars(Tcl_Channel channel, Tcl_Obj *objPtr, - int charsToRead, int appendFlag); -/* 314 */ -EXTERN void Tcl_RestoreResult(Tcl_Interp *interp, - Tcl_SavedResult *statePtr); -/* 315 */ -EXTERN void Tcl_SaveResult(Tcl_Interp *interp, - Tcl_SavedResult *statePtr); +EXTERN size_t Tcl_ReadChars(Tcl_Channel channel, Tcl_Obj *objPtr, + size_t charsToRead, int appendFlag); +/* Slot 314 is reserved */ +/* Slot 315 is reserved */ /* 316 */ EXTERN int Tcl_SetSystemEncoding(Tcl_Interp *interp, const char *name); @@ -987,7 +868,7 @@ EXTERN void Tcl_ThreadAlert(Tcl_ThreadId threadId); EXTERN void Tcl_ThreadQueueEvent(Tcl_ThreadId threadId, Tcl_Event *evPtr, Tcl_QueuePosition position); /* 320 */ -EXTERN int Tcl_UniCharAtIndex(const char *src, int index); +EXTERN int Tcl_UniCharAtIndex(const char *src, size_t index); /* 321 */ EXTERN int Tcl_UniCharToLower(int ch); /* 322 */ @@ -997,11 +878,11 @@ EXTERN int Tcl_UniCharToUpper(int ch); /* 324 */ EXTERN int Tcl_UniCharToUtf(int ch, char *buf); /* 325 */ -EXTERN const char * Tcl_UtfAtIndex(const char *src, int index); +EXTERN const char * Tcl_UtfAtIndex(const char *src, size_t index); /* 326 */ -EXTERN int Tcl_UtfCharComplete(const char *src, int length); +EXTERN int Tcl_UtfCharComplete(const char *src, size_t length); /* 327 */ -EXTERN int Tcl_UtfBackslash(const char *src, int *readPtr, +EXTERN size_t Tcl_UtfBackslash(const char *src, int *readPtr, char *dst); /* 328 */ EXTERN const char * Tcl_UtfFindFirst(const char *src, int ch); @@ -1014,13 +895,13 @@ EXTERN const char * Tcl_UtfPrev(const char *src, const char *start); /* 332 */ EXTERN int Tcl_UtfToExternal(Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, - int srcLen, int flags, + size_t srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, - int dstLen, int *srcReadPtr, + size_t dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); /* 333 */ EXTERN char * Tcl_UtfToExternalDString(Tcl_Encoding encoding, - const char *src, int srcLen, + const char *src, size_t srcLen, Tcl_DString *dsPtr); /* 334 */ EXTERN int Tcl_UtfToLower(char *src); @@ -1032,20 +913,16 @@ EXTERN int Tcl_UtfToChar16(const char *src, /* 337 */ EXTERN int Tcl_UtfToUpper(char *src); /* 338 */ -EXTERN int Tcl_WriteChars(Tcl_Channel chan, const char *src, - int srcLen); +EXTERN size_t Tcl_WriteChars(Tcl_Channel chan, const char *src, + size_t srcLen); /* 339 */ -EXTERN int Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr); +EXTERN size_t 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(ClientData clientData); +EXTERN void Tcl_AlertNotifier(void *clientData); /* 344 */ EXTERN void Tcl_ServiceModeHook(int mode); /* 345 */ @@ -1062,53 +939,44 @@ EXTERN int Tcl_UniCharIsSpace(int ch); EXTERN int Tcl_UniCharIsUpper(int ch); /* 351 */ EXTERN int Tcl_UniCharIsWordChar(int ch); -/* 352 */ -TCL_DEPRECATED("Use Tcl_GetCharLength") -int Tcl_UniCharLen(const Tcl_UniChar *uniStr); -/* 353 */ -TCL_DEPRECATED("Use Tcl_UtfNcmp") -int Tcl_UniCharNcmp(const Tcl_UniChar *ucs, - const Tcl_UniChar *uct, - unsigned long numChars); +/* Slot 352 is reserved */ +/* Slot 353 is reserved */ /* 354 */ EXTERN char * Tcl_Char16ToUtfDString(const unsigned short *uniStr, - int uniLength, Tcl_DString *dsPtr); + size_t uniLength, Tcl_DString *dsPtr); /* 355 */ -EXTERN unsigned short * Tcl_UtfToChar16DString(const char *src, int length, - Tcl_DString *dsPtr); +EXTERN unsigned short * Tcl_UtfToChar16DString(const char *src, + size_t length, Tcl_DString *dsPtr); /* 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 */ EXTERN void Tcl_LogCommandInfo(Tcl_Interp *interp, const char *script, const char *command, - int length); + size_t length); /* 360 */ EXTERN int Tcl_ParseBraces(Tcl_Interp *interp, - const char *start, int numBytes, + const char *start, size_t numBytes, Tcl_Parse *parsePtr, int append, const char **termPtr); /* 361 */ EXTERN int Tcl_ParseCommand(Tcl_Interp *interp, - const char *start, int numBytes, int nested, - Tcl_Parse *parsePtr); + const char *start, size_t numBytes, + int nested, Tcl_Parse *parsePtr); /* 362 */ EXTERN int Tcl_ParseExpr(Tcl_Interp *interp, const char *start, - int numBytes, Tcl_Parse *parsePtr); + size_t numBytes, Tcl_Parse *parsePtr); /* 363 */ EXTERN int Tcl_ParseQuotedString(Tcl_Interp *interp, - const char *start, int numBytes, + const char *start, size_t numBytes, Tcl_Parse *parsePtr, int append, const char **termPtr); /* 364 */ EXTERN int Tcl_ParseVarName(Tcl_Interp *interp, - const char *start, int numBytes, + const char *start, size_t numBytes, Tcl_Parse *parsePtr, int append); /* 365 */ EXTERN char * Tcl_GetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr); @@ -1119,11 +987,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); @@ -1138,29 +1005,25 @@ EXTERN int Tcl_UniCharIsPunct(int ch); /* 376 */ EXTERN int Tcl_RegExpExecObj(Tcl_Interp *interp, Tcl_RegExp regexp, Tcl_Obj *textObj, - int offset, int nmatches, int flags); + size_t offset, size_t nmatches, int flags); /* 377 */ EXTERN void Tcl_RegExpGetInfo(Tcl_RegExp regexp, Tcl_RegExpInfo *infoPtr); /* 378 */ EXTERN Tcl_Obj * Tcl_NewUnicodeObj(const Tcl_UniChar *unicode, - int numChars); + size_t numChars); /* 379 */ EXTERN void Tcl_SetUnicodeObj(Tcl_Obj *objPtr, - const Tcl_UniChar *unicode, int numChars); + const Tcl_UniChar *unicode, size_t numChars); /* 380 */ -EXTERN int Tcl_GetCharLength(Tcl_Obj *objPtr); +EXTERN size_t Tcl_GetCharLength(Tcl_Obj *objPtr); /* 381 */ -EXTERN int Tcl_GetUniChar(Tcl_Obj *objPtr, int index); -/* 382 */ -TCL_DEPRECATED("No longer in use, changed to macro") -Tcl_UniChar * Tcl_GetUnicode(Tcl_Obj *objPtr); +EXTERN int Tcl_GetUniChar(Tcl_Obj *objPtr, size_t index); +/* Slot 382 is reserved */ /* 383 */ -EXTERN Tcl_Obj * Tcl_GetRange(Tcl_Obj *objPtr, int first, int last); -/* 384 */ -TCL_DEPRECATED("Use Tcl_AppendStringsToObj") -void Tcl_AppendUnicodeToObj(Tcl_Obj *objPtr, - const Tcl_UniChar *unicode, int length); +EXTERN Tcl_Obj * Tcl_GetRange(Tcl_Obj *objPtr, size_t first, + size_t last); +/* Slot 384 is reserved */ /* 385 */ EXTERN int Tcl_RegExpMatchObj(Tcl_Interp *interp, Tcl_Obj *textObj, Tcl_Obj *patternObj); @@ -1174,24 +1037,22 @@ EXTERN int Tcl_GetChannelNames(Tcl_Interp *interp); EXTERN int Tcl_GetChannelNamesEx(Tcl_Interp *interp, const char *pattern); /* 390 */ -EXTERN int Tcl_ProcObjCmd(ClientData clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); +EXTERN int Tcl_ProcObjCmd(void *clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]); /* 391 */ EXTERN void Tcl_ConditionFinalize(Tcl_Condition *condPtr); /* 392 */ EXTERN void Tcl_MutexFinalize(Tcl_Mutex *mutex); /* 393 */ EXTERN int Tcl_CreateThread(Tcl_ThreadId *idPtr, - Tcl_ThreadCreateProc *proc, - ClientData clientData, int stackSize, - int flags); + Tcl_ThreadCreateProc *proc, void *clientData, + size_t stackSize, int flags); /* 394 */ -EXTERN int Tcl_ReadRaw(Tcl_Channel chan, char *dst, - int bytesToRead); +EXTERN size_t Tcl_ReadRaw(Tcl_Channel chan, char *dst, + size_t bytesToRead); /* 395 */ -EXTERN int Tcl_WriteRaw(Tcl_Channel chan, const char *src, - int srcLen); +EXTERN size_t Tcl_WriteRaw(Tcl_Channel chan, const char *src, + size_t srcLen); /* 396 */ EXTERN Tcl_Channel Tcl_GetTopChannel(Tcl_Channel chan); /* 397 */ @@ -1204,10 +1065,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); @@ -1217,10 +1075,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); @@ -1254,69 +1109,48 @@ 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 Tcl_UniChar *ucs, - const Tcl_UniChar *uct, - unsigned long numChars); -/* 420 */ -TCL_DEPRECATED("Use Tcl_StringCaseMatch") -int Tcl_UniCharCaseMatch(const Tcl_UniChar *uniStr, - const Tcl_UniChar *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); /* 424 */ EXTERN void Tcl_InitObjHashTable(Tcl_HashTable *tablePtr); /* 425 */ -EXTERN ClientData Tcl_CommandTraceInfo(Tcl_Interp *interp, +EXTERN void * Tcl_CommandTraceInfo(Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *procPtr, - ClientData prevClientData); + void *prevClientData); /* 426 */ EXTERN int Tcl_TraceCommand(Tcl_Interp *interp, const char *varName, int flags, - Tcl_CommandTraceProc *proc, - ClientData clientData); + Tcl_CommandTraceProc *proc, void *clientData); /* 427 */ EXTERN void Tcl_UntraceCommand(Tcl_Interp *interp, const char *varName, int flags, - Tcl_CommandTraceProc *proc, - ClientData clientData); + Tcl_CommandTraceProc *proc, void *clientData); /* 428 */ -EXTERN char * Tcl_AttemptAlloc(unsigned int size); +EXTERN void * Tcl_AttemptAlloc(size_t size); /* 429 */ -EXTERN char * Tcl_AttemptDbCkalloc(unsigned int size, - const char *file, int line); +EXTERN void * Tcl_AttemptDbCkalloc(size_t size, const char *file, + int line); /* 430 */ -EXTERN char * Tcl_AttemptRealloc(char *ptr, unsigned int size); +EXTERN void * Tcl_AttemptRealloc(void *ptr, size_t size); /* 431 */ -EXTERN char * Tcl_AttemptDbCkrealloc(char *ptr, unsigned int size, +EXTERN void * Tcl_AttemptDbCkrealloc(void *ptr, size_t size, const char *file, int line); /* 432 */ -EXTERN int Tcl_AttemptSetObjLength(Tcl_Obj *objPtr, int length); +EXTERN int Tcl_AttemptSetObjLength(Tcl_Obj *objPtr, + size_t length); /* 433 */ EXTERN Tcl_ThreadId Tcl_GetChannelThread(Tcl_Channel channel); /* 434 */ EXTERN Tcl_UniChar * 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, - ClientData *clientDataPtr); -/* 436 */ -TCL_DEPRECATED("") -Tcl_Obj * Tcl_ListMathFuncs(Tcl_Interp *interp, - const char *pattern); +/* Slot 435 is reserved */ +/* Slot 436 is reserved */ /* 437 */ EXTERN Tcl_Obj * Tcl_SubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); @@ -1366,7 +1200,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 +1231,7 @@ EXTERN Tcl_Obj * Tcl_FSGetNormalizedPath(Tcl_Interp *interp, EXTERN Tcl_Obj * Tcl_FSJoinToPath(Tcl_Obj *pathPtr, int objc, Tcl_Obj *const objv[]); /* 465 */ -EXTERN ClientData Tcl_FSGetInternalRep(Tcl_Obj *pathPtr, +EXTERN void * Tcl_FSGetInternalRep(Tcl_Obj *pathPtr, const Tcl_Filesystem *fsPtr); /* 466 */ EXTERN Tcl_Obj * Tcl_FSGetTranslatedPath(Tcl_Interp *interp, @@ -1407,7 +1241,7 @@ EXTERN int Tcl_FSEvalFile(Tcl_Interp *interp, Tcl_Obj *fileName); /* 468 */ EXTERN Tcl_Obj * Tcl_FSNewNativePath( const Tcl_Filesystem *fromFilesystem, - ClientData clientData); + void *clientData); /* 469 */ EXTERN const void * Tcl_FSGetNativePath(Tcl_Obj *pathPtr); /* 470 */ @@ -1417,17 +1251,17 @@ EXTERN Tcl_Obj * Tcl_FSPathSeparator(Tcl_Obj *pathPtr); /* 472 */ EXTERN Tcl_Obj * Tcl_FSListVolumes(void); /* 473 */ -EXTERN int Tcl_FSRegister(ClientData clientData, +EXTERN int Tcl_FSRegister(void *clientData, const Tcl_Filesystem *fsPtr); /* 474 */ EXTERN int Tcl_FSUnregister(const Tcl_Filesystem *fsPtr); /* 475 */ -EXTERN ClientData Tcl_FSData(const Tcl_Filesystem *fsPtr); +EXTERN void * Tcl_FSData(const Tcl_Filesystem *fsPtr); /* 476 */ 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 */ @@ -1436,13 +1270,13 @@ EXTERN int Tcl_OutputBuffered(Tcl_Channel chan); EXTERN void Tcl_FSMountsChanged(const Tcl_Filesystem *fsPtr); /* 481 */ EXTERN int Tcl_EvalTokensStandard(Tcl_Interp *interp, - Tcl_Token *tokenPtr, int count); + Tcl_Token *tokenPtr, size_t count); /* 482 */ EXTERN void Tcl_GetTime(Tcl_Time *timeBuf); /* 483 */ EXTERN Tcl_Trace Tcl_CreateObjTrace(Tcl_Interp *interp, int level, int flags, Tcl_CmdObjTraceProc *objProc, - ClientData clientData, + void *clientData, Tcl_CmdObjTraceDeleteProc *delProc); /* 484 */ EXTERN int Tcl_GetCommandInfoFromToken(Tcl_Command token, @@ -1513,7 +1347,7 @@ EXTERN void Tcl_RegisterConfig(Tcl_Interp *interp, const char *valEncoding); /* 506 */ EXTERN Tcl_Namespace * Tcl_CreateNamespace(Tcl_Interp *interp, - const char *name, ClientData clientData, + const char *name, void *clientData, Tcl_NamespaceDeleteProc *deleteProc); /* 507 */ EXTERN void Tcl_DeleteNamespace(Tcl_Namespace *nsPtr); @@ -1549,17 +1383,16 @@ 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, - ClientData clientData, + void *clientData, Tcl_LimitHandlerDeleteProc *deleteProc); /* 521 */ EXTERN void Tcl_LimitRemoveHandler(Tcl_Interp *interp, int type, Tcl_LimitHandlerProc *handlerProc, - ClientData clientData); + void *clientData); /* 522 */ EXTERN int Tcl_LimitReady(Tcl_Interp *interp); /* 523 */ @@ -1642,11 +1475,11 @@ EXTERN int Tcl_GetEnsembleNamespace(Tcl_Interp *interp, /* 552 */ EXTERN void Tcl_SetTimeProc(Tcl_GetTimeProc *getProc, Tcl_ScaleTimeProc *scaleProc, - ClientData clientData); + void *clientData); /* 553 */ EXTERN void Tcl_QueryTimeProc(Tcl_GetTimeProc **getProc, Tcl_ScaleTimeProc **scaleProc, - ClientData *clientData); + void **clientData); /* 554 */ EXTERN Tcl_DriverThreadActionProc * Tcl_ChannelThreadActionProc( const Tcl_ChannelType *chanTypePtr); @@ -1707,8 +1540,8 @@ EXTERN void Tcl_AppendObjToErrorInfo(Tcl_Interp *interp, Tcl_Obj *objPtr); /* 575 */ EXTERN void Tcl_AppendLimitedToObj(Tcl_Obj *objPtr, - const char *bytes, int length, int limit, - const char *ellipsis); + const char *bytes, size_t length, + size_t limit, const char *ellipsis); /* 576 */ EXTERN Tcl_Obj * Tcl_Format(Tcl_Interp *interp, const char *format, int objc, Tcl_Obj *const objv[]); @@ -1723,7 +1556,7 @@ EXTERN void Tcl_AppendPrintfToObj(Tcl_Obj *objPtr, const char *format, ...) TCL_FORMAT_PRINTF(2, 3); /* 580 */ EXTERN int Tcl_CancelEval(Tcl_Interp *interp, - Tcl_Obj *resultObjPtr, ClientData clientData, + Tcl_Obj *resultObjPtr, void *clientData, int flags); /* 581 */ EXTERN int Tcl_Canceled(Tcl_Interp *interp, int flags); @@ -1734,8 +1567,7 @@ EXTERN int Tcl_CreatePipe(Tcl_Interp *interp, /* 583 */ EXTERN Tcl_Command Tcl_NRCreateCommand(Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc *proc, - Tcl_ObjCmdProc *nreProc, - ClientData clientData, + Tcl_ObjCmdProc *nreProc, void *clientData, Tcl_CmdDeleteProc *deleteProc); /* 584 */ EXTERN int Tcl_NREvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr, @@ -1748,14 +1580,12 @@ EXTERN int Tcl_NRCmdSwap(Tcl_Interp *interp, Tcl_Command cmd, int objc, Tcl_Obj *const objv[], int flags); /* 587 */ EXTERN void Tcl_NRAddCallback(Tcl_Interp *interp, - Tcl_NRPostProc *postProcPtr, - ClientData data0, ClientData data1, - ClientData data2, ClientData data3); + Tcl_NRPostProc *postProcPtr, void *data0, + void *data1, void *data2, void *data3); /* 588 */ EXTERN int Tcl_NRCallObjProc(Tcl_Interp *interp, - Tcl_ObjCmdProc *objProc, - ClientData clientData, int objc, - Tcl_Obj *const objv[]); + Tcl_ObjCmdProc *objProc, void *clientData, + int objc, Tcl_Obj *const objv[]); /* 589 */ EXTERN unsigned Tcl_GetFSDeviceFromStat(const Tcl_StatBuf *statPtr); /* 590 */ @@ -1810,14 +1640,14 @@ EXTERN int Tcl_ZlibDeflate(Tcl_Interp *interp, int format, Tcl_Obj *gzipHeaderDictObj); /* 611 */ EXTERN int Tcl_ZlibInflate(Tcl_Interp *interp, int format, - Tcl_Obj *data, int buffersize, + Tcl_Obj *data, size_t buffersize, Tcl_Obj *gzipHeaderDictObj); /* 612 */ EXTERN unsigned int Tcl_ZlibCRC32(unsigned int crc, - const unsigned char *buf, int len); + const unsigned char *buf, size_t len); /* 613 */ EXTERN unsigned int Tcl_ZlibAdler32(unsigned int adler, - const unsigned char *buf, int len); + const unsigned char *buf, size_t len); /* 614 */ EXTERN int Tcl_ZlibStreamInit(Tcl_Interp *interp, int mode, int format, int level, Tcl_Obj *dictObj, @@ -1833,7 +1663,7 @@ EXTERN int Tcl_ZlibStreamPut(Tcl_ZlibStream zshandle, Tcl_Obj *data, int flush); /* 619 */ EXTERN int Tcl_ZlibStreamGet(Tcl_ZlibStream zshandle, - Tcl_Obj *data, int count); + Tcl_Obj *data, size_t count); /* 620 */ EXTERN int Tcl_ZlibStreamClose(Tcl_ZlibStream zshandle); /* 621 */ @@ -1871,7 +1701,7 @@ EXTERN Tcl_Channel Tcl_OpenTcpServerEx(Tcl_Interp *interp, const char *service, const char *host, unsigned int flags, Tcl_TcpAcceptProc *acceptProc, - ClientData callbackData); + void *callbackData); /* 632 */ EXTERN int TclZipfs_Mount(Tcl_Interp *interp, const char *mountPoint, const char *zipname, @@ -1889,7 +1719,7 @@ EXTERN int TclZipfs_MountBuffer(Tcl_Interp *interp, EXTERN void Tcl_FreeIntRep(Tcl_Obj *objPtr); /* 637 */ EXTERN char * Tcl_InitStringRep(Tcl_Obj *objPtr, const char *bytes, - unsigned int numBytes); + size_t numBytes); /* 638 */ EXTERN Tcl_ObjIntRep * Tcl_FetchIntRep(Tcl_Obj *objPtr, const Tcl_ObjType *typePtr); @@ -1908,18 +1738,19 @@ EXTERN int Tcl_IsShared(Tcl_Obj *objPtr); /* 644 */ EXTERN int Tcl_LinkArray(Tcl_Interp *interp, const char *varName, void *addr, int type, - int size); + size_t size); /* 645 */ EXTERN int Tcl_GetIntForIndex(Tcl_Interp *interp, - Tcl_Obj *objPtr, int endValue, int *indexPtr); + Tcl_Obj *objPtr, size_t endValue, + size_t *indexPtr); /* 646 */ EXTERN int Tcl_UtfToUniChar(const char *src, int *chPtr); /* 647 */ EXTERN char * Tcl_UniCharToUtfDString(const int *uniStr, - int uniLength, Tcl_DString *dsPtr); + size_t uniLength, Tcl_DString *dsPtr); /* 648 */ -EXTERN int * Tcl_UtfToUniCharDString(const char *src, int length, - Tcl_DString *dsPtr); +EXTERN int * Tcl_UtfToUniCharDString(const char *src, + size_t length, Tcl_DString *dsPtr); typedef struct { const struct TclPlatStubs *tclPlatStubs; @@ -1934,20 +1765,20 @@ 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) (unsigned int size); /* 3 */ - void (*tcl_Free) (char *ptr); /* 4 */ - char * (*tcl_Realloc) (char *ptr, unsigned int size); /* 5 */ - char * (*tcl_DbCkalloc) (unsigned int size, const char *file, int line); /* 6 */ - void (*tcl_DbCkfree) (char *ptr, const char *file, int line); /* 7 */ - char * (*tcl_DbCkrealloc) (char *ptr, unsigned int size, const char *file, int line); /* 8 */ + void * (*tcl_Alloc) (size_t size); /* 3 */ + void (*tcl_Free) (void *ptr); /* 4 */ + void * (*tcl_Realloc) (void *ptr, size_t size); /* 5 */ + void * (*tcl_DbCkalloc) (size_t size, const char *file, int line); /* 6 */ + void (*tcl_DbCkfree) (void *ptr, const char *file, int line); /* 7 */ + void * (*tcl_DbCkrealloc) (void *ptr, size_t size, const char *file, int line); /* 8 */ #if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */ - void (*tcl_CreateFileHandler) (int fd, int mask, Tcl_FileProc *proc, ClientData clientData); /* 9 */ + 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, ClientData clientData); /* 9 */ + 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 */ @@ -1963,19 +1794,19 @@ typedef struct TclStubs { int (*tcl_WaitForEvent) (const Tcl_Time *timePtr); /* 13 */ int (*tcl_AppendAllObjTypes) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 14 */ void (*tcl_AppendStringsToObj) (Tcl_Obj *objPtr, ...); /* 15 */ - void (*tcl_AppendToObj) (Tcl_Obj *objPtr, const char *bytes, int length); /* 16 */ + void (*tcl_AppendToObj) (Tcl_Obj *objPtr, const char *bytes, size_t length); /* 16 */ Tcl_Obj * (*tcl_ConcatObj) (int objc, Tcl_Obj *const objv[]); /* 17 */ int (*tcl_ConvertToType) (Tcl_Interp *interp, Tcl_Obj *objPtr, const Tcl_ObjType *typePtr); /* 18 */ 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 boolValue, const char *file, int line); /* 22 */ - Tcl_Obj * (*tcl_DbNewByteArrayObj) (const unsigned char *bytes, int length, const char *file, int line); /* 23 */ + void (*reserved22)(void); + Tcl_Obj * (*tcl_DbNewByteArrayObj) (const unsigned char *bytes, size_t length, const char *file, int line); /* 23 */ Tcl_Obj * (*tcl_DbNewDoubleObj) (double doubleValue, const char *file, int line); /* 24 */ Tcl_Obj * (*tcl_DbNewListObj) (int objc, Tcl_Obj *const *objv, const char *file, int line); /* 25 */ - 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, int length, const char *file, int line); /* 28 */ + Tcl_Obj * (*tcl_DbNewStringObj) (const char *bytes, size_t 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 *boolPtr); /* 31 */ @@ -1983,11 +1814,11 @@ typedef struct TclStubs { unsigned char * (*tcl_GetByteArrayFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 33 */ int (*tcl_GetDouble) (Tcl_Interp *interp, const char *src, double *doublePtr); /* 34 */ int (*tcl_GetDoubleFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, double *doublePtr); /* 35 */ - 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 */ + const Tcl_ObjType * (*tcl_GetObjType) (const char *typeName); /* 40 */ char * (*tcl_GetStringFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 41 */ void (*tcl_InvalidateStringRep) (Tcl_Obj *objPtr); /* 42 */ int (*tcl_ListObjAppendList) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *elemListPtr); /* 43 */ @@ -1996,90 +1827,90 @@ typedef struct TclStubs { int (*tcl_ListObjIndex) (Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj **objPtrPtr); /* 46 */ int (*tcl_ListObjLength) (Tcl_Interp *interp, Tcl_Obj *listPtr, int *lengthPtr); /* 47 */ int (*tcl_ListObjReplace) (Tcl_Interp *interp, Tcl_Obj *listPtr, int first, int count, int objc, Tcl_Obj *const objv[]); /* 48 */ - TCL_DEPRECATED_API("No longer in use, changed to macro") Tcl_Obj * (*tcl_NewBooleanObj) (int boolValue); /* 49 */ - Tcl_Obj * (*tcl_NewByteArrayObj) (const unsigned char *bytes, int length); /* 50 */ + void (*reserved49)(void); + Tcl_Obj * (*tcl_NewByteArrayObj) (const unsigned char *bytes, size_t length); /* 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) (int 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, int length); /* 56 */ - TCL_DEPRECATED_API("No longer in use, changed to macro") void (*tcl_SetBooleanObj) (Tcl_Obj *objPtr, int boolValue); /* 57 */ - unsigned char * (*tcl_SetByteArrayLength) (Tcl_Obj *objPtr, int length); /* 58 */ - void (*tcl_SetByteArrayObj) (Tcl_Obj *objPtr, const unsigned char *bytes, int length); /* 59 */ + Tcl_Obj * (*tcl_NewStringObj) (const char *bytes, size_t length); /* 56 */ + void (*reserved57)(void); + unsigned char * (*tcl_SetByteArrayLength) (Tcl_Obj *objPtr, size_t length); /* 58 */ + void (*tcl_SetByteArrayObj) (Tcl_Obj *objPtr, const unsigned char *bytes, size_t length); /* 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, int 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 (*tcl_SetObjLength) (Tcl_Obj *objPtr, int length); /* 64 */ - void (*tcl_SetStringObj) (Tcl_Obj *objPtr, const char *bytes, int 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 (*reserved63)(void); + void (*tcl_SetObjLength) (Tcl_Obj *objPtr, size_t length); /* 64 */ + void (*tcl_SetStringObj) (Tcl_Obj *objPtr, const char *bytes, size_t length); /* 65 */ + 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 */ - Tcl_AsyncHandler (*tcl_AsyncCreate) (Tcl_AsyncProc *proc, ClientData clientData); /* 71 */ + Tcl_AsyncHandler (*tcl_AsyncCreate) (Tcl_AsyncProc *proc, void *clientData); /* 71 */ void (*tcl_AsyncDelete) (Tcl_AsyncHandler async); /* 72 */ 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, ClientData clientData); /* 79 */ - void (*tcl_CancelIdleCall) (Tcl_IdleProc *idleProc, ClientData clientData); /* 80 */ - int (*tcl_Close) (Tcl_Interp *interp, Tcl_Channel chan); /* 81 */ + void (*tcl_CallWhenDeleted) (Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, void *clientData); /* 79 */ + void (*tcl_CancelIdleCall) (Tcl_IdleProc *idleProc, void *clientData); /* 80 */ + void (*reserved81)(void); int (*tcl_CommandComplete) (const char *cmd); /* 82 */ char * (*tcl_Concat) (int argc, const char *const *argv); /* 83 */ - int (*tcl_ConvertElement) (const char *src, char *dst, int flags); /* 84 */ - int (*tcl_ConvertCountedElement) (const char *src, int length, char *dst, int flags); /* 85 */ + size_t (*tcl_ConvertElement) (const char *src, char *dst, int flags); /* 84 */ + size_t (*tcl_ConvertCountedElement) (const char *src, size_t length, char *dst, int flags); /* 85 */ int (*tcl_CreateAlias) (Tcl_Interp *childInterp, const char *childCmd, Tcl_Interp *target, const char *targetCmd, int argc, const char *const *argv); /* 86 */ int (*tcl_CreateAliasObj) (Tcl_Interp *childInterp, const char *childCmd, Tcl_Interp *target, const char *targetCmd, int objc, Tcl_Obj *const objv[]); /* 87 */ - Tcl_Channel (*tcl_CreateChannel) (const Tcl_ChannelType *typePtr, const char *chanName, ClientData instanceData, int mask); /* 88 */ - void (*tcl_CreateChannelHandler) (Tcl_Channel chan, int mask, Tcl_ChannelProc *proc, ClientData clientData); /* 89 */ - void (*tcl_CreateCloseHandler) (Tcl_Channel chan, Tcl_CloseProc *proc, ClientData clientData); /* 90 */ - Tcl_Command (*tcl_CreateCommand) (Tcl_Interp *interp, const char *cmdName, Tcl_CmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc); /* 91 */ - void (*tcl_CreateEventSource) (Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, ClientData clientData); /* 92 */ - void (*tcl_CreateExitHandler) (Tcl_ExitProc *proc, ClientData clientData); /* 93 */ + Tcl_Channel (*tcl_CreateChannel) (const Tcl_ChannelType *typePtr, const char *chanName, void *instanceData, int mask); /* 88 */ + void (*tcl_CreateChannelHandler) (Tcl_Channel chan, int mask, Tcl_ChannelProc *proc, void *clientData); /* 89 */ + void (*tcl_CreateCloseHandler) (Tcl_Channel chan, Tcl_CloseProc *proc, void *clientData); /* 90 */ + Tcl_Command (*tcl_CreateCommand) (Tcl_Interp *interp, const char *cmdName, Tcl_CmdProc *proc, void *clientData, Tcl_CmdDeleteProc *deleteProc); /* 91 */ + 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, ClientData clientData); /* 95 */ - Tcl_Command (*tcl_CreateObjCommand) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc); /* 96 */ + 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, ClientData clientData); /* 98 */ - Tcl_Trace (*tcl_CreateTrace) (Tcl_Interp *interp, int level, Tcl_CmdTraceProc *proc, ClientData clientData); /* 99 */ + Tcl_TimerToken (*tcl_CreateTimerHandler) (int milliseconds, Tcl_TimerProc *proc, void *clientData); /* 98 */ + Tcl_Trace (*tcl_CreateTrace) (Tcl_Interp *interp, int level, Tcl_CmdTraceProc *proc, void *clientData); /* 99 */ void (*tcl_DeleteAssocData) (Tcl_Interp *interp, const char *name); /* 100 */ - void (*tcl_DeleteChannelHandler) (Tcl_Channel chan, Tcl_ChannelProc *proc, ClientData clientData); /* 101 */ - void (*tcl_DeleteCloseHandler) (Tcl_Channel chan, Tcl_CloseProc *proc, ClientData clientData); /* 102 */ + void (*tcl_DeleteChannelHandler) (Tcl_Channel chan, Tcl_ChannelProc *proc, void *clientData); /* 101 */ + void (*tcl_DeleteCloseHandler) (Tcl_Channel chan, Tcl_CloseProc *proc, void *clientData); /* 102 */ int (*tcl_DeleteCommand) (Tcl_Interp *interp, const char *cmdName); /* 103 */ int (*tcl_DeleteCommandFromToken) (Tcl_Interp *interp, Tcl_Command command); /* 104 */ - void (*tcl_DeleteEvents) (Tcl_EventDeleteProc *proc, ClientData clientData); /* 105 */ - void (*tcl_DeleteEventSource) (Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, ClientData clientData); /* 106 */ - void (*tcl_DeleteExitHandler) (Tcl_ExitProc *proc, ClientData clientData); /* 107 */ + void (*tcl_DeleteEvents) (Tcl_EventDeleteProc *proc, void *clientData); /* 105 */ + void (*tcl_DeleteEventSource) (Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, void *clientData); /* 106 */ + void (*tcl_DeleteExitHandler) (Tcl_ExitProc *proc, void *clientData); /* 107 */ void (*tcl_DeleteHashEntry) (Tcl_HashEntry *entryPtr); /* 108 */ void (*tcl_DeleteHashTable) (Tcl_HashTable *tablePtr); /* 109 */ void (*tcl_DeleteInterp) (Tcl_Interp *interp); /* 110 */ void (*tcl_DetachPids) (int numPids, Tcl_Pid *pidPtr); /* 111 */ void (*tcl_DeleteTimerHandler) (Tcl_TimerToken token); /* 112 */ void (*tcl_DeleteTrace) (Tcl_Interp *interp, Tcl_Trace trace); /* 113 */ - void (*tcl_DontCallWhenDeleted) (Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, ClientData clientData); /* 114 */ + void (*tcl_DontCallWhenDeleted) (Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, void *clientData); /* 114 */ int (*tcl_DoOneEvent) (int flags); /* 115 */ - void (*tcl_DoWhenIdle) (Tcl_IdleProc *proc, ClientData clientData); /* 116 */ - char * (*tcl_DStringAppend) (Tcl_DString *dsPtr, const char *bytes, int length); /* 117 */ + void (*tcl_DoWhenIdle) (Tcl_IdleProc *proc, void *clientData); /* 116 */ + char * (*tcl_DStringAppend) (Tcl_DString *dsPtr, const char *bytes, size_t length); /* 117 */ char * (*tcl_DStringAppendElement) (Tcl_DString *dsPtr, const char *element); /* 118 */ void (*tcl_DStringEndSublist) (Tcl_DString *dsPtr); /* 119 */ void (*tcl_DStringFree) (Tcl_DString *dsPtr); /* 120 */ void (*tcl_DStringGetResult) (Tcl_Interp *interp, Tcl_DString *dsPtr); /* 121 */ void (*tcl_DStringInit) (Tcl_DString *dsPtr); /* 122 */ void (*tcl_DStringResult) (Tcl_Interp *interp, Tcl_DString *dsPtr); /* 123 */ - void (*tcl_DStringSetLength) (Tcl_DString *dsPtr, int length); /* 124 */ + void (*tcl_DStringSetLength) (Tcl_DString *dsPtr, size_t length); /* 124 */ void (*tcl_DStringStartSublist) (Tcl_DString *dsPtr); /* 125 */ 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 (*tcl_EventuallyFree) (ClientData clientData, Tcl_FreeProc *freeProc); /* 132 */ + 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 */ int (*tcl_ExprBoolean) (Tcl_Interp *interp, const char *expr, int *ptr); /* 135 */ @@ -2091,21 +1922,21 @@ 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") void (*tcl_FindExecutable) (const char *argv0); /* 144 */ + void (*reserved144)(void); Tcl_HashEntry * (*tcl_FirstHashEntry) (Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr); /* 145 */ int (*tcl_Flush) (Tcl_Channel chan); /* 146 */ - 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 */ - ClientData (*tcl_GetAssocData) (Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc **procPtr); /* 150 */ + void * (*tcl_GetAssocData) (Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc **procPtr); /* 150 */ Tcl_Channel (*tcl_GetChannel) (Tcl_Interp *interp, const char *chanName, int *modePtr); /* 151 */ int (*tcl_GetChannelBufferSize) (Tcl_Channel chan); /* 152 */ - int (*tcl_GetChannelHandle) (Tcl_Channel chan, int direction, ClientData *handlePtr); /* 153 */ - ClientData (*tcl_GetChannelInstanceData) (Tcl_Channel chan); /* 154 */ + int (*tcl_GetChannelHandle) (Tcl_Channel chan, int direction, void **handlePtr); /* 153 */ + void * (*tcl_GetChannelInstanceData) (Tcl_Channel chan); /* 154 */ 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 */ @@ -2115,25 +1946,25 @@ typedef struct TclStubs { 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, ClientData *filePtr); /* 167 */ + 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, ClientData *filePtr); /* 167 */ + 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 */ - int (*tcl_Gets) (Tcl_Channel chan, Tcl_DString *dsPtr); /* 169 */ - int (*tcl_GetsObj) (Tcl_Channel chan, Tcl_Obj *objPtr); /* 170 */ + size_t (*tcl_Gets) (Tcl_Channel chan, Tcl_DString *dsPtr); /* 169 */ + size_t (*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 */ @@ -2144,9 +1975,9 @@ typedef struct TclStubs { char * (*tcl_JoinPath) (int argc, const char *const *argv, Tcl_DString *resultPtr); /* 186 */ int (*tcl_LinkVar) (Tcl_Interp *interp, const char *varName, void *addr, int type); /* 187 */ void (*reserved188)(void); - Tcl_Channel (*tcl_MakeFileChannel) (ClientData handle, int mode); /* 189 */ + Tcl_Channel (*tcl_MakeFileChannel) (void *handle, int mode); /* 189 */ int (*tcl_MakeSafe) (Tcl_Interp *interp); /* 190 */ - Tcl_Channel (*tcl_MakeTcpClientChannel) (ClientData tcpSocket); /* 191 */ + Tcl_Channel (*tcl_MakeTcpClientChannel) (void *tcpSocket); /* 191 */ char * (*tcl_Merge) (int argc, const char *const *argv); /* 192 */ Tcl_HashEntry * (*tcl_NextHashEntry) (Tcl_HashSearch *searchPtr); /* 193 */ void (*tcl_NotifyChannel) (Tcl_Channel channel, int mask); /* 194 */ @@ -2155,13 +1986,13 @@ typedef struct TclStubs { Tcl_Channel (*tcl_OpenCommandChannel) (Tcl_Interp *interp, int argc, const char **argv, int flags); /* 197 */ Tcl_Channel (*tcl_OpenFileChannel) (Tcl_Interp *interp, const char *fileName, const char *modeString, int permissions); /* 198 */ Tcl_Channel (*tcl_OpenTcpClient) (Tcl_Interp *interp, int port, const char *address, const char *myaddr, int myport, int async); /* 199 */ - Tcl_Channel (*tcl_OpenTcpServer) (Tcl_Interp *interp, int port, const char *host, Tcl_TcpAcceptProc *acceptProc, ClientData callbackData); /* 200 */ - void (*tcl_Preserve) (ClientData data); /* 201 */ + Tcl_Channel (*tcl_OpenTcpServer) (Tcl_Interp *interp, int port, const char *host, Tcl_TcpAcceptProc *acceptProc, void *callbackData); /* 200 */ + void (*tcl_Preserve) (void *data); /* 201 */ void (*tcl_PrintDouble) (Tcl_Interp *interp, double value, char *dst); /* 202 */ int (*tcl_PutEnv) (const char *assignment); /* 203 */ const char * (*tcl_PosixError) (Tcl_Interp *interp); /* 204 */ void (*tcl_QueueEvent) (Tcl_Event *evPtr, Tcl_QueuePosition position); /* 205 */ - int (*tcl_Read) (Tcl_Channel chan, char *bufPtr, int toRead); /* 206 */ + size_t (*tcl_Read) (Tcl_Channel chan, char *bufPtr, size_t toRead); /* 206 */ void (*tcl_ReapDetachedProcs) (void); /* 207 */ int (*tcl_RecordAndEval) (Tcl_Interp *interp, const char *cmd, int flags); /* 208 */ int (*tcl_RecordAndEvalObj) (Tcl_Interp *interp, Tcl_Obj *cmdPtr, int flags); /* 209 */ @@ -2170,135 +2001,135 @@ typedef struct TclStubs { Tcl_RegExp (*tcl_RegExpCompile) (Tcl_Interp *interp, const char *pattern); /* 212 */ int (*tcl_RegExpExec) (Tcl_Interp *interp, Tcl_RegExp regexp, const char *text, const char *start); /* 213 */ int (*tcl_RegExpMatch) (Tcl_Interp *interp, const char *text, const char *pattern); /* 214 */ - void (*tcl_RegExpRange) (Tcl_RegExp regexp, int index, const char **startPtr, const char **endPtr); /* 215 */ - void (*tcl_Release) (ClientData clientData); /* 216 */ + void (*tcl_RegExpRange) (Tcl_RegExp regexp, size_t index, const char **startPtr, const char **endPtr); /* 215 */ + void (*tcl_Release) (void *clientData); /* 216 */ void (*tcl_ResetResult) (Tcl_Interp *interp); /* 217 */ - int (*tcl_ScanElement) (const char *src, int *flagPtr); /* 218 */ - int (*tcl_ScanCountedElement) (const char *src, int length, int *flagPtr); /* 219 */ - TCL_DEPRECATED_API("") int (*tcl_SeekOld) (Tcl_Channel chan, int offset, int mode); /* 220 */ + size_t (*tcl_ScanElement) (const char *src, int *flagPtr); /* 218 */ + size_t (*tcl_ScanCountedElement) (const char *src, size_t length, int *flagPtr); /* 219 */ + void (*reserved220)(void); int (*tcl_ServiceAll) (void); /* 221 */ int (*tcl_ServiceEvent) (int flags); /* 222 */ - void (*tcl_SetAssocData) (Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc *proc, ClientData clientData); /* 223 */ + void (*tcl_SetAssocData) (Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc *proc, void *clientData); /* 223 */ void (*tcl_SetChannelBufferSize) (Tcl_Channel chan, int sz); /* 224 */ int (*tcl_SetChannelOption) (Tcl_Interp *interp, Tcl_Channel chan, const char *optionName, const char *newValue); /* 225 */ int (*tcl_SetCommandInfo) (Tcl_Interp *interp, const char *cmdName, const Tcl_CmdInfo *infoPtr); /* 226 */ 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") void (*tcl_SetPanicProc) (TCL_NORETURN1 Tcl_PanicProc *panicProc); /* 230 */ + void (*reserved230)(void); int (*tcl_SetRecursionLimit) (Tcl_Interp *interp, int depth); /* 231 */ - void (*tcl_SetResult) (Tcl_Interp *interp, char *result, Tcl_FreeProc *freeProc); /* 232 */ + 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_StaticPackage) (Tcl_Interp *interp, const char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *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, ClientData clientData); /* 247 */ - int (*tcl_TraceVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 248 */ + 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 */ - int (*tcl_Ungets) (Tcl_Channel chan, const char *str, int len, int atHead); /* 250 */ + size_t (*tcl_Ungets) (Tcl_Channel chan, const char *str, size_t 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, ClientData clientData); /* 255 */ - void (*tcl_UntraceVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 256 */ + 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") ClientData (*tcl_VarTraceInfo) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData); /* 261 */ - ClientData (*tcl_VarTraceInfo2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData); /* 262 */ - int (*tcl_Write) (Tcl_Channel chan, const char *s, int slen); /* 263 */ + void (*reserved261)(void); + void * (*tcl_VarTraceInfo2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *procPtr, void *prevClientData); /* 262 */ + size_t (*tcl_Write) (Tcl_Channel chan, const char *s, size_t slen); /* 263 */ void (*tcl_WrongNumArgs) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], const char *message); /* 264 */ int (*tcl_DumpActiveMemory) (const char *fileName); /* 265 */ void (*tcl_ValidateAllMemory) (const char *file, int line); /* 266 */ - 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, ClientData instanceData, int mask, Tcl_Channel prevChan); /* 281 */ + Tcl_Channel (*tcl_StackChannel) (Tcl_Interp *interp, const Tcl_ChannelType *typePtr, void *instanceData, int mask, Tcl_Channel prevChan); /* 281 */ int (*tcl_UnstackChannel) (Tcl_Interp *interp, Tcl_Channel chan); /* 282 */ Tcl_Channel (*tcl_GetStackedChannel) (Tcl_Channel chan); /* 283 */ void (*tcl_SetMainLoop) (Tcl_MainLoopProc *proc); /* 284 */ void (*reserved285)(void); void (*tcl_AppendObjToObj) (Tcl_Obj *objPtr, Tcl_Obj *appendObjPtr); /* 286 */ Tcl_Encoding (*tcl_CreateEncoding) (const Tcl_EncodingType *typePtr); /* 287 */ - void (*tcl_CreateThreadExitHandler) (Tcl_ExitProc *proc, ClientData clientData); /* 288 */ - void (*tcl_DeleteThreadExitHandler) (Tcl_ExitProc *proc, ClientData clientData); /* 289 */ - void (*tcl_DiscardResult) (Tcl_SavedResult *statePtr); /* 290 */ - int (*tcl_EvalEx) (Tcl_Interp *interp, const char *script, int numBytes, int flags); /* 291 */ + void (*tcl_CreateThreadExitHandler) (Tcl_ExitProc *proc, void *clientData); /* 288 */ + void (*tcl_DeleteThreadExitHandler) (Tcl_ExitProc *proc, void *clientData); /* 289 */ + void (*reserved290)(void); + int (*tcl_EvalEx) (Tcl_Interp *interp, const char *script, size_t numBytes, int flags); /* 291 */ int (*tcl_EvalObjv) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags); /* 292 */ int (*tcl_EvalObjEx) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 293 */ TCL_NORETURN1 void (*tcl_ExitThread) (int status); /* 294 */ - int (*tcl_ExternalToUtf) (Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); /* 295 */ - char * (*tcl_ExternalToUtfDString) (Tcl_Encoding encoding, const char *src, int srcLen, Tcl_DString *dsPtr); /* 296 */ + int (*tcl_ExternalToUtf) (Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, size_t srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, size_t dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); /* 295 */ + char * (*tcl_ExternalToUtfDString) (Tcl_Encoding encoding, const char *src, size_t srcLen, Tcl_DString *dsPtr); /* 296 */ void (*tcl_FinalizeThread) (void); /* 297 */ - void (*tcl_FinalizeNotifier) (ClientData clientData); /* 298 */ + void (*tcl_FinalizeNotifier) (void *clientData); /* 298 */ void (*tcl_FreeEncoding) (Tcl_Encoding encoding); /* 299 */ Tcl_ThreadId (*tcl_GetCurrentThread) (void); /* 300 */ Tcl_Encoding (*tcl_GetEncoding) (Tcl_Interp *interp, const char *name); /* 301 */ const char * (*tcl_GetEncodingName) (Tcl_Encoding encoding); /* 302 */ void (*tcl_GetEncodingNames) (Tcl_Interp *interp); /* 303 */ - int (*tcl_GetIndexFromObjStruct) (Tcl_Interp *interp, Tcl_Obj *objPtr, const void *tablePtr, int offset, const char *msg, int flags, int *indexPtr); /* 304 */ - void * (*tcl_GetThreadData) (Tcl_ThreadDataKey *keyPtr, int size); /* 305 */ + int (*tcl_GetIndexFromObjStruct) (Tcl_Interp *interp, Tcl_Obj *objPtr, const void *tablePtr, size_t offset, const char *msg, int flags, int *indexPtr); /* 304 */ + void * (*tcl_GetThreadData) (Tcl_ThreadDataKey *keyPtr, size_t size); /* 305 */ Tcl_Obj * (*tcl_GetVar2Ex) (Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 306 */ - ClientData (*tcl_InitNotifier) (void); /* 307 */ + void * (*tcl_InitNotifier) (void); /* 307 */ void (*tcl_MutexLock) (Tcl_Mutex *mutexPtr); /* 308 */ 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 */ - int (*tcl_NumUtfChars) (const char *src, int length); /* 312 */ - int (*tcl_ReadChars) (Tcl_Channel channel, Tcl_Obj *objPtr, int charsToRead, int appendFlag); /* 313 */ - void (*tcl_RestoreResult) (Tcl_Interp *interp, Tcl_SavedResult *statePtr); /* 314 */ - void (*tcl_SaveResult) (Tcl_Interp *interp, Tcl_SavedResult *statePtr); /* 315 */ + size_t (*tcl_NumUtfChars) (const char *src, size_t length); /* 312 */ + size_t (*tcl_ReadChars) (Tcl_Channel channel, Tcl_Obj *objPtr, size_t charsToRead, int appendFlag); /* 313 */ + 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 */ void (*tcl_ThreadQueueEvent) (Tcl_ThreadId threadId, Tcl_Event *evPtr, Tcl_QueuePosition position); /* 319 */ - int (*tcl_UniCharAtIndex) (const char *src, int index); /* 320 */ + int (*tcl_UniCharAtIndex) (const char *src, size_t index); /* 320 */ 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, int index); /* 325 */ - int (*tcl_UtfCharComplete) (const char *src, int length); /* 326 */ - int (*tcl_UtfBackslash) (const char *src, int *readPtr, char *dst); /* 327 */ + const char * (*tcl_UtfAtIndex) (const char *src, size_t index); /* 325 */ + int (*tcl_UtfCharComplete) (const char *src, size_t length); /* 326 */ + size_t (*tcl_UtfBackslash) (const char *src, int *readPtr, char *dst); /* 327 */ const char * (*tcl_UtfFindFirst) (const char *src, int ch); /* 328 */ const char * (*tcl_UtfFindLast) (const char *src, int ch); /* 329 */ const char * (*tcl_UtfNext) (const char *src); /* 330 */ const char * (*tcl_UtfPrev) (const char *src, const char *start); /* 331 */ - int (*tcl_UtfToExternal) (Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); /* 332 */ - char * (*tcl_UtfToExternalDString) (Tcl_Encoding encoding, const char *src, int srcLen, Tcl_DString *dsPtr); /* 333 */ + int (*tcl_UtfToExternal) (Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, size_t srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, size_t dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); /* 332 */ + char * (*tcl_UtfToExternalDString) (Tcl_Encoding encoding, const char *src, size_t 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 */ - int (*tcl_WriteChars) (Tcl_Channel chan, const char *src, int srcLen); /* 338 */ - int (*tcl_WriteObj) (Tcl_Channel chan, Tcl_Obj *objPtr); /* 339 */ + size_t (*tcl_WriteChars) (Tcl_Channel chan, const char *src, size_t srcLen); /* 338 */ + size_t (*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 (*tcl_AlertNotifier) (ClientData clientData); /* 343 */ + void (*reserved341)(void); + void (*reserved342)(void); + void (*tcl_AlertNotifier) (void *clientData); /* 343 */ void (*tcl_ServiceModeHook) (int mode); /* 344 */ int (*tcl_UniCharIsAlnum) (int ch); /* 345 */ int (*tcl_UniCharIsAlpha) (int ch); /* 346 */ @@ -2307,60 +2138,60 @@ typedef struct TclStubs { int (*tcl_UniCharIsSpace) (int ch); /* 349 */ int (*tcl_UniCharIsUpper) (int ch); /* 350 */ int (*tcl_UniCharIsWordChar) (int ch); /* 351 */ - TCL_DEPRECATED_API("Use Tcl_GetCharLength") int (*tcl_UniCharLen) (const Tcl_UniChar *uniStr); /* 352 */ - TCL_DEPRECATED_API("Use Tcl_UtfNcmp") int (*tcl_UniCharNcmp) (const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned long numChars); /* 353 */ - char * (*tcl_Char16ToUtfDString) (const unsigned short *uniStr, int uniLength, Tcl_DString *dsPtr); /* 354 */ - unsigned short * (*tcl_UtfToChar16DString) (const char *src, int length, Tcl_DString *dsPtr); /* 355 */ + void (*reserved352)(void); + void (*reserved353)(void); + char * (*tcl_Char16ToUtfDString) (const unsigned short *uniStr, size_t uniLength, Tcl_DString *dsPtr); /* 354 */ + unsigned short * (*tcl_UtfToChar16DString) (const char *src, size_t 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, int length); /* 359 */ - int (*tcl_ParseBraces) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, const char **termPtr); /* 360 */ - int (*tcl_ParseCommand) (Tcl_Interp *interp, const char *start, int numBytes, int nested, Tcl_Parse *parsePtr); /* 361 */ - int (*tcl_ParseExpr) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr); /* 362 */ - int (*tcl_ParseQuotedString) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, const char **termPtr); /* 363 */ - int (*tcl_ParseVarName) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append); /* 364 */ + void (*tcl_LogCommandInfo) (Tcl_Interp *interp, const char *script, const char *command, size_t length); /* 359 */ + int (*tcl_ParseBraces) (Tcl_Interp *interp, const char *start, size_t numBytes, Tcl_Parse *parsePtr, int append, const char **termPtr); /* 360 */ + int (*tcl_ParseCommand) (Tcl_Interp *interp, const char *start, size_t numBytes, int nested, Tcl_Parse *parsePtr); /* 361 */ + int (*tcl_ParseExpr) (Tcl_Interp *interp, const char *start, size_t numBytes, Tcl_Parse *parsePtr); /* 362 */ + int (*tcl_ParseQuotedString) (Tcl_Interp *interp, const char *start, size_t numBytes, Tcl_Parse *parsePtr, int append, const char **termPtr); /* 363 */ + int (*tcl_ParseVarName) (Tcl_Interp *interp, const char *start, size_t numBytes, Tcl_Parse *parsePtr, int append); /* 364 */ char * (*tcl_GetCwd) (Tcl_Interp *interp, Tcl_DString *cwdPtr); /* 365 */ int (*tcl_Chdir) (const char *dirName); /* 366 */ int (*tcl_Access) (const char *path, int mode); /* 367 */ int (*tcl_Stat) (const char *path, struct stat *bufPtr); /* 368 */ - int (*tcl_UtfNcmp) (const char *s1, const char *s2, unsigned long n); /* 369 */ - int (*tcl_UtfNcasecmp) (const char *s1, const char *s2, unsigned long n); /* 370 */ + int (*tcl_UtfNcmp) (const char *s1, const char *s2, size_t n); /* 369 */ + int (*tcl_UtfNcasecmp) (const char *s1, const char *s2, size_t n); /* 370 */ int (*tcl_StringCaseMatch) (const char *str, const char *pattern, int nocase); /* 371 */ int (*tcl_UniCharIsControl) (int ch); /* 372 */ int (*tcl_UniCharIsGraph) (int ch); /* 373 */ int (*tcl_UniCharIsPrint) (int ch); /* 374 */ int (*tcl_UniCharIsPunct) (int ch); /* 375 */ - int (*tcl_RegExpExecObj) (Tcl_Interp *interp, Tcl_RegExp regexp, Tcl_Obj *textObj, int offset, int nmatches, int flags); /* 376 */ + int (*tcl_RegExpExecObj) (Tcl_Interp *interp, Tcl_RegExp regexp, Tcl_Obj *textObj, size_t offset, size_t nmatches, int flags); /* 376 */ void (*tcl_RegExpGetInfo) (Tcl_RegExp regexp, Tcl_RegExpInfo *infoPtr); /* 377 */ - Tcl_Obj * (*tcl_NewUnicodeObj) (const Tcl_UniChar *unicode, int numChars); /* 378 */ - void (*tcl_SetUnicodeObj) (Tcl_Obj *objPtr, const Tcl_UniChar *unicode, int numChars); /* 379 */ - int (*tcl_GetCharLength) (Tcl_Obj *objPtr); /* 380 */ - int (*tcl_GetUniChar) (Tcl_Obj *objPtr, int index); /* 381 */ - TCL_DEPRECATED_API("No longer in use, changed to macro") Tcl_UniChar * (*tcl_GetUnicode) (Tcl_Obj *objPtr); /* 382 */ - Tcl_Obj * (*tcl_GetRange) (Tcl_Obj *objPtr, int first, int last); /* 383 */ - TCL_DEPRECATED_API("Use Tcl_AppendStringsToObj") void (*tcl_AppendUnicodeToObj) (Tcl_Obj *objPtr, const Tcl_UniChar *unicode, int length); /* 384 */ + Tcl_Obj * (*tcl_NewUnicodeObj) (const Tcl_UniChar *unicode, size_t numChars); /* 378 */ + void (*tcl_SetUnicodeObj) (Tcl_Obj *objPtr, const Tcl_UniChar *unicode, size_t numChars); /* 379 */ + size_t (*tcl_GetCharLength) (Tcl_Obj *objPtr); /* 380 */ + int (*tcl_GetUniChar) (Tcl_Obj *objPtr, size_t index); /* 381 */ + void (*reserved382)(void); + Tcl_Obj * (*tcl_GetRange) (Tcl_Obj *objPtr, size_t first, size_t last); /* 383 */ + void (*reserved384)(void); int (*tcl_RegExpMatchObj) (Tcl_Interp *interp, Tcl_Obj *textObj, Tcl_Obj *patternObj); /* 385 */ void (*tcl_SetNotifier) (Tcl_NotifierProcs *notifierProcPtr); /* 386 */ Tcl_Mutex * (*tcl_GetAllocMutex) (void); /* 387 */ int (*tcl_GetChannelNames) (Tcl_Interp *interp); /* 388 */ int (*tcl_GetChannelNamesEx) (Tcl_Interp *interp, const char *pattern); /* 389 */ - int (*tcl_ProcObjCmd) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 390 */ + int (*tcl_ProcObjCmd) (void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 390 */ void (*tcl_ConditionFinalize) (Tcl_Condition *condPtr); /* 391 */ void (*tcl_MutexFinalize) (Tcl_Mutex *mutex); /* 392 */ - int (*tcl_CreateThread) (Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc *proc, ClientData clientData, int stackSize, int flags); /* 393 */ - int (*tcl_ReadRaw) (Tcl_Channel chan, char *dst, int bytesToRead); /* 394 */ - int (*tcl_WriteRaw) (Tcl_Channel chan, const char *src, int srcLen); /* 395 */ + int (*tcl_CreateThread) (Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc *proc, void *clientData, size_t stackSize, int flags); /* 393 */ + size_t (*tcl_ReadRaw) (Tcl_Channel chan, char *dst, size_t bytesToRead); /* 394 */ + size_t (*tcl_WriteRaw) (Tcl_Channel chan, const char *src, size_t srcLen); /* 395 */ Tcl_Channel (*tcl_GetTopChannel) (Tcl_Channel chan); /* 396 */ int (*tcl_ChannelBuffered) (Tcl_Channel chan); /* 397 */ 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 */ @@ -2374,24 +2205,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 Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned long numChars); /* 419 */ - TCL_DEPRECATED_API("Use Tcl_StringCaseMatch") int (*tcl_UniCharCaseMatch) (const Tcl_UniChar *uniStr, const Tcl_UniChar *uniPattern, int nocase); /* 420 */ - Tcl_HashEntry * (*tcl_FindHashEntry) (Tcl_HashTable *tablePtr, const void *key); /* 421 */ - Tcl_HashEntry * (*tcl_CreateHashEntry) (Tcl_HashTable *tablePtr, const void *key, int *newPtr); /* 422 */ + 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 */ - ClientData (*tcl_CommandTraceInfo) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *procPtr, ClientData prevClientData); /* 425 */ - int (*tcl_TraceCommand) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *proc, ClientData clientData); /* 426 */ - void (*tcl_UntraceCommand) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *proc, ClientData clientData); /* 427 */ - char * (*tcl_AttemptAlloc) (unsigned int size); /* 428 */ - char * (*tcl_AttemptDbCkalloc) (unsigned int size, const char *file, int line); /* 429 */ - char * (*tcl_AttemptRealloc) (char *ptr, unsigned int size); /* 430 */ - char * (*tcl_AttemptDbCkrealloc) (char *ptr, unsigned int size, const char *file, int line); /* 431 */ - int (*tcl_AttemptSetObjLength) (Tcl_Obj *objPtr, int length); /* 432 */ + 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 */ + void * (*tcl_AttemptAlloc) (size_t size); /* 428 */ + void * (*tcl_AttemptDbCkalloc) (size_t size, const char *file, int line); /* 429 */ + void * (*tcl_AttemptRealloc) (void *ptr, size_t size); /* 430 */ + void * (*tcl_AttemptDbCkrealloc) (void *ptr, size_t size, const char *file, int line); /* 431 */ + int (*tcl_AttemptSetObjLength) (Tcl_Obj *objPtr, size_t length); /* 432 */ Tcl_ThreadId (*tcl_GetChannelThread) (Tcl_Channel channel); /* 433 */ Tcl_UniChar * (*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, ClientData *clientDataPtr); /* 435 */ - TCL_DEPRECATED_API("") Tcl_Obj * (*tcl_ListMathFuncs) (Tcl_Interp *interp, const char *pattern); /* 436 */ + void (*reserved435)(void); + void (*reserved436)(void); Tcl_Obj * (*tcl_SubstObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 437 */ int (*tcl_DetachChannel) (Tcl_Interp *interp, Tcl_Channel channel); /* 438 */ int (*tcl_IsStandardChannel) (Tcl_Channel channel); /* 439 */ @@ -2408,7 +2239,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 */ @@ -2420,25 +2251,25 @@ typedef struct TclStubs { 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, int objc, Tcl_Obj *const objv[]); /* 464 */ - ClientData (*tcl_FSGetInternalRep) (Tcl_Obj *pathPtr, const Tcl_Filesystem *fsPtr); /* 465 */ + void * (*tcl_FSGetInternalRep) (Tcl_Obj *pathPtr, const Tcl_Filesystem *fsPtr); /* 465 */ Tcl_Obj * (*tcl_FSGetTranslatedPath) (Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 466 */ int (*tcl_FSEvalFile) (Tcl_Interp *interp, Tcl_Obj *fileName); /* 467 */ - Tcl_Obj * (*tcl_FSNewNativePath) (const Tcl_Filesystem *fromFilesystem, ClientData clientData); /* 468 */ + Tcl_Obj * (*tcl_FSNewNativePath) (const Tcl_Filesystem *fromFilesystem, void *clientData); /* 468 */ const void * (*tcl_FSGetNativePath) (Tcl_Obj *pathPtr); /* 469 */ Tcl_Obj * (*tcl_FSFileSystemInfo) (Tcl_Obj *pathPtr); /* 470 */ Tcl_Obj * (*tcl_FSPathSeparator) (Tcl_Obj *pathPtr); /* 471 */ Tcl_Obj * (*tcl_FSListVolumes) (void); /* 472 */ - int (*tcl_FSRegister) (ClientData clientData, const Tcl_Filesystem *fsPtr); /* 473 */ + int (*tcl_FSRegister) (void *clientData, const Tcl_Filesystem *fsPtr); /* 473 */ int (*tcl_FSUnregister) (const Tcl_Filesystem *fsPtr); /* 474 */ - ClientData (*tcl_FSData) (const Tcl_Filesystem *fsPtr); /* 475 */ + 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 */ - int (*tcl_EvalTokensStandard) (Tcl_Interp *interp, Tcl_Token *tokenPtr, int count); /* 481 */ + int (*tcl_EvalTokensStandard) (Tcl_Interp *interp, Tcl_Token *tokenPtr, size_t count); /* 481 */ void (*tcl_GetTime) (Tcl_Time *timeBuf); /* 482 */ - Tcl_Trace (*tcl_CreateObjTrace) (Tcl_Interp *interp, int level, int flags, Tcl_CmdObjTraceProc *objProc, ClientData clientData, Tcl_CmdObjTraceDeleteProc *delProc); /* 483 */ + Tcl_Trace (*tcl_CreateObjTrace) (Tcl_Interp *interp, int level, int flags, Tcl_CmdObjTraceProc *objProc, void *clientData, Tcl_CmdObjTraceDeleteProc *delProc); /* 483 */ int (*tcl_GetCommandInfoFromToken) (Tcl_Command token, Tcl_CmdInfo *infoPtr); /* 484 */ int (*tcl_SetCommandInfoFromToken) (Tcl_Command token, const Tcl_CmdInfo *infoPtr); /* 485 */ Tcl_Obj * (*tcl_DbNewWideIntObj) (Tcl_WideInt wideValue, const char *file, int line); /* 486 */ @@ -2461,7 +2292,7 @@ typedef struct TclStubs { Tcl_Obj * (*tcl_NewDictObj) (void); /* 503 */ Tcl_Obj * (*tcl_DbNewDictObj) (const char *file, int line); /* 504 */ void (*tcl_RegisterConfig) (Tcl_Interp *interp, const char *pkgName, const Tcl_Config *configuration, const char *valEncoding); /* 505 */ - Tcl_Namespace * (*tcl_CreateNamespace) (Tcl_Interp *interp, const char *name, ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc); /* 506 */ + Tcl_Namespace * (*tcl_CreateNamespace) (Tcl_Interp *interp, const char *name, void *clientData, Tcl_NamespaceDeleteProc *deleteProc); /* 506 */ void (*tcl_DeleteNamespace) (Tcl_Namespace *nsPtr); /* 507 */ int (*tcl_AppendExportList) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *objPtr); /* 508 */ int (*tcl_Export) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int resetListFirst); /* 509 */ @@ -2474,9 +2305,9 @@ 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 (*tcl_LimitAddHandler) (Tcl_Interp *interp, int type, Tcl_LimitHandlerProc *handlerProc, ClientData clientData, Tcl_LimitHandlerDeleteProc *deleteProc); /* 520 */ - void (*tcl_LimitRemoveHandler) (Tcl_Interp *interp, int type, Tcl_LimitHandlerProc *handlerProc, ClientData clientData); /* 521 */ + 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 */ int (*tcl_LimitCheck) (Tcl_Interp *interp); /* 523 */ int (*tcl_LimitExceeded) (Tcl_Interp *interp); /* 524 */ @@ -2507,8 +2338,8 @@ typedef struct TclStubs { int (*tcl_GetEnsembleUnknownHandler) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **unknownListPtr); /* 549 */ int (*tcl_GetEnsembleFlags) (Tcl_Interp *interp, Tcl_Command token, int *flagsPtr); /* 550 */ int (*tcl_GetEnsembleNamespace) (Tcl_Interp *interp, Tcl_Command token, Tcl_Namespace **namespacePtrPtr); /* 551 */ - void (*tcl_SetTimeProc) (Tcl_GetTimeProc *getProc, Tcl_ScaleTimeProc *scaleProc, ClientData clientData); /* 552 */ - void (*tcl_QueryTimeProc) (Tcl_GetTimeProc **getProc, Tcl_ScaleTimeProc **scaleProc, ClientData *clientData); /* 553 */ + void (*tcl_SetTimeProc) (Tcl_GetTimeProc *getProc, Tcl_ScaleTimeProc *scaleProc, void *clientData); /* 552 */ + void (*tcl_QueryTimeProc) (Tcl_GetTimeProc **getProc, Tcl_ScaleTimeProc **scaleProc, void **clientData); /* 553 */ Tcl_DriverThreadActionProc * (*tcl_ChannelThreadActionProc) (const Tcl_ChannelType *chanTypePtr); /* 554 */ Tcl_Obj * (*tcl_NewBignumObj) (void *value); /* 555 */ Tcl_Obj * (*tcl_DbNewBignumObj) (void *value, const char *file, int line); /* 556 */ @@ -2530,20 +2361,20 @@ typedef struct TclStubs { const char * (*tcl_GetEncodingNameFromEnvironment) (Tcl_DString *bufPtr); /* 572 */ int (*tcl_PkgRequireProc) (Tcl_Interp *interp, const char *name, int objc, Tcl_Obj *const objv[], void *clientDataPtr); /* 573 */ void (*tcl_AppendObjToErrorInfo) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 574 */ - void (*tcl_AppendLimitedToObj) (Tcl_Obj *objPtr, const char *bytes, int length, int limit, const char *ellipsis); /* 575 */ + void (*tcl_AppendLimitedToObj) (Tcl_Obj *objPtr, const char *bytes, size_t length, size_t limit, const char *ellipsis); /* 575 */ Tcl_Obj * (*tcl_Format) (Tcl_Interp *interp, const char *format, int objc, Tcl_Obj *const objv[]); /* 576 */ int (*tcl_AppendFormatToObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, const char *format, int objc, Tcl_Obj *const objv[]); /* 577 */ Tcl_Obj * (*tcl_ObjPrintf) (const char *format, ...) TCL_FORMAT_PRINTF(1, 2); /* 578 */ void (*tcl_AppendPrintfToObj) (Tcl_Obj *objPtr, const char *format, ...) TCL_FORMAT_PRINTF(2, 3); /* 579 */ - int (*tcl_CancelEval) (Tcl_Interp *interp, Tcl_Obj *resultObjPtr, ClientData clientData, int flags); /* 580 */ + int (*tcl_CancelEval) (Tcl_Interp *interp, Tcl_Obj *resultObjPtr, void *clientData, int flags); /* 580 */ int (*tcl_Canceled) (Tcl_Interp *interp, int flags); /* 581 */ int (*tcl_CreatePipe) (Tcl_Interp *interp, Tcl_Channel *rchan, Tcl_Channel *wchan, int flags); /* 582 */ - Tcl_Command (*tcl_NRCreateCommand) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc *proc, Tcl_ObjCmdProc *nreProc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc); /* 583 */ + Tcl_Command (*tcl_NRCreateCommand) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc *proc, Tcl_ObjCmdProc *nreProc, void *clientData, Tcl_CmdDeleteProc *deleteProc); /* 583 */ int (*tcl_NREvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 584 */ int (*tcl_NREvalObjv) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags); /* 585 */ int (*tcl_NRCmdSwap) (Tcl_Interp *interp, Tcl_Command cmd, int objc, Tcl_Obj *const objv[], int flags); /* 586 */ - void (*tcl_NRAddCallback) (Tcl_Interp *interp, Tcl_NRPostProc *postProcPtr, ClientData data0, ClientData data1, ClientData data2, ClientData data3); /* 587 */ - int (*tcl_NRCallObjProc) (Tcl_Interp *interp, Tcl_ObjCmdProc *objProc, ClientData clientData, int objc, Tcl_Obj *const objv[]); /* 588 */ + void (*tcl_NRAddCallback) (Tcl_Interp *interp, Tcl_NRPostProc *postProcPtr, void *data0, void *data1, void *data2, void *data3); /* 587 */ + int (*tcl_NRCallObjProc) (Tcl_Interp *interp, Tcl_ObjCmdProc *objProc, void *clientData, int objc, Tcl_Obj *const objv[]); /* 588 */ unsigned (*tcl_GetFSDeviceFromStat) (const Tcl_StatBuf *statPtr); /* 589 */ unsigned (*tcl_GetFSInodeFromStat) (const Tcl_StatBuf *statPtr); /* 590 */ unsigned (*tcl_GetModeFromStat) (const Tcl_StatBuf *statPtr); /* 591 */ @@ -2566,15 +2397,15 @@ typedef struct TclStubs { int (*tcl_InterpActive) (Tcl_Interp *interp); /* 608 */ void (*tcl_BackgroundException) (Tcl_Interp *interp, int code); /* 609 */ int (*tcl_ZlibDeflate) (Tcl_Interp *interp, int format, Tcl_Obj *data, int level, Tcl_Obj *gzipHeaderDictObj); /* 610 */ - int (*tcl_ZlibInflate) (Tcl_Interp *interp, int format, Tcl_Obj *data, int buffersize, Tcl_Obj *gzipHeaderDictObj); /* 611 */ - unsigned int (*tcl_ZlibCRC32) (unsigned int crc, const unsigned char *buf, int len); /* 612 */ - unsigned int (*tcl_ZlibAdler32) (unsigned int adler, const unsigned char *buf, int len); /* 613 */ + int (*tcl_ZlibInflate) (Tcl_Interp *interp, int format, Tcl_Obj *data, size_t buffersize, Tcl_Obj *gzipHeaderDictObj); /* 611 */ + unsigned int (*tcl_ZlibCRC32) (unsigned int crc, const unsigned char *buf, size_t len); /* 612 */ + unsigned int (*tcl_ZlibAdler32) (unsigned int adler, const unsigned char *buf, size_t len); /* 613 */ int (*tcl_ZlibStreamInit) (Tcl_Interp *interp, int mode, int format, int level, Tcl_Obj *dictObj, Tcl_ZlibStream *zshandle); /* 614 */ Tcl_Obj * (*tcl_ZlibStreamGetCommandName) (Tcl_ZlibStream zshandle); /* 615 */ int (*tcl_ZlibStreamEof) (Tcl_ZlibStream zshandle); /* 616 */ int (*tcl_ZlibStreamChecksum) (Tcl_ZlibStream zshandle); /* 617 */ int (*tcl_ZlibStreamPut) (Tcl_ZlibStream zshandle, Tcl_Obj *data, int flush); /* 618 */ - int (*tcl_ZlibStreamGet) (Tcl_ZlibStream zshandle, Tcl_Obj *data, int count); /* 619 */ + int (*tcl_ZlibStreamGet) (Tcl_ZlibStream zshandle, Tcl_Obj *data, size_t count); /* 619 */ int (*tcl_ZlibStreamClose) (Tcl_ZlibStream zshandle); /* 620 */ int (*tcl_ZlibStreamReset) (Tcl_ZlibStream zshandle); /* 621 */ void (*tcl_SetStartupScript) (Tcl_Obj *path, const char *encoding); /* 622 */ @@ -2586,24 +2417,24 @@ typedef struct TclStubs { void * (*tcl_FindSymbol) (Tcl_Interp *interp, Tcl_LoadHandle handle, const char *symbol); /* 628 */ int (*tcl_FSUnloadFile) (Tcl_Interp *interp, Tcl_LoadHandle handlePtr); /* 629 */ void (*tcl_ZlibStreamSetCompressionDictionary) (Tcl_ZlibStream zhandle, Tcl_Obj *compressionDictionaryObj); /* 630 */ - Tcl_Channel (*tcl_OpenTcpServerEx) (Tcl_Interp *interp, const char *service, const char *host, unsigned int flags, Tcl_TcpAcceptProc *acceptProc, ClientData callbackData); /* 631 */ + Tcl_Channel (*tcl_OpenTcpServerEx) (Tcl_Interp *interp, const char *service, const char *host, unsigned int flags, Tcl_TcpAcceptProc *acceptProc, void *callbackData); /* 631 */ int (*tclZipfs_Mount) (Tcl_Interp *interp, const char *mountPoint, const char *zipname, const char *passwd); /* 632 */ int (*tclZipfs_Unmount) (Tcl_Interp *interp, const char *mountPoint); /* 633 */ Tcl_Obj * (*tclZipfs_TclLibrary) (void); /* 634 */ int (*tclZipfs_MountBuffer) (Tcl_Interp *interp, const char *mountPoint, unsigned char *data, size_t datalen, int copy); /* 635 */ void (*tcl_FreeIntRep) (Tcl_Obj *objPtr); /* 636 */ - char * (*tcl_InitStringRep) (Tcl_Obj *objPtr, const char *bytes, unsigned int numBytes); /* 637 */ + char * (*tcl_InitStringRep) (Tcl_Obj *objPtr, const char *bytes, size_t numBytes); /* 637 */ Tcl_ObjIntRep * (*tcl_FetchIntRep) (Tcl_Obj *objPtr, const Tcl_ObjType *typePtr); /* 638 */ void (*tcl_StoreIntRep) (Tcl_Obj *objPtr, const Tcl_ObjType *typePtr, const Tcl_ObjIntRep *irPtr); /* 639 */ int (*tcl_HasStringRep) (Tcl_Obj *objPtr); /* 640 */ void (*tcl_IncrRefCount) (Tcl_Obj *objPtr); /* 641 */ void (*tcl_DecrRefCount) (Tcl_Obj *objPtr); /* 642 */ int (*tcl_IsShared) (Tcl_Obj *objPtr); /* 643 */ - int (*tcl_LinkArray) (Tcl_Interp *interp, const char *varName, void *addr, int type, int size); /* 644 */ - int (*tcl_GetIntForIndex) (Tcl_Interp *interp, Tcl_Obj *objPtr, int endValue, int *indexPtr); /* 645 */ + int (*tcl_LinkArray) (Tcl_Interp *interp, const char *varName, void *addr, int type, size_t size); /* 644 */ + int (*tcl_GetIntForIndex) (Tcl_Interp *interp, Tcl_Obj *objPtr, size_t endValue, size_t *indexPtr); /* 645 */ int (*tcl_UtfToUniChar) (const char *src, int *chPtr); /* 646 */ - char * (*tcl_UniCharToUtfDString) (const int *uniStr, int uniLength, Tcl_DString *dsPtr); /* 647 */ - int * (*tcl_UtfToUniCharDString) (const char *src, int length, Tcl_DString *dsPtr); /* 648 */ + char * (*tcl_UniCharToUtfDString) (const int *uniStr, size_t uniLength, Tcl_DString *dsPtr); /* 647 */ + int * (*tcl_UtfToUniCharDString) (const char *src, size_t length, Tcl_DString *dsPtr); /* 648 */ } TclStubs; extern const TclStubs *tclStubsPtr; @@ -2674,16 +2505,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 \ @@ -2702,8 +2531,7 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_GetDouble) /* 34 */ #define Tcl_GetDoubleFromObj \ (tclStubsPtr->tcl_GetDoubleFromObj) /* 35 */ -#define Tcl_GetIndexFromObj \ - (tclStubsPtr->tcl_GetIndexFromObj) /* 36 */ +/* Slot 36 is reserved */ #define Tcl_GetInt \ (tclStubsPtr->tcl_GetInt) /* 37 */ #define Tcl_GetIntFromObj \ @@ -2728,44 +2556,36 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_ListObjLength) /* 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 \ @@ -2782,18 +2602,15 @@ 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 \ (tclStubsPtr->tcl_CallWhenDeleted) /* 79 */ #define Tcl_CancelIdleCall \ (tclStubsPtr->tcl_CancelIdleCall) /* 80 */ -#define Tcl_Close \ - (tclStubsPtr->tcl_Close) /* 81 */ +/* Slot 81 is reserved */ #define Tcl_CommandComplete \ (tclStubsPtr->tcl_CommandComplete) /* 82 */ #define Tcl_Concat \ @@ -2820,8 +2637,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 \ @@ -2888,12 +2704,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 \ @@ -2918,14 +2732,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 \ @@ -2984,16 +2796,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 \ @@ -3075,8 +2883,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 \ @@ -3095,12 +2902,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 \ @@ -3109,8 +2914,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 \ @@ -3123,14 +2927,10 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_SplitList) /* 242 */ #define Tcl_SplitPath \ (tclStubsPtr->tcl_SplitPath) /* 243 */ -#define Tcl_StaticPackage \ - (tclStubsPtr->tcl_StaticPackage) /* 244 */ -#define Tcl_StringMatch \ - (tclStubsPtr->tcl_StringMatch) /* 245 */ -#define Tcl_TellOld \ - (tclStubsPtr->tcl_TellOld) /* 246 */ -#define Tcl_TraceVar \ - (tclStubsPtr->tcl_TraceVar) /* 247 */ +/* Slot 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 \ @@ -3141,24 +2941,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 \ @@ -3169,30 +2965,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 \ @@ -3214,8 +3002,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 \ @@ -3262,10 +3049,8 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_NumUtfChars) /* 312 */ #define Tcl_ReadChars \ (tclStubsPtr->tcl_ReadChars) /* 313 */ -#define Tcl_RestoreResult \ - (tclStubsPtr->tcl_RestoreResult) /* 314 */ -#define Tcl_SaveResult \ - (tclStubsPtr->tcl_SaveResult) /* 315 */ +/* Slot 314 is reserved */ +/* Slot 315 is reserved */ #define Tcl_SetSystemEncoding \ (tclStubsPtr->tcl_SetSystemEncoding) /* 316 */ #define Tcl_SetVar2Ex \ @@ -3316,10 +3101,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 \ @@ -3338,18 +3121,15 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_UniCharIsUpper) /* 350 */ #define Tcl_UniCharIsWordChar \ (tclStubsPtr->tcl_UniCharIsWordChar) /* 351 */ -#define Tcl_UniCharLen \ - (tclStubsPtr->tcl_UniCharLen) /* 352 */ -#define Tcl_UniCharNcmp \ - (tclStubsPtr->tcl_UniCharNcmp) /* 353 */ +/* Slot 352 is reserved */ +/* 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 \ @@ -3398,12 +3178,10 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_GetCharLength) /* 380 */ #define Tcl_GetUniChar \ (tclStubsPtr->tcl_GetUniChar) /* 381 */ -#define Tcl_GetUnicode \ - (tclStubsPtr->tcl_GetUnicode) /* 382 */ +/* Slot 382 is reserved */ #define Tcl_GetRange \ (tclStubsPtr->tcl_GetRange) /* 383 */ -#define Tcl_AppendUnicodeToObj \ - (tclStubsPtr->tcl_AppendUnicodeToObj) /* 384 */ +/* Slot 384 is reserved */ #define Tcl_RegExpMatchObj \ (tclStubsPtr->tcl_RegExpMatchObj) /* 385 */ #define Tcl_SetNotifier \ @@ -3436,16 +3214,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 \ @@ -3472,14 +3248,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 \ @@ -3504,10 +3276,8 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_GetChannelThread) /* 433 */ #define Tcl_GetUnicodeFromObj \ (tclStubsPtr->tcl_GetUnicodeFromObj) /* 434 */ -#define Tcl_GetMathFuncInfo \ - (tclStubsPtr->tcl_GetMathFuncInfo) /* 435 */ -#define Tcl_ListMathFuncs \ - (tclStubsPtr->tcl_ListMathFuncs) /* 436 */ +/* Slot 435 is reserved */ +/* Slot 436 is reserved */ #define Tcl_SubstObj \ (tclStubsPtr->tcl_SubstObj) /* 437 */ #define Tcl_DetachChannel \ @@ -3672,8 +3442,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 \ @@ -3939,15 +3708,9 @@ extern const TclStubs *tclStubsPtr; #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_StaticPackage # 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)) @@ -3956,107 +3719,65 @@ extern const TclStubs *tclStubsPtr; #if defined(_WIN32) && defined(UNICODE) # define Tcl_FindExecutable(arg) ((Tcl_FindExecutable)((const char *)(arg))) # define Tcl_MainEx Tcl_MainExW - EXTERN void Tcl_MainExW(int argc, wchar_t **argv, + EXTERN TCL_NORETURN void Tcl_MainExW(int argc, wchar_t **argv, Tcl_AppInitProc *appInitProc, Tcl_Interp *interp); #endif #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLIMPORT -#undef Tcl_SeekOld -#undef Tcl_TellOld - -#undef Tcl_PkgPresent #define Tcl_PkgPresent(interp, name, version, exact) \ Tcl_PkgPresentEx(interp, name, version, exact, NULL) -#undef Tcl_PkgProvide #define Tcl_PkgProvide(interp, name, version) \ Tcl_PkgProvideEx(interp, name, version, NULL) -#undef Tcl_PkgRequire #define Tcl_PkgRequire(interp, name, version, exact) \ Tcl_PkgRequireEx(interp, name, version, exact, NULL) -#undef Tcl_GetIndexFromObj #define Tcl_GetIndexFromObj(interp, objPtr, tablePtr, msg, flags, indexPtr) \ Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, \ sizeof(char *), msg, flags, indexPtr) -#undef Tcl_NewBooleanObj #define Tcl_NewBooleanObj(boolValue) \ Tcl_NewWideIntObj((boolValue)!=0) -#undef Tcl_DbNewBooleanObj #define Tcl_DbNewBooleanObj(boolValue, file, line) \ Tcl_DbNewWideIntObj((boolValue)!=0, file, line) -#undef Tcl_SetBooleanObj #define Tcl_SetBooleanObj(objPtr, boolValue) \ Tcl_SetWideIntObj(objPtr, (boolValue)!=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, -1)) -#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_UniCharLen -#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, -1, 0) -#undef Tcl_GlobalEval #define Tcl_GlobalEval(interp, objPtr) \ Tcl_EvalEx(interp, objPtr, -1, TCL_EVAL_GLOBAL) -#undef Tcl_SaveResult +#define Tcl_GetStringResult(interp) Tcl_GetString(Tcl_GetObjResult(interp)) #define Tcl_SaveResult(interp, statePtr) \ do { \ - (statePtr)->objResultPtr = Tcl_GetObjResult(interp); \ - Tcl_IncrRefCount((statePtr)->objResultPtr); \ + *(statePtr) = Tcl_GetObjResult(interp); \ + Tcl_IncrRefCount(*(statePtr)); \ Tcl_SetObjResult(interp, Tcl_NewObj()); \ } while(0) -#undef Tcl_RestoreResult #define Tcl_RestoreResult(interp, statePtr) \ do { \ Tcl_ResetResult(interp); \ - Tcl_SetObjResult(interp, (statePtr)->objResultPtr); \ - Tcl_DecrRefCount((statePtr)->objResultPtr); \ + Tcl_SetObjResult(interp, *(statePtr)); \ + Tcl_DecrRefCount(*(statePtr)); \ } while(0) -#undef Tcl_DiscardResult #define Tcl_DiscardResult(statePtr) \ - Tcl_DecrRefCount((statePtr)->objResultPtr) -#undef Tcl_SetResult + Tcl_DecrRefCount(*(statePtr)) #define Tcl_SetResult(interp, result, freeProc) \ do { \ const char *__result = result; \ @@ -4064,13 +3785,12 @@ extern const TclStubs *tclStubsPtr; Tcl_SetObjResult(interp, Tcl_NewStringObj(__result, -1)); \ 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 */ #if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) # if defined(__CYGWIN__) && defined(TCL_WIDE_INT_IS_LONG) @@ -4084,10 +3804,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){ @@ -4103,32 +3819,34 @@ 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 -#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_GetUnicode #define Tcl_GetUnicode(objPtr) Tcl_GetUnicodeFromObj((objPtr), NULL) -#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 <= 3 @@ -4141,21 +3859,21 @@ extern const TclStubs *tclStubsPtr; #endif #if defined(USE_TCL_STUBS) # define Tcl_WCharToUtfDString (sizeof(wchar_t) != sizeof(short) \ - ? (char *(*)(const wchar_t *, int, Tcl_DString *))tclStubsPtr->tcl_UniCharToUtfDString \ - : (char *(*)(const wchar_t *, int, Tcl_DString *))Tcl_Char16ToUtfDString) + ? (char *(*)(const wchar_t *, size_t, Tcl_DString *))tclStubsPtr->tcl_UniCharToUtfDString \ + : (char *(*)(const wchar_t *, size_t, Tcl_DString *))Tcl_Char16ToUtfDString) # define Tcl_UtfToWCharDString (sizeof(wchar_t) != sizeof(short) \ - ? (wchar_t *(*)(const char *, int, Tcl_DString *))tclStubsPtr->tcl_UtfToUniCharDString \ - : (wchar_t *(*)(const char *, int, Tcl_DString *))Tcl_UtfToChar16DString) + ? (wchar_t *(*)(const char *, size_t, Tcl_DString *))tclStubsPtr->tcl_UtfToUniCharDString \ + : (wchar_t *(*)(const char *, size_t, Tcl_DString *))Tcl_UtfToChar16DString) # define Tcl_UtfToWChar (sizeof(wchar_t) != sizeof(short) \ ? (int (*)(const char *, wchar_t *))tclStubsPtr->tcl_UtfToChar16 \ : (int (*)(const char *, wchar_t *))Tcl_UtfToUniChar) #else # define Tcl_WCharToUtfDString (sizeof(wchar_t) != sizeof(short) \ - ? (char *(*)(const wchar_t *, int, Tcl_DString *))Tcl_UniCharToUtfDString \ - : (char *(*)(const wchar_t *, int, Tcl_DString *))Tcl_Char16ToUtfDString) + ? (char *(*)(const wchar_t *, size_t, Tcl_DString *))Tcl_UniCharToUtfDString \ + : (char *(*)(const wchar_t *, size_t, Tcl_DString *))Tcl_Char16ToUtfDString) # define Tcl_UtfToWCharDString (sizeof(wchar_t) != sizeof(short) \ - ? (wchar_t *(*)(const char *, int, Tcl_DString *))Tcl_UtfToUniCharDString \ - : (wchar_t *(*)(const char *, int, Tcl_DString *))Tcl_UtfToChar16DString) + ? (wchar_t *(*)(const char *, size_t, Tcl_DString *))Tcl_UtfToUniCharDString \ + : (wchar_t *(*)(const char *, size_t, Tcl_DString *))Tcl_UtfToChar16DString) # define Tcl_UtfToWChar (sizeof(wchar_t) != sizeof(short) \ ? (int (*)(const char *, wchar_t *))Tcl_UtfToChar16 \ : (int (*)(const char *, wchar_t *))Tcl_UtfToUniChar) @@ -4165,25 +3883,58 @@ extern const TclStubs *tclStubsPtr; * Deprecated Tcl procedures: */ -#undef Tcl_EvalObj #define Tcl_EvalObj(interp, objPtr) \ Tcl_EvalObjEx(interp, objPtr, 0) -#undef Tcl_GlobalEvalObj #define Tcl_GlobalEvalObj(interp, objPtr) \ Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL) -#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 defined(USE_TCL_STUBS) && (TCL_UTF_MAX > 3) +#define Tcl_Close(interp, chan) Tcl_CloseEx(interp, chan, 0) + +#if defined(USE_TCL_STUBS) && (TCL_UTF_MAX <= 3) # undef Tcl_UtfCharComplete # define Tcl_UtfCharComplete(src, length) (((unsigned)((unsigned char)*(src) - 0xF0) < 5) \ - ? ((length) >= 4) : tclStubsPtr->tcl_UtfCharComplete((src), (length))) + ? ((length) >= TCL_UTF_MAX) : tclStubsPtr->tcl_UtfCharComplete((src), (length))) +#endif +#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 9c11df6..8002fd4 100644 --- a/generic/tclDictObj.c +++ b/generic/tclDictObj.c @@ -129,7 +129,7 @@ typedef struct Dict { * the dictionary. Used for doing traversal of * the entries in the order that they are * created. */ - unsigned int epoch; /* Epoch counter */ + size_t epoch; /* Epoch counter */ size_t refCount; /* Reference counter (see above) */ Tcl_Obj *chain; /* Linked list used for invalidating the * string representations of updated nested @@ -228,10 +228,10 @@ 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); - cPtr->entry.clientData = NULL; + Tcl_SetHashValue(&cPtr->entry, NULL); cPtr->prevPtr = cPtr->nextPtr = NULL; return &cPtr->entry; @@ -359,7 +359,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; DictGetIntRep(srcPtr, oldDict); @@ -454,7 +454,7 @@ DeleteDict( Dict *dict) { DeleteChainTable(dict); - ckfree(dict); + Tcl_Free(dict); } /* @@ -488,7 +488,7 @@ UpdateStringOfDict( Dict *dict; ChainEntry *cPtr; Tcl_Obj *keyPtr, *valuePtr; - int i, length, bytesNeeded = 0; + size_t i, length, bytesNeeded = 0; const char *elem; char *dst; @@ -497,7 +497,7 @@ UpdateStringOfDict( * is not exposed by any API function... */ - int numElems; + size_t numElems; DictGetIntRep(dictPtr, dict); @@ -518,7 +518,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) { /* @@ -530,20 +530,10 @@ UpdateStringOfDict( keyPtr = (Tcl_Obj *)Tcl_GetHashKey(&dict->table, &cPtr->entry); elem = TclGetStringFromObj(keyPtr, &length); bytesNeeded += TclScanElement(elem, length, flagPtr+i); - if (bytesNeeded < 0) { - 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); bytesNeeded += TclScanElement(elem, length, flagPtr+i+1); - if (bytesNeeded < 0) { - Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); - } - } - if (bytesNeeded > INT_MAX - numElems + 1) { - Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); } bytesNeeded += numElems; @@ -569,7 +559,7 @@ UpdateStringOfDict( (void)Tcl_InitStringRep(dictPtr, NULL, bytesNeeded - 1); if (flagPtr != localFlags) { - ckfree(flagPtr); + Tcl_Free(flagPtr); } } @@ -600,7 +590,7 @@ SetDictFromAny( { Tcl_HashEntry *hPtr; int isNew; - Dict *dict = (Dict *)ckalloc(sizeof(Dict)); + Dict *dict = (Dict *)Tcl_Alloc(sizeof(Dict)); InitChainTable(dict); @@ -633,7 +623,7 @@ SetDictFromAny( * convert back. */ - (void) Tcl_GetString(objPtr); + (void) TclGetString(objPtr); TclDecrRefCount(discardedValue); } @@ -641,14 +631,15 @@ SetDictFromAny( Tcl_IncrRefCount(objv[i+1]); /* Since hash now holds ref to it */ } } else { - int length; + size_t length; const char *nextElem = TclGetStringFromObj(objPtr, &length); const char *limit = (nextElem + length); while (nextElem < limit) { Tcl_Obj *keyPtr, *valuePtr; const char *elemStart; - int elemSize, literal; + size_t elemSize; + int literal; if (TclFindDictElement(interp, nextElem, (limit - nextElem), &elemStart, &nextElem, &elemSize, &literal) != TCL_OK) { @@ -728,7 +719,7 @@ SetDictFromAny( } errorInFindDictElement: DeleteChainTable(dict); - ckfree(dict); + Tcl_Free(dict); return TCL_ERROR; } @@ -1406,7 +1397,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; @@ -1454,7 +1445,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; @@ -2124,7 +2115,7 @@ DictInfoCmd( statsStr = Tcl_HashStats(&dict->table); Tcl_SetObjResult(interp, Tcl_NewStringObj(statsStr, -1)); - ckfree(statsStr); + Tcl_Free(statsStr); return TCL_OK; } @@ -3299,7 +3290,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); diff --git a/generic/tclDisassemble.c b/generic/tclDisassemble.c index 8ccc303..a96dba9 100644 --- a/generic/tclDisassemble.c +++ b/generic/tclDisassemble.c @@ -193,10 +193,10 @@ TclPrintObject( FILE *outFile, /* The file to print the source to. */ Tcl_Obj *objPtr, /* Points to the Tcl object whose string * representation should be printed. */ - 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); TclPrintSource(outFile, bytes, TclMin(length, maxChars)); @@ -224,7 +224,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,16 +277,15 @@ 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", @@ -322,7 +321,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 %d, compiled locals %d\n", procPtr, procPtr->refCount, procPtr->numArgs, numCompiledLocals); if (numCompiledLocals > 0) { @@ -406,7 +405,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; @@ -416,7 +415,7 @@ DisassembleByteCodeObj( } codeOffset += delta; - if ((unsigned) *codeLengthNext == (unsigned) 0xFF) { + if (*codeLengthNext == 0xFF) { codeLengthNext++; codeLen = TclGetInt4AtPtr(codeLengthNext); codeLengthNext += 4; @@ -425,7 +424,7 @@ DisassembleByteCodeObj( codeLengthNext++; } - if ((unsigned) *srcDeltaNext == (unsigned) 0xFF) { + if (*srcDeltaNext == 0xFF) { srcDeltaNext++; delta = TclGetInt4AtPtr(srcDeltaNext); srcDeltaNext += 4; @@ -435,7 +434,7 @@ DisassembleByteCodeObj( } srcOffset += delta; - if ((unsigned) *srcLengthNext == (unsigned) 0xFF) { + if (*srcLengthNext == 0xFF) { srcLengthNext++; srcLen = TclGetInt4AtPtr(srcLengthNext); srcLengthNext += 4; @@ -465,7 +464,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; @@ -475,7 +474,7 @@ DisassembleByteCodeObj( } codeOffset += delta; - if ((unsigned) *srcDeltaNext == (unsigned) 0xFF) { + if (*srcDeltaNext == 0xFF) { srcDeltaNext++; delta = TclGetInt4AtPtr(srcDeltaNext); srcDeltaNext += 4; @@ -485,7 +484,7 @@ DisassembleByteCodeObj( } srcOffset += delta; - if ((unsigned) *srcLengthNext == (unsigned) 0xFF) { + if (*srcLengthNext == 0xFF) { srcLengthNext++; srcLen = TclGetInt4AtPtr(srcLengthNext); srcLengthNext += 4; @@ -565,7 +564,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; @@ -573,7 +572,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++; @@ -592,16 +591,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: @@ -625,19 +624,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++; @@ -651,7 +650,7 @@ FormatInstruction( } if (suffixObj) { const char *bytes; - int length; + size_t length; Tcl_AppendToObj(bufferObj, "\t# ", -1); bytes = TclGetStringFromObj(codePtr->objArrayPtr[opnd], &length); @@ -834,12 +833,12 @@ UpdateStringOfInstName( if (inst > LAST_INST_OPCODE) { dst = Tcl_InitStringRep(objPtr, NULL, TCL_INTEGER_SPACE + 5); - TclOOM(dst, TCL_INTEGER_SPACE + 5); + TclOOM(dst, (size_t)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); } diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index 48ab3cf..3bbb360 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -600,14 +600,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); @@ -684,70 +684,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(); - - Tcl_ListObjLength(NULL, searchPath, &numDirs); - if (numDirs == 0) { - return NULL; - } - Tcl_ListObjIndex(NULL, searchPath, 0, &first); - - return TclGetString(first); -} - -/* - *------------------------------------------------------------------------- - * - * Tcl_SetDefaultEncodingDir -- - * - * Legacy public interface to set the first directory in the encoding - * search path. - * - * Results: - * None. - * - * Side effects: - * Modifies the encoding search path. - * - *------------------------------------------------------------------------- - */ - -void -Tcl_SetDefaultEncodingDir( - const char *path) -{ - Tcl_Obj *searchPath = Tcl_GetEncodingSearchPath(); - Tcl_Obj *directory = Tcl_NewStringObj(path, -1); - - searchPath = Tcl_DuplicateObj(searchPath); - Tcl_ListObjReplace(NULL, searchPath, 0, 0, 1, &directory); - Tcl_SetEncodingSearchPath(searchPath); -} -#endif - -/* - *------------------------------------------------------------------------- - * * Tcl_GetEncoding -- * * Given the name of a encoding, find the corresponding Tcl_Encoding @@ -857,9 +793,9 @@ FreeEncoding( Tcl_DeleteHashEntry(encodingPtr->hPtr); } if (encodingPtr->name) { - ckfree(encodingPtr->name); + Tcl_Free(encodingPtr->name); } - ckfree(encodingPtr); + Tcl_Free(encodingPtr); } } @@ -1047,7 +983,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; @@ -1079,7 +1015,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); @@ -1115,7 +1051,7 @@ 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. */ @@ -1123,7 +1059,8 @@ Tcl_ExternalToUtfDString( char *dst; Tcl_EncodingState state; const Encoding *encodingPtr; - int flags, dstLen, result, soFar, srcRead, dstWrote, dstChars; + int flags, result, soFar, srcRead, dstWrote, dstChars; + size_t dstLen; Tcl_DStringInit(dstPtr); dst = Tcl_DStringValue(dstPtr); @@ -1136,7 +1073,7 @@ Tcl_ExternalToUtfDString( if (src == NULL) { srcLen = 0; - } else if (srcLen < 0) { + } else if (srcLen == TCL_INDEX_NONE) { srcLen = encodingPtr->lengthProc(src); } @@ -1188,8 +1125,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 @@ -1198,7 +1135,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 @@ -1226,7 +1163,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) { @@ -1304,7 +1241,7 @@ 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. */ @@ -1312,7 +1249,8 @@ Tcl_UtfToExternalDString( char *dst; Tcl_EncodingState state; const Encoding *encodingPtr; - int flags, dstLen, result, soFar, srcRead, dstWrote, dstChars; + int flags, result, soFar, srcRead, dstWrote, dstChars; + size_t dstLen; Tcl_DStringInit(dstPtr); dst = Tcl_DStringValue(dstPtr); @@ -1325,7 +1263,7 @@ Tcl_UtfToExternalDString( 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; @@ -1379,8 +1317,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 @@ -1389,7 +1327,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 @@ -1414,7 +1352,7 @@ Tcl_UtfToExternal( if (src == NULL) { srcLen = 0; - } else if (srcLen < 0) { + } else if (srcLen == TCL_INDEX_NONE) { srcLen = strlen(src); } if (statePtr == NULL) { @@ -1656,7 +1594,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; } @@ -1746,7 +1684,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; @@ -1758,7 +1696,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); @@ -1767,7 +1705,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; @@ -1819,7 +1757,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); @@ -1915,7 +1853,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; @@ -2009,7 +1947,7 @@ LoadEscapeEncoding( 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); @@ -2051,13 +1989,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); @@ -2343,7 +2281,6 @@ UtfToUtfProc( */ *dst++ = *src++; - *chPtr = 0; /* reset surrogate handling */ } else if (pureNullMode == 1 && UCHAR(*src) == 0xC0 && (src + 1 < srcEnd) && UCHAR(*(src+1)) == 0x80) { /* @@ -2351,7 +2288,6 @@ UtfToUtfProc( */ *dst++ = 0; - *chPtr = 0; /* reset surrogate handling */ src += 2; } else if (!TclUCS4Complete(src, srcEnd - src)) { /* @@ -3147,11 +3083,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); } /* @@ -3524,8 +3460,7 @@ EscapeFromUtfProc( result = TCL_CONVERT_NOSPACE; break; } - memcpy(dst, subTablePtr->sequence, - subTablePtr->sequenceLen); + memcpy(dst, subTablePtr->sequence, subTablePtr->sequenceLen); dst += subTablePtr->sequenceLen; } } @@ -3629,7 +3564,7 @@ EscapeFreeProc( subTablePtr++; } } - ckfree(dataPtr); + Tcl_Free(dataPtr); } /* @@ -3730,7 +3665,7 @@ unilen( static void InitializeEncodingSearchPath( char **valuePtr, - unsigned int *lengthPtr, + size_t *lengthPtr, Tcl_Encoding *encodingPtr) { const char *bytes; @@ -3764,10 +3699,8 @@ InitializeEncodingSearchPath( if (*encodingPtr) { ((Encoding *)(*encodingPtr))->refCount++; } - bytes = TclGetString(searchPathObj); - - *lengthPtr = searchPathObj->length; - *valuePtr = (char *)ckalloc(*lengthPtr + 1); + bytes = TclGetStringFromObj(searchPathObj, lengthPtr); + *valuePtr = (char *)Tcl_Alloc(*lengthPtr + 1); memcpy(*valuePtr, bytes, *lengthPtr + 1); Tcl_DecrRefCount(searchPathObj); } diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index 23516f8..0d048ab 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -105,7 +105,7 @@ static const Tcl_ObjType ensembleCmdType = { */ typedef struct { - unsigned 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 @@ -675,12 +675,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; } @@ -1624,7 +1624,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 { /* @@ -1645,7 +1645,7 @@ TclMakeEnsemble( Tcl_DStringFree(&buf); Tcl_DStringFree(&hiddenBuf); if (nameParts != NULL) { - ckfree(nameParts); + Tcl_Free((void *)nameParts); } return ensemble; } @@ -1701,7 +1701,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. Cf. test @@ -1710,7 +1710,7 @@ NsEnsembleImplementationCmdNR( restartEnsembleParse: subIdx = 1 + ensemblePtr->numParameters; - if (objc < subIdx + 1) { + if ((size_t)objc < subIdx + 1) { /* * We don't have a subcommand argument. Make error message. */ @@ -1807,8 +1807,8 @@ NsEnsembleImplementationCmdNR( * it (will be an error for a non-unique * prefix). */ 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); @@ -1972,7 +1972,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); @@ -2017,8 +2017,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; @@ -2030,7 +2030,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; @@ -2100,8 +2100,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; } @@ -2110,15 +2110,15 @@ TclSpellFix( Tcl_Interp *interp, Tcl_Obj *const *objv, int objc, - int badIdx, + 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; @@ -2176,9 +2176,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 *)); @@ -2418,7 +2418,7 @@ MakeCachedEnsembleCommand( * our own. */ - ensembleCmd = (EnsembleCmdRep *)ckalloc(sizeof(EnsembleCmdRep)); + ensembleCmd = (EnsembleCmdRep *)Tcl_Alloc(sizeof(EnsembleCmdRep)); ECRSetIntRep(objPtr, ensembleCmd); } @@ -2471,7 +2471,7 @@ ClearTable( Tcl_DecrRefCount(prefixObj); hPtr = Tcl_NextHashEntry(&search); } - ckfree((char *) ensemblePtr->subcommandArrayPtr); + Tcl_Free(ensemblePtr->subcommandArrayPtr); } Tcl_DeleteHashTable(hash); } @@ -2568,7 +2568,8 @@ BuildEnsembleConfig( Tcl_HashSearch search; /* Used for scanning the set of commands in * the namespace that backs up this * ensemble. */ - int i, j, isNew; + size_t i, j; + int isNew; Tcl_HashTable *hash = &ensemblePtr->subcommandTable; Tcl_HashEntry *hPtr; Tcl_Obj *mapDict = ensemblePtr->subcommandDict; @@ -2594,7 +2595,7 @@ BuildEnsembleConfig( * as the dict mapping to targets. */ - for (i = 0; i < subc; i += 2) { + for (i = 0; i < (size_t)subc; i += 2) { name = TclGetString(subv[i]); hPtr = Tcl_CreateHashEntry(hash, name, &isNew); if (!isNew) { @@ -2618,7 +2619,7 @@ BuildEnsembleConfig( * Usual case where we can freely act on the list and dict. */ - for (i = 0; i < subc; i++) { + for (i = 0; i < (size_t)subc; i++) { name = TclGetString(subv[i]); hPtr = Tcl_CreateHashEntry(hash, name, &isNew); if (!isNew) { @@ -2740,7 +2741,7 @@ BuildEnsembleConfig( */ ensemblePtr->subcommandArrayPtr = - (char **)ckalloc(sizeof(char *) * hash->numEntries); + (char **)Tcl_Alloc(sizeof(char *) * hash->numEntries); /* * Fill array from both ends as this makes us less likely to end up with @@ -2834,7 +2835,7 @@ FreeEnsembleCmdRep( if (ensembleCmd->fix) { Tcl_DecrRefCount(ensembleCmd->fix); } - ckfree(ensembleCmd); + Tcl_Free(ensembleCmd); } /* @@ -2861,7 +2862,7 @@ DupEnsembleCmdRep( Tcl_Obj *copyPtr) { EnsembleCmdRep *ensembleCmd; - EnsembleCmdRep *ensembleCopy = (EnsembleCmdRep *)ckalloc(sizeof(EnsembleCmdRep)); + EnsembleCmdRep *ensembleCopy = (EnsembleCmdRep *)Tcl_Alloc(sizeof(EnsembleCmdRep)); ECRGetIntRep(objPtr, ensembleCmd); ECRSetIntRep(copyPtr, ensembleCopy); @@ -2914,7 +2915,7 @@ TclCompileEnsemble( Command *oldCmdPtr = cmdPtr, *newCmdPtr; int len, result, flags = 0, i, depth = 1, invokeAnyway = 0; int ourResult = TCL_ERROR; - unsigned numBytes; + size_t numBytes; const char *word; TclNewObj(replaced); @@ -2984,7 +2985,7 @@ TclCompileEnsemble( (void) Tcl_GetEnsembleSubcommandList(NULL, ensemble, &listObj); if (listObj != NULL) { - int sclen; + size_t sclen; const char *str; Tcl_Obj *matchObj = NULL; @@ -2993,7 +2994,7 @@ TclCompileEnsemble( } for (i=0 ; i<len ; i++) { str = TclGetStringFromObj(elems[i], &sclen); - if ((sclen == (int) numBytes) && !memcmp(word, str, numBytes)) { + if ((sclen == numBytes) && !memcmp(word, str, numBytes)) { /* * Exact match! Excellent! */ @@ -3040,7 +3041,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) { /* @@ -3181,7 +3182,7 @@ TclCompileEnsemble( 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; } @@ -3356,7 +3357,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 @@ -3383,6 +3384,7 @@ CompileToInvokedCommand( Tcl_Obj *objPtr, **words; const char *bytes; int i, numWords, cmdLit, extraLiteralFlags = LITERAL_CMD_NAME; + size_t length; /* * Push the words of the command. Take care; the command words may be @@ -3394,8 +3396,8 @@ CompileToInvokedCommand( for (i = 0, tokPtr = parsePtr->tokenPtr; i < parsePtr->numWords; i++, tokPtr = TokenAfter(tokPtr)) { if (i > 0 && i < numWords+1) { - bytes = TclGetString(words[i-1]); - PushLiteral(envPtr, bytes, words[i-1]->length); + bytes = TclGetStringFromObj(words[i-1], &length); + PushLiteral(envPtr, bytes, length); continue; } @@ -3423,11 +3425,11 @@ CompileToInvokedCommand( TclNewObj(objPtr); Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, objPtr); - bytes = TclGetString(objPtr); + bytes = TclGetStringFromObj(objPtr, &length); if ((cmdPtr != NULL) && (cmdPtr->flags & CMD_VIA_RESOLVER)) { extraLiteralFlags |= LITERAL_UNSHARED; } - cmdLit = TclRegisterLiteral(envPtr, bytes, objPtr->length, extraLiteralFlags); + cmdLit = TclRegisterLiteral(envPtr, bytes, length, extraLiteralFlags); TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, cmdLit), cmdPtr); TclEmitPush(cmdLit, envPtr); TclDecrRefCount(objPtr); diff --git a/generic/tclEnv.c b/generic/tclEnv.c index 96d050d..d0c59f0 100644 --- a/generic/tclEnv.c +++ b/generic/tclEnv.c @@ -37,7 +37,7 @@ TCL_DECLARE_MUTEX(envMutex) /* To serialize access to environ. */ #endif 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 @@ -45,7 +45,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 @@ -248,8 +248,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; @@ -262,7 +262,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 @@ -271,11 +271,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; @@ -315,7 +315,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); @@ -325,7 +325,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); @@ -346,7 +346,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 { @@ -354,7 +354,7 @@ TclSetEnv( * This putenv() copies instead of taking ownership. */ - ckfree(p); + Tcl_Free(p); #endif /* HAVE_PUTENV_THAT_COPIES */ } @@ -446,8 +446,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; @@ -463,7 +462,7 @@ TclUnsetEnv( * needless work and to avoid recursion on the unset. */ - if (index == -1) { + if (index == TCL_INDEX_NONE) { Tcl_MutexUnlock(&envMutex); return; } @@ -486,18 +485,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); @@ -518,7 +517,7 @@ TclUnsetEnv( * This putenv() copies instead of taking ownership. */ - ckfree(string); + Tcl_Free(string); #endif /* HAVE_PUTENV_THAT_COPIES */ } #else /* !USE_PUTENV_FOR_UNSET */ @@ -562,13 +561,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); @@ -694,7 +693,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 @@ -714,7 +713,7 @@ ReplaceString( */ if (env.cache[i]) { - ckfree(env.cache[i]); + Tcl_Free(env.cache[i]); } if (newStr) { @@ -732,11 +731,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; } } @@ -773,17 +772,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 76a45ae..22ea3d5 100644 --- a/generic/tclEvent.c +++ b/generic/tclEvent.c @@ -124,7 +124,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). @@ -139,17 +139,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 @@ -163,7 +152,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); @@ -230,7 +219,7 @@ HandleBgErrors( errPtr = assocPtr->firstBgPtr; Tcl_ListObjGetElements(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; @@ -245,8 +234,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) { /* @@ -259,7 +248,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); @@ -528,7 +517,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; @@ -607,7 +596,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); @@ -637,7 +626,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; @@ -670,7 +659,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; @@ -715,7 +704,7 @@ Tcl_DeleteExitHandler( } else { prevPtr->nextPtr = exitPtr->nextPtr; } - ckfree(exitPtr); + Tcl_Free(exitPtr); break; } } @@ -758,7 +747,7 @@ TclDeleteLateExitHandler( } else { prevPtr->nextPtr = exitPtr->nextPtr; } - ckfree(exitPtr); + Tcl_Free(exitPtr); break; } } @@ -792,7 +781,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; @@ -834,7 +823,7 @@ Tcl_DeleteThreadExitHandler( } else { prevPtr->nextPtr = exitPtr->nextPtr; } - ckfree(exitPtr); + Tcl_Free(exitPtr); return; } } @@ -912,7 +901,7 @@ InvokeExitHandlers(void) firstExitPtr = exitPtr->nextPtr; Tcl_MutexUnlock(&exitMutex); exitPtr->proc(exitPtr->clientData); - ckfree(exitPtr); + Tcl_Free(exitPtr); Tcl_MutexLock(&exitMutex); } firstExitPtr = NULL; @@ -1140,7 +1129,7 @@ Tcl_Finalize(void) firstLateExitPtr = exitPtr->nextPtr; Tcl_MutexUnlock(&exitMutex); exitPtr->proc(exitPtr->clientData); - ckfree(exitPtr); + Tcl_Free(exitPtr); Tcl_MutexLock(&exitMutex); } firstLateExitPtr = NULL; @@ -1251,7 +1240,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(); @@ -1310,7 +1299,7 @@ FinalizeThread( tsdPtr->firstExitPtr = exitPtr->nextPtr; exitPtr->proc(exitPtr->clientData); - ckfree(exitPtr); + Tcl_Free(exitPtr); } TclFinalizeIOSubsystem(); TclFinalizeNotifier(); @@ -1410,7 +1399,7 @@ Tcl_VwaitObjCmd( Tcl_WrongNumArgs(interp, 1, objv, "name"); return TCL_ERROR; } - nameString = Tcl_GetString(objv[1]); + nameString = TclGetString(objv[1]); if (Tcl_TraceVar2(interp, nameString, NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, VwaitVarProc, &done) != TCL_OK) { @@ -1570,7 +1559,7 @@ NewThreadProc( threadProc = cdPtr->proc; threadClientData = cdPtr->clientData; - ckfree(clientData); /* Allocated in Tcl_CreateThread() */ + Tcl_Free(clientData); /* Allocated in Tcl_CreateThread() */ threadProc(threadClientData); @@ -1602,19 +1591,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 54c147d..60f8928 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -73,11 +73,11 @@ int tclTraceExec = 0; * expression opcodes (e.g., INST_LOR) in tclCompile.h. * * Does not include the string for INST_EXPON (and beyond), as that is - * disjoint for backward-compatability reasons. + * disjoint for backward-compatibility reasons. */ static const char *const operatorStrings[] = { - "||", "&&", "|", "^", "&", "==", "!=", "<", ">", "<=", ">=", "<<", ">>", + "|", "^", "&", "==", "!=", "<", ">", "<=", ">=", "<<", ">>", "+", "-", "*", "/", "%", "+", "-", "~", "!" }; @@ -101,64 +101,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 @@ -166,7 +108,7 @@ static BuiltinFunc const tclBuiltinFuncTable[] = { * Minimal data required to fully reconstruct the execution state. */ -typedef struct TEBCdata { +typedef struct { ByteCode *codePtr; /* Constant until the BC returns */ /* -----------------------------------------*/ ptrdiff_t *catchTop; /* These fields are used on return TO this */ @@ -511,13 +453,13 @@ VarHashCreateVar( #define GetNumberFromObj(interp, objPtr, ptrPtr, tPtr) \ ((TclHasIntRep((objPtr), &tclIntType)) \ ? (*(tPtr) = TCL_NUMBER_INT, \ - *(ptrPtr) = (ClientData) \ + *(ptrPtr) = (void *) \ (&((objPtr)->internalRep.wideValue)), TCL_OK) : \ TclHasIntRep((objPtr), &tclDoubleType) \ ? (((TclIsNaN((objPtr)->internalRep.doubleValue)) \ ? (*(tPtr) = TCL_NUMBER_NAN) \ : (*(tPtr) = TCL_NUMBER_DOUBLE)), \ - *(ptrPtr) = (ClientData) \ + *(ptrPtr) = (void *) \ (&((objPtr)->internalRep.doubleValue)), TCL_OK) : \ (((objPtr)->bytes != NULL) && ((objPtr)->length == 0)) \ ? TCL_ERROR : \ @@ -694,7 +636,7 @@ static void FreeExprCodeInternalRep(Tcl_Obj *objPtr); static ExceptionRange * GetExceptRangeForPc(const unsigned char *pc, int searchMode, ByteCode *codePtr); static const char * GetSrcInfoForPc(const unsigned char *pc, - ByteCode *codePtr, int *lengthPtr, + ByteCode *codePtr, size_t *lengthPtr, const unsigned char **pcBeg, int *cmdIdxPtr); static Tcl_Obj ** GrowEvaluationStack(ExecEnv *eePtr, int growth, int move); @@ -704,8 +646,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; @@ -771,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); @@ -851,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; @@ -915,7 +857,7 @@ DeleteExecStack( if (esPtr->nextPtr) { esPtr->nextPtr->prevPtr = esPtr->prevPtr; } - ckfree(esPtr); + Tcl_Free(esPtr); } void @@ -947,7 +889,7 @@ TclDeleteExecEnv( if (eePtr->corPtr && !cachedInExit) { Tcl_Panic("Deleting execEnv with existing coroutine"); } - ckfree(eePtr); + Tcl_Free(eePtr); } /* @@ -1038,8 +980,8 @@ GrowEvaluationStack( 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 newElems, currElems, needed = growth - (esPtr->endPtr - esPtr->tosPtr); Tcl_Obj **markerPtr = esPtr->markerPtr, **memStart; int moveWords = 0; @@ -1124,7 +1066,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; @@ -1184,7 +1126,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 @@ -1202,7 +1144,7 @@ StackAllocWords( static Tcl_Obj ** StackReallocWords( Tcl_Interp *interp, - int numWords) + size_t numWords) { Interp *iPtr = (Interp *) interp; ExecEnv *eePtr = iPtr->execEnvPtr; @@ -1223,7 +1165,7 @@ TclStackFree( Tcl_Obj **markerPtr, *marker; if (iPtr == NULL || iPtr->execEnvPtr == NULL) { - ckfree(freePtr); + Tcl_Free(freePtr); return; } @@ -1281,32 +1223,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; @@ -1348,7 +1290,7 @@ int Tcl_ExprObj( Tcl_Interp *interp, /* Context in which to evaluate the * expression. */ - Tcl_Obj *objPtr, /* Points to Tcl object containing expression + Tcl_Obj *objPtr, /* Points to Tcl object containing expression * to evaluate. */ Tcl_Obj **resultPtrPtr) /* Where the Tcl_Obj* that is the expression * result is stored if no errors occur. */ @@ -1494,10 +1436,11 @@ CompileExprObj( * TIP #280: No invoker (yet) - Expression compilation. */ - const char *string = TclGetString(objPtr); + size_t length; + const char *string = TclGetStringFromObj(objPtr, &length); - TclInitCompileEnv(interp, &compEnv, string, objPtr->length, NULL, 0); - TclCompileExpr(interp, string, objPtr->length, &compEnv, 0); + TclInitCompileEnv(interp, &compEnv, string, length, NULL, 0); + TclCompileExpr(interp, string, length, &compEnv, 0); /* * Successful compilation. If the expression yielded no instructions, @@ -2684,7 +2627,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 @@ -2880,91 +2823,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); @@ -3785,7 +3643,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)) { @@ -4052,29 +3910,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; @@ -4398,51 +4233,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. */ @@ -4828,8 +4618,8 @@ TEBCresume( */ { - int index, numIndices, fromIdx, toIdx; - int nocase, match, length2, cflags, s1len, s2len; + int numIndices, nocase, match, cflags; + size_t slength, length2, fromIdx, toIdx, index, s1len, s2len; const char *s1, *s2; case INST_LIST: @@ -4918,7 +4708,7 @@ TEBCresume( pcAdjustment = 5; lindexFastPath: - if (index >= 0 && index < objc) { + if (index < (size_t)objc) { objResultPtr = objv[index]; } else { TclNewObj(objResultPtr); @@ -5081,13 +4871,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 ); * @@ -5243,24 +5033,24 @@ TEBCresume( case INST_STR_LEN: valuePtr = OBJ_AT_TOS; - length = Tcl_GetCharLength(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 = TclGetStringFromObj(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); TclFreeIntRep(valuePtr); TRACE_APPEND(("\"%.20s\"\n", O2S(valuePtr))); NEXT_INST_F(1, 0, 0); @@ -5269,15 +5059,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 = TclGetStringFromObj(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); TclFreeIntRep(valuePtr); TRACE_APPEND(("\"%.20s\"\n", O2S(valuePtr))); NEXT_INST_F(1, 0, 0); @@ -5286,15 +5076,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 = TclGetStringFromObj(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); TclFreeIntRep(valuePtr); TRACE_APPEND(("\"%.20s\"\n", O2S(valuePtr))); NEXT_INST_F(1, 0, 0); @@ -5309,21 +5099,21 @@ TEBCresume( * Get char length to calulate what 'end' means. */ - length = Tcl_GetCharLength(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( Tcl_GetByteArrayFromObj(valuePtr, NULL)+index, 1); - } else if (valuePtr->bytes && length == valuePtr->length) { + } else if (valuePtr->bytes && slength == valuePtr->length) { objResultPtr = Tcl_NewStringObj((const char *) valuePtr->bytes+index, 1); } else { @@ -5338,11 +5128,11 @@ 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 ((ch >= 0xD800) && (slength < 3)) { + slength += Tcl_UniCharToUtf(-1, buf + slength); } - objResultPtr = Tcl_NewStringObj(buf, length); + objResultPtr = Tcl_NewStringObj(buf, slength); } } @@ -5352,16 +5142,16 @@ TEBCresume( case INST_STR_RANGE: TRACE(("\"%.20s\" %.20s %.20s =>", O2S(OBJ_AT_DEPTH(2)), O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS))); - length = Tcl_GetCharLength(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); @@ -5369,13 +5159,13 @@ TEBCresume( } CACHE_STACK_INFO(); - if (fromIdx < 0) { - fromIdx = 0; + if (fromIdx == TCL_INDEX_NONE) { + fromIdx = TCL_INDEX_START; } - if (toIdx >= length) { - toIdx = length; + if (toIdx + 1 >= slength + 1) { + toIdx = slength; } - if (toIdx >= fromIdx) { + if (toIdx + 1 >= fromIdx + 1) { objResultPtr = Tcl_GetRange(OBJ_AT_DEPTH(2), fromIdx, toIdx); } else { TclNewObj(objResultPtr); @@ -5387,11 +5177,11 @@ TEBCresume( valuePtr = OBJ_AT_TOS; fromIdx = TclGetInt4AtPtr(pc+1); toIdx = TclGetInt4AtPtr(pc+5); - length = Tcl_GetCharLength(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); } @@ -5407,14 +5197,14 @@ TEBCresume( goto emptyRange; } - toIdx = TclIndexDecode(toIdx, length - 1); - if (toIdx < 0) { + toIdx = TclIndexDecode(toIdx, slength - 1); + if (toIdx == TCL_INDEX_NONE) { goto emptyRange; - } else if (toIdx >= length) { - toIdx = length - 1; + } else if (toIdx >= slength) { + toIdx = slength - 1; } - assert ( toIdx >= 0 && toIdx < length ); + assert ( toIdx != TCL_INDEX_NONE && toIdx < slength ); /* assert ( fromIdx != TCL_INDEX_NONE ); @@ -5425,12 +5215,12 @@ TEBCresume( fromIdx = TCL_INDEX_START; } - fromIdx = TclIndexDecode(fromIdx, length - 1); - if (fromIdx < 0) { - fromIdx = 0; + fromIdx = TclIndexDecode(fromIdx, slength - 1); + if (fromIdx == TCL_INDEX_NONE) { + fromIdx = TCL_INDEX_START; } - if (fromIdx <= toIdx) { + if (fromIdx + 1 <= toIdx + 1) { objResultPtr = Tcl_GetRange(valuePtr, fromIdx, toIdx); } else { emptyRange: @@ -5441,19 +5231,19 @@ TEBCresume( { 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 = Tcl_GetCharLength(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); @@ -5466,23 +5256,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))); @@ -5514,41 +5304,41 @@ TEBCresume( objResultPtr = value3Ptr; goto doneStringMap; } - ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length); - if (length == 0) { + ustring1 = TclGetUnicodeFromObj(valuePtr, &slength); + if (slength == 0) { objResultPtr = valuePtr; goto doneStringMap; } - ustring2 = Tcl_GetUnicodeFromObj(value2Ptr, &length2); - if (length2 > length || length2 == 0) { + ustring2 = TclGetUnicodeFromObj(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 = Tcl_GetUnicodeFromObj(value3Ptr, &length3); + ustring3 = TclGetUnicodeFromObj(value3Ptr, &length3); objResultPtr = Tcl_NewUnicodeObj(ustring1, 0); p = ustring1; - end = ustring1 + length; + end = ustring1 + slength; for (; ustring1 < end; ustring1++) { if ((*ustring1 == *ustring2) && (length2==1 || memcmp(ustring1, ustring2, sizeof(Tcl_UniChar) * length2) == 0)) { if (p != ustring1) { - Tcl_AppendUnicodeToObj(objResultPtr, p, ustring1-p); + TclAppendUnicodeToObj(objResultPtr, p, ustring1-p); p = ustring1 + length2; } else { p += length2; } ustring1 = p - 1; - Tcl_AppendUnicodeToObj(objResultPtr, ustring3, length3); + TclAppendUnicodeToObj(objResultPtr, ustring3, length3); } } if (p != ustring1) { @@ -5556,7 +5346,7 @@ TEBCresume( * Put the rest of the unmapped chars onto result. */ - Tcl_AppendUnicodeToObj(objResultPtr, p, ustring1 - p); + TclAppendUnicodeToObj(objResultPtr, p, ustring1 - p); } doneStringMap: TRACE_WITH_OBJ(("%.20s %.20s %.20s => ", @@ -5582,11 +5372,11 @@ TEBCresume( valuePtr = OBJ_AT_TOS; TRACE(("%s \"%.30s\" => ", tclStringClassTable[opnd].name, O2S(valuePtr))); - ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length); + ustring1 = TclGetUnicodeFromObj(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)) { @@ -5613,16 +5403,17 @@ TEBCresume( || TclHasIntRep(value2Ptr, &tclStringType)) { Tcl_UniChar *ustring1, *ustring2; - ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length); - ustring2 = Tcl_GetUnicodeFromObj(value2Ptr, &length2); - match = TclUniCharMatch(ustring1, length, ustring2, length2, + ustring1 = TclGetUnicodeFromObj(valuePtr, &slength); + ustring2 = TclGetUnicodeFromObj(value2Ptr, &length2); + match = TclUniCharMatch(ustring1, slength, ustring2, length2, nocase); } else if (TclIsPureByteArray(valuePtr) && !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 = TclGetByteArrayFromObj(valuePtr, &wlen1); + bytes2 = TclGetByteArrayFromObj(value2Ptr, &wlen2); + match = TclByteArrayMatch(bytes1, wlen1, bytes2, wlen2, 0); } else { match = Tcl_StringCaseMatch(TclGetString(valuePtr), TclGetString(value2Ptr), nocase); @@ -5643,30 +5434,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); + string1 = TclGetStringFromObj(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); + string1 = TclGetStringFromObj(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); + string1 = TclGetStringFromObj(valuePtr, &slength); + trim1 = TclTrim(string1, slength, string2, length2, &trim2); createTrimmedString: /* * Careful here; trim set often contains non-ASCII characters so we @@ -5689,7 +5480,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); @@ -6458,170 +6249,6 @@ 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 (TclListObjLength(interp, listPtr, &listLen) != TCL_OK) { - TRACE_APPEND(("ERROR converting list %ld, \"%.30s\": %s\n", - i, O2S(listPtr), O2S(Tcl_GetObjResult(interp)))); - goto gotError; - } - if ((size_t)listLen > iterNum * numVars) { - continueLoop = 1; - } - listTmpIndex++; - } - - /* - * If some var in some var list still has a remaining list element - * iterate one more time. Assign to var the next element from its - * value list. We already checked above that each list temp holds a - * valid list object (by calling Tcl_ListObjLength), but cannot rely - * on that check remaining valid: one list could have been shimmered - * as a side effect of setting a traced variable. - */ - - if (continueLoop) { - listTmpIndex = infoPtr->firstValueTemp; - for (i = 0; i < numLists; i++) { - varListPtr = infoPtr->varLists[i]; - numVars = varListPtr->numVars; - - listVarPtr = LOCAL(listTmpIndex); - listPtr = TclListObjCopy(NULL, listVarPtr->value.objPtr); - TclListObjGetElements(interp, listPtr, &listLen, &elements); - - valIndex = (iterNum * numVars); - for (j = 0; j < numVars; j++) { - if (valIndex >= listLen) { - TclNewObj(valuePtr); - } else { - valuePtr = elements[valIndex]; - } - - varIndex = varListPtr->varIndexes[j]; - varPtr = LOCAL(varIndex); - while (TclIsVarLink(varPtr)) { - varPtr = varPtr->value.linkPtr; - } - if (TclIsVarDirectWritable(varPtr)) { - value2Ptr = varPtr->value.objPtr; - if (valuePtr != value2Ptr) { - if (value2Ptr != NULL) { - TclDecrRefCount(value2Ptr); - } - varPtr->value.objPtr = valuePtr; - Tcl_IncrRefCount(valuePtr); - } - } else { - DECACHE_STACK_INFO(); - if (TclPtrSetVarIdx(interp, varPtr, NULL, NULL, NULL, - valuePtr, TCL_LEAVE_ERR_MSG, varIndex)==NULL){ - CACHE_STACK_INFO(); - TRACE_APPEND(( - "ERROR init. index temp %d: %s\n", - varIndex, O2S(Tcl_GetObjResult(interp)))); - TclDecrRefCount(listPtr); - goto gotError; - } - CACHE_STACK_INFO(); - } - valIndex++; - } - TclDecrRefCount(listPtr); - listTmpIndex++; - } - } - TRACE_APPEND(("%d lists, iter %" TCL_Z_MODIFIER "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; @@ -7253,7 +6880,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) { @@ -7264,7 +6891,7 @@ TEBCresume( */ Tcl_DecrRefCount(dictPtr); - ckfree(searchPtr); + Tcl_Free(searchPtr); TRACE_ERROR(interp); goto gotError; } @@ -7349,7 +6976,7 @@ TEBCresume( TRACE_ERROR(interp); goto gotError; } - if (length != duiPtr->length) { + if ((size_t)length != duiPtr->length) { Tcl_Panic("dictUpdateStart argument length mismatch"); } for (i=0 ; i<length ; i++) { @@ -7718,11 +7345,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; @@ -7884,8 +7512,9 @@ TEBCresume( instStartCmdFailed: { const char *bytes; + size_t xxx1length; - length = 0; + xxx1length = 0; if (TclInterpReady(interp) == TCL_ERROR) { goto gotError; @@ -7902,11 +7531,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; } } @@ -9076,10 +8705,9 @@ 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); @@ -9105,7 +8733,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 %d, compiled locals %d\n", procPtr, procPtr->refCount, procPtr->numArgs, procPtr->numCompiledLocals); } @@ -9157,14 +8785,14 @@ ValidatePcAndStackTop( pc); Tcl_Panic("TclNRExecuteByteCode execution failure: bad pc"); } - if ((unsigned) opCode > LAST_INST_OPCODE) { + if ((unsigned) opCode >= LAST_INST_OPCODE) { fprintf(stderr, "\nBad opcode %d at pc %" TCL_Z_MODIFIER "u in TclNRExecuteByteCode\n", (unsigned) opCode, relativePc); Tcl_Panic("TclNRExecuteByteCode execution failure: bad opcode"); } if (checkStack && ((stackTop < 0) || (stackTop > stackUpperBound))) { - int numChars; + size_t numChars; const char *cmd = GetSrcInfoForPc(pc, codePtr, &numChars, NULL, NULL); fprintf(stderr, "\nBad stack top %d at pc %" TCL_Z_MODIFIER "u in TclNRExecuteByteCode (min 0, max %i)", @@ -9220,20 +8848,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) { @@ -9244,7 +8863,8 @@ IllegalExprOperandType( } Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't use %s as operand of \"%s\"", description, op)); + "can't use %s \"%s\" as operand of \"%s\"", description, + TclGetString(opndPtr), op)); Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", description, NULL); } @@ -9321,7 +8941,8 @@ TclGetSrcInfoForPc( ExtCmdLoc *eclPtr; ECL *locPtr = NULL; - int srcOffset, i; + size_t srcOffset; + int i; Interp *iPtr = (Interp *) *codePtr->interpHandle; Tcl_HashEntry *hePtr = Tcl_FindHashEntry(iPtr->lineBCPtr, codePtr); @@ -9367,7 +8988,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 @@ -9377,18 +8998,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 < (size_t)codePtr->numCodeBytes); /* * Decode the code and source offset and length for each command. The @@ -9531,8 +9152,8 @@ GetExceptRangeForPc( ExceptionRange *rangeArrayPtr; int 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; @@ -9710,9 +9331,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; @@ -9754,8 +9374,8 @@ EvalStatsCmd( Tcl_AppendPrintfToObj(objPtr, "\n----------------------------------------------------------------\n"); Tcl_AppendPrintfToObj(objPtr, - "Compilation and execution statistics for interpreter %#" TCL_Z_MODIFIER "x\n", - (size_t)iPtr); + "Compilation and execution statistics for interpreter %p\n", + iPtr); Tcl_AppendPrintfToObj(objPtr, "\nNumber ByteCodes executed\t%" TCL_Z_MODIFIER "u\n", statsPtr->numExecutions); @@ -9802,11 +9422,11 @@ EvalStatsCmd( statsPtr->currentByteCodeBytes); Tcl_AppendPrintfToObj(objPtr, " Literal bytes\t\t%.6g\n", currentLiteralBytes); - Tcl_AppendPrintfToObj(objPtr, " table %lu + bkts %lu + entries %lu + objects %lu + strings %.6g\n", - (unsigned long) sizeof(LiteralTable), - (unsigned long) (iPtr->literalTable.numBuckets * sizeof(LiteralEntry *)), - (unsigned long) (iPtr->literalTable.numEntries * sizeof(LiteralEntry)), - (unsigned long) (iPtr->literalTable.numEntries * sizeof(Tcl_Obj)), + Tcl_AppendPrintfToObj(objPtr, " table %" TCL_Z_MODIFIER "u + bkts %" TCL_Z_MODIFIER "u + entries %" TCL_Z_MODIFIER "u + objects %" TCL_Z_MODIFIER "u + strings %.6g\n", + sizeof(LiteralTable), + iPtr->literalTable.numBuckets * sizeof(LiteralEntry *), + iPtr->literalTable.numEntries * sizeof(LiteralEntry), + iPtr->literalTable.numEntries * sizeof(Tcl_Obj), statsPtr->currentLitStringBytes); Tcl_AppendPrintfToObj(objPtr, " Mean code/source\t\t%.1f\n", currentCodeBytes / statsPtr->currentSrcBytes); @@ -9877,7 +9497,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", @@ -9969,14 +9589,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. @@ -10001,7 +9621,7 @@ EvalStatsCmd( 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)); } @@ -10024,7 +9644,7 @@ EvalStatsCmd( 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)); } @@ -10056,7 +9676,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]) { @@ -10069,7 +9689,7 @@ EvalStatsCmd( #ifdef TCL_MEM_DEBUG Tcl_AppendPrintfToObj(objPtr, "\nHeap Statistics:\n"); - TclDumpMemoryInfo((ClientData) objPtr, 1); + TclDumpMemoryInfo(objPtr, 1); #endif Tcl_AppendPrintfToObj(objPtr, "\n----------------------------------------------------------------\n"); diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c index f9636d8..6d7f3cf 100644 --- a/generic/tclFCmd.c +++ b/generic/tclFCmd.c @@ -1389,7 +1389,7 @@ TclFileTemporaryCmd( TclNewObj(nameObj); } if (objc > 2) { - int length; + size_t length; Tcl_Obj *templateObj = objv[2]; const char *string = TclGetStringFromObj(templateObj, &length); diff --git a/generic/tclFileName.c b/generic/tclFileName.c index c3f3bf0..bab3f90 100644 --- a/generic/tclFileName.c +++ b/generic/tclFileName.c @@ -386,8 +386,7 @@ TclpGetNativePathType( Tcl_Obj **driveNameRef) { Tcl_PathType type = TCL_PATH_ABSOLUTE; - int pathLen; - const char *path = TclGetStringFromObj(pathPtr, &pathLen); + const char *path = TclGetString(pathPtr); if (path[0] == '~') { /* @@ -504,11 +503,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; } @@ -537,7 +536,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. * @@ -557,7 +556,8 @@ Tcl_SplitPath( { Tcl_Obj *resultPtr = NULL; /* Needed only to prevent gcc warnings. */ Tcl_Obj *tmpPtr, *eltPtr; - int i, size, len; + int i; + size_t size, len; char *p; const char *str; @@ -578,7 +578,7 @@ Tcl_SplitPath( size = 1; for (i = 0; i < *argcPtr; i++) { Tcl_ListObjIndex(NULL, resultPtr, i, &eltPtr); - TclGetStringFromObj(eltPtr, &len); + (void)TclGetStringFromObj(eltPtr, &len); size += len + 1; } @@ -587,7 +587,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)); /* @@ -643,7 +643,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; @@ -733,7 +733,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; @@ -824,12 +824,12 @@ Tcl_FSJoinToPath( return TclJoinPath(2, pair, 0); } else { int elemc = objc + 1; - Tcl_Obj *ret, **elemv = (Tcl_Obj**)ckalloc(elemc*sizeof(Tcl_Obj *)); + 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; } } @@ -855,7 +855,8 @@ TclpNativeJoinPath( Tcl_Obj *prefix, const char *joining) { - int length, needsSep; + int needsSep; + size_t length; char *dest; const char *p; const char *start; @@ -888,7 +889,7 @@ TclpNativeJoinPath( if (length > 0 && (start[length-1] != '/')) { Tcl_AppendToObj(prefix, "/", 1); - TclGetStringFromObj(prefix, &length); + (void)TclGetStringFromObj(prefix, &length); } needsSep = 0; @@ -898,7 +899,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] == '/') { @@ -912,7 +913,7 @@ TclpNativeJoinPath( needsSep = 1; } } - length = dest - Tcl_GetString(prefix); + length = dest - TclGetString(prefix); Tcl_SetObjLength(prefix, length); break; @@ -924,7 +925,7 @@ TclpNativeJoinPath( if ((length > 0) && (start[length-1] != '/') && (start[length-1] != ':')) { Tcl_AppendToObj(prefix, "/", 1); - TclGetStringFromObj(prefix, &length); + (void)TclGetStringFromObj(prefix, &length); } needsSep = 0; @@ -933,7 +934,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] == '\\')) { @@ -947,7 +948,7 @@ TclpNativeJoinPath( needsSep = 1; } } - length = dest - Tcl_GetString(prefix); + length = dest - TclGetString(prefix); Tcl_SetObjLength(prefix, length); break; } @@ -979,7 +980,8 @@ Tcl_JoinPath( const char *const *argv, Tcl_DString *resultPtr) /* Pointer to previously initialized DString */ { - int i, len; + int i; + size_t len; Tcl_Obj *listObj; Tcl_Obj *resultObj; const char *resultStr; @@ -1252,7 +1254,7 @@ Tcl_GlobObjCmd( for (i = 1; i < objc; i++) { if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, &index) != TCL_OK) { - string = TclGetStringFromObj(objv[i], &length); + string = TclGetString(objv[i]); if (string[0] == '-') { /* * It looks like the command contains an option so signal an @@ -1364,7 +1366,7 @@ Tcl_GlobObjCmd( } if (dir == PATH_GENERAL) { - int pathlength; + size_t pathlength; const char *last; const char *first = TclGetStringFromObj(pathOrDir,&pathlength); @@ -1416,7 +1418,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); } } @@ -1465,7 +1467,7 @@ Tcl_GlobObjCmd( globTypes->macCreator = NULL; while (--length >= 0) { - int len; + size_t len; const char *str; Tcl_ListObjIndex(interp, typePtr, length, &look); @@ -1523,13 +1525,14 @@ Tcl_GlobObjCmd( } else { Tcl_Obj *item; + int llen; - if ((Tcl_ListObjLength(NULL, look, &len) == TCL_OK) - && (len == 3)) { + if ((Tcl_ListObjLength(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; @@ -1537,7 +1540,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; @@ -1557,7 +1560,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; @@ -1621,7 +1624,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; @@ -1653,7 +1656,7 @@ Tcl_GlobObjCmd( for (i = 0; i < objc; i++) { Tcl_AppendPrintfToObj(errorMsg, "%s%s", - sep, Tcl_GetString(objv[i])); + sep, TclGetString(objv[i])); sep = " "; } } @@ -1854,7 +1857,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++; @@ -1988,7 +1991,7 @@ TclGlob( if (globFlags & TCL_GLOBMODE_TAILS) { int objc, i; Tcl_Obj **objv; - int prefixLen; + size_t prefixLen; const char *pre; /* @@ -2016,7 +2019,7 @@ TclGlob( Tcl_ListObjGetElements(NULL, filenamesObj, &objc, &objv); for (i = 0; i< objc; i++) { - int len; + size_t len; const char *oldStr = TclGetStringFromObj(objv[i], &len); Tcl_Obj *elem; @@ -2348,7 +2351,7 @@ DoGlob( for (i=0; result==TCL_OK && i<subdirc; i++) { Tcl_Obj *copy = NULL; - if (pathPtr == NULL && Tcl_GetString(subdirv[i])[0] == '~') { + if (pathPtr == NULL && TclGetString(subdirv[i])[0] == '~') { Tcl_ListObjLength(NULL, matchesObj, &repair); copy = subdirv[i]; subdirv[i] = Tcl_NewStringObj("./", 2); @@ -2365,7 +2368,7 @@ DoGlob( Tcl_ListObjLength(NULL, matchesObj, &end); while (repair < end) { const char *bytes; - int numBytes; + size_t numBytes; Tcl_Obj *fixme, *newObj; Tcl_ListObjIndex(NULL, matchesObj, repair, &fixme); @@ -2388,7 +2391,7 @@ DoGlob( */ if (*p == '\0') { - int length; + size_t length; Tcl_DString append; /* @@ -2452,7 +2455,7 @@ DoGlob( * The current prefix must end in a separator. */ - int len; + size_t len; const char *joined = TclGetStringFromObj(joinedPtr,&len); if ((len > 0) && (strchr(separators, joined[len-1]) == NULL)) { @@ -2489,7 +2492,7 @@ DoGlob( * This behaviour is not currently tested for in the test suite. */ - int len; + size_t len; const char *joined = TclGetStringFromObj(joinedPtr,&len); if ((len > 0) && (strchr(separators, joined[len-1]) == NULL)) { @@ -2519,7 +2522,7 @@ DoGlob( * * Results: * A pointer to a Tcl_StatBuf which may be deallocated by being passed to - * ckfree(). + * Tcl_Free(). * * Side effects: * None. @@ -2530,7 +2533,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 1eec7ff..684407c 100644 --- a/generic/tclFileSystem.h +++ b/generic/tclFileSystem.h @@ -30,7 +30,7 @@ MODULE_SCOPE Tcl_Obj * TclFSMakePathRelative(Tcl_Interp *interp, MODULE_SCOPE int TclFSEnsureEpochOk(Tcl_Obj *pathPtr, const Tcl_Filesystem **fsPtrPtr); MODULE_SCOPE void TclFSSetPathDetails(Tcl_Obj *pathPtr, - const Tcl_Filesystem *fsPtr, ClientData clientData); + const Tcl_Filesystem *fsPtr, void *clientData); MODULE_SCOPE Tcl_Obj * TclFSNormalizeAbsolutePath(Tcl_Interp *interp, Tcl_Obj *pathPtr); MODULE_SCOPE size_t TclFSEpoch(void); diff --git a/generic/tclGet.c b/generic/tclGet.c index 12e0e79..4811c42 100644 --- a/generic/tclGet.c +++ b/generic/tclGet.c @@ -142,7 +142,7 @@ Tcl_GetBoolean( Tcl_Panic("invalid sharing of Tcl_Obj on C stack"); } if (code == TCL_OK) { - TclGetBooleanFromObj(NULL, &obj, boolPtr); + *boolPtr = obj.internalRep.wideValue != 0; } return code; } diff --git a/generic/tclGetDate.y b/generic/tclGetDate.y index a84d3c2..7615bb5 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 584b5e1..e633fb0 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)*1103515245L) >> (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. */ @@ -273,8 +247,7 @@ CreateHashEntry( { Tcl_HashEntry *hPtr; const Tcl_HashKeyType *typePtr; - unsigned int hash; - int index; + size_t hash, index; if (tablePtr->keyType == TCL_STRING_KEYS) { typePtr = &tclStringHashKeyType; @@ -295,7 +268,7 @@ CreateHashEntry( index = hash & tablePtr->mask; } } else { - hash = PTR2UINT(key); + hash = (size_t) key; index = RANDOM_INDEX(tablePtr, hash); } @@ -308,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 */ @@ -324,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) { @@ -348,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; - hPtr->clientData = 0; + 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++; @@ -396,7 +369,7 @@ Tcl_DeleteHashEntry( const Tcl_HashKeyType *typePtr; Tcl_HashTable *tablePtr; Tcl_HashEntry **bucketPtr; - int index; + size_t index; tablePtr = entryPtr->tablePtr; @@ -413,9 +386,9 @@ Tcl_DeleteHashEntry( if (typePtr->hashKeyProc == NULL || typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) { - index = RANDOM_INDEX(tablePtr, PTR2INT(entryPtr->hash)); + index = RANDOM_INDEX(tablePtr, entryPtr->hash); } else { - index = PTR2UINT(entryPtr->hash) & tablePtr->mask; + index = entryPtr->hash & tablePtr->mask; } bucketPtr = &tablePtr->buckets[index]; @@ -438,7 +411,7 @@ Tcl_DeleteHashEntry( if (typePtr->freeEntryProc) { typePtr->freeEntryProc(entryPtr); } else { - ckfree(entryPtr); + Tcl_Free(entryPtr); } } @@ -465,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; @@ -489,7 +462,7 @@ Tcl_DeleteHashTable( if (typePtr->freeEntryProc) { typePtr->freeEntryProc(hPtr); } else { - ckfree(hPtr); + Tcl_Free(hPtr); } hPtr = nextPtr; } @@ -503,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); } } @@ -614,7 +587,7 @@ Tcl_HashStats( Tcl_HashTable *tablePtr) /* Table for which to produce stats. */ { #define NUM_COUNTERS 10 - int count[NUM_COUNTERS], overflow, i, j; + size_t count[NUM_COUNTERS], overflow, i, j; double average, tmp; Tcl_HashEntry *hPtr; char *result, *p; @@ -648,16 +621,16 @@ Tcl_HashStats( * 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++) { - sprintf(p, "number of buckets with %d entries: %d\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 %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); @@ -683,13 +656,13 @@ Tcl_HashStats( static Tcl_HashEntry * AllocArrayEntry( Tcl_HashTable *tablePtr, /* Hash table. */ - void *keyPtr) /* Key to store in the hash table entry. */ + void *keyPtr) /* Key to store in the hash table entry. */ { int *array = (int *) keyPtr; int *iPtr1, *iPtr2; Tcl_HashEntry *hPtr; int count; - unsigned int size; + size_t size; count = tablePtr->keyType; @@ -697,13 +670,13 @@ AllocArrayEntry( if (size < sizeof(Tcl_HashEntry)) { size = sizeof(Tcl_HashEntry); } - hPtr = (Tcl_HashEntry *)ckalloc(size); + hPtr = (Tcl_HashEntry *)Tcl_Alloc(size); for (iPtr1 = array, iPtr2 = hPtr->key.words; count > 0; count--, iPtr1++, iPtr2++) { *iPtr2 = *iPtr1; } - hPtr->clientData = 0; + Tcl_SetHashValue(hPtr, NULL); return hPtr; } @@ -727,11 +700,11 @@ AllocArrayEntry( static int CompareArrayKeys( - void *keyPtr, /* New key to compare. */ + void *keyPtr, /* New key to compare. */ Tcl_HashEntry *hPtr) /* Existing key to compare. */ { - const int *iPtr1 = (const int *) keyPtr; - const int *iPtr2 = (const int *) hPtr->key.words; + const int *iPtr1 = (const int *)keyPtr; + const int *iPtr2 = hPtr->key.words; Tcl_HashTable *tablePtr = hPtr->tablePtr; int count; @@ -767,7 +740,7 @@ CompareArrayKeys( static TCL_HASH_TYPE HashArrayKey( Tcl_HashTable *tablePtr, /* Hash table. */ - void *keyPtr) /* Key from which to compute hash value. */ + void *keyPtr) /* Key from which to compute hash value. */ { const int *array = (const int *) keyPtr; TCL_HASH_TYPE result; @@ -799,7 +772,7 @@ HashArrayKey( static Tcl_HashEntry * AllocStringEntry( TCL_UNUSED(Tcl_HashTable *), - void *keyPtr) /* Key to store in the hash table entry. */ + void *keyPtr) /* Key to store in the hash table entry. */ { const char *string = (const char *) keyPtr; Tcl_HashEntry *hPtr; @@ -809,10 +782,10 @@ 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, sizeof(Tcl_HashEntry) + allocsize - sizeof(hPtr->key)); memcpy(hPtr->key.string, string, size); - hPtr->clientData = 0; + Tcl_SetHashValue(hPtr, NULL); return hPtr; } @@ -835,13 +808,10 @@ AllocStringEntry( static int CompareStringKeys( - void *keyPtr, /* New key to compare. */ + void *keyPtr, /* New key to compare. */ Tcl_HashEntry *hPtr) /* Existing key to compare. */ { - const char *p1 = (const char *) keyPtr; - const char *p2 = (const char *) hPtr->key.string; - - return !strcmp(p1, p2); + return !strcmp((char *)keyPtr, hPtr->key.string); } /* @@ -864,7 +834,7 @@ CompareStringKeys( static TCL_HASH_TYPE HashStringKey( TCL_UNUSED(Tcl_HashTable *), - void *keyPtr) /* Key from which to compute hash value. */ + void *keyPtr) /* Key from which to compute hash value. */ { const char *string = (const char *)keyPtr; TCL_HASH_TYPE result; @@ -985,14 +955,14 @@ static void RebuildTable( Tcl_HashTable *tablePtr) /* Table to enlarge. */ { - int count, index, oldSize = tablePtr->numBuckets; + size_t count, index, oldSize = tablePtr->numBuckets; Tcl_HashEntry **oldBuckets = tablePtr->buckets; Tcl_HashEntry **oldChainPtr, **newChainPtr; Tcl_HashEntry *hPtr; const Tcl_HashKeyType *typePtr; /* Avoid outgrowing capability of the memory allocators */ - if (oldSize > (int)(UINT_MAX / (4 * sizeof(Tcl_HashEntry *)))) { + if (oldSize > UINT_MAX / (4 * sizeof(Tcl_HashEntry *))) { tablePtr->rebuildSize = INT_MAX; return; } @@ -1015,18 +985,20 @@ RebuildTable( tablePtr->numBuckets *= 4; if (typePtr->flags & TCL_HASH_KEY_SYSTEM_HASH) { - tablePtr->buckets = (Tcl_HashEntry **) TclpSysAlloc( - tablePtr->numBuckets * sizeof(Tcl_HashEntry *), 0); + tablePtr->buckets = (Tcl_HashEntry **)TclpSysAlloc( + 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++) { *newChainPtr = NULL; } tablePtr->rebuildSize *= 4; - tablePtr->downShift -= 2; + if (tablePtr->downShift > 1) { + tablePtr->downShift -= 2; + } tablePtr->mask = (tablePtr->mask << 2) + 3; /* @@ -1038,9 +1010,9 @@ RebuildTable( *oldChainPtr = hPtr->nextPtr; if (typePtr->hashKeyProc == NULL || typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) { - index = RANDOM_INDEX(tablePtr, PTR2INT(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; @@ -1055,7 +1027,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 3a52a20..ed9fd04 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); @@ -217,7 +210,7 @@ DeleteHistoryObjs( TclDecrRefCount(histObjsPtr->historyObj); TclDecrRefCount(histObjsPtr->addObj); - ckfree(histObjsPtr); + Tcl_Free(histObjsPtr); } /* diff --git a/generic/tclIO.c b/generic/tclIO.c index 1547489..5c7c5a6 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -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. * @@ -275,9 +275,9 @@ static int WillRead(Channel *chanPtr); * -------------------------------------------------------------------------- */ -#define BytesLeft(bufPtr) ((bufPtr)->nextAdded - (bufPtr)->nextRemoved) +#define BytesLeft(bufPtr) ((size_t)((bufPtr)->nextAdded - (bufPtr)->nextRemoved)) -#define SpaceLeft(bufPtr) ((bufPtr)->bufLength - (bufPtr)->nextAdded) +#define SpaceLeft(bufPtr) ((size_t)((bufPtr)->bufLength - (bufPtr)->nextAdded)) #define IsBufferReady(bufPtr) ((bufPtr)->nextAdded > (bufPtr)->nextRemoved) @@ -374,11 +374,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); } @@ -430,7 +425,7 @@ ChanRead( } ResetFlag(chanPtr->state, CHANNEL_BLOCKED | CHANNEL_EOF); chanPtr->state->inputEncodingFlags &= ~TCL_ENCODING_END; - if (WillRead(chanPtr) < 0) { + if (WillRead(chanPtr) == -1) { return -1; } @@ -446,7 +441,16 @@ 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; + } + Tcl_SetErrno(result); + } else if (bytesRead == 0) { + SetFlag(chanPtr->state, CHANNEL_EOF); + chanPtr->state->inputEncodingFlags |= TCL_ENCODING_END; + } else { /* * If we get a short read, signal up that we may be BLOCKED. We should * avoid calling the driver because on some platforms we will block in @@ -457,15 +461,6 @@ ChanRead( if (bytesRead < dstSize) { SetFlag(chanPtr->state, CHANNEL_BLOCKED); } - } else if (bytesRead == 0) { - SetFlag(chanPtr->state, CHANNEL_EOF); - chanPtr->state->inputEncodingFlags |= TCL_ENCODING_END; - } else if (bytesRead < 0) { - if ((result == EWOULDBLOCK) || (result == EAGAIN)) { - SetFlag(chanPtr->state, CHANNEL_BLOCKED); - result = EAGAIN; - } - Tcl_SetErrno(result); } return bytesRead; } @@ -483,18 +478,8 @@ ChanSeek( */ if (Tcl_ChannelWideSeekProc(chanPtr->typePtr) == NULL) { -#ifndef TCL_NO_DEPRECATED - if (offset<LONG_MIN || offset>LONG_MAX) { - *errnoPtr = EOVERFLOW; - return -1; - } - - return Tcl_ChannelSeekProc(chanPtr->typePtr)(chanPtr->instanceData, - offset, mode, errnoPtr); -#else *errnoPtr = EINVAL; return -1; -#endif } return Tcl_ChannelWideSeekProc(chanPtr->typePtr)(chanPtr->instanceData, @@ -666,14 +651,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 +838,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 +884,7 @@ Tcl_DeleteCloseHandler( } else { cbPrevPtr->nextPtr = cbPtr->nextPtr; } - ckfree(cbPtr); + Tcl_Free(cbPtr); break; } cbPrevPtr = cbPtr; @@ -934,7 +919,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 +1011,7 @@ DeleteChannelTable( TclChannelEventScriptInvoker, sPtr); TclDecrRefCount(sPtr->scriptPtr); - ckfree(sPtr); + Tcl_Free(sPtr); } else { prevPtr = sPtr; } @@ -1043,13 +1028,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 +1069,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 +1077,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 +1085,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 +1247,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 +1541,15 @@ TclGetChannelFromObj( * Re-use the ResolvedCmdName struct. */ - Tcl_Release((ClientData) resPtr->statePtr); + Tcl_Release(resPtr->statePtr); } else { - resPtr = (ResolvedChanName *) ckalloc(sizeof(ResolvedChanName)); + resPtr = (ResolvedChanName *) Tcl_Alloc(sizeof(ResolvedChanName)); resPtr->refCount = 0; ChanSetIntRep(objPtr, resPtr); /* Overwrites, if needed */ } statePtr = ((Channel *)chan)->state; resPtr->statePtr = statePtr; - Tcl_Preserve((ClientData) statePtr); + Tcl_Preserve(statePtr); resPtr->interp = interp; resPtr->epoch = statePtr->epoch; @@ -1621,18 +1606,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 +1621,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 +1647,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; @@ -1949,7 +1923,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 @@ -2011,7 +1985,7 @@ TclChannelRelease( return; } if (chanPtr->typePtr == NULL) { - ckfree(chanPtr); + Tcl_Free(chanPtr); } } @@ -2019,8 +1993,8 @@ static void ChannelFree( Channel *chanPtr) { - if (chanPtr->refCount == 0) { - ckfree(chanPtr); + if (!chanPtr->refCount) { + Tcl_Free(chanPtr); return; } chanPtr->typePtr = NULL; @@ -2191,8 +2165,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 @@ -2478,7 +2452,7 @@ AllocChannelBuffer( int 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; @@ -2491,7 +2465,7 @@ static void PreserveChannelBuffer( ChannelBuffer *bufPtr) { - if (bufPtr->refCount == 0) { + if (!bufPtr->refCount) { Tcl_Panic("Reuse of ChannelBuffer! %p", bufPtr); } bufPtr->refCount++; @@ -2504,14 +2478,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; } /* @@ -2947,7 +2921,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))) { @@ -3083,7 +3057,7 @@ CloseChannel( if (chanPtr == statePtr->bottomChanPtr) { if (statePtr->channelName != NULL) { - ckfree(statePtr->channelName); + Tcl_Free(statePtr->channelName); statePtr->channelName = NULL; } @@ -3140,7 +3114,7 @@ CloseChannel( ChannelFree(chanPtr); - return Tcl_Close(interp, (Tcl_Channel) downChanPtr); + return Tcl_CloseEx(interp, (Tcl_Channel) downChanPtr, 0); } /* @@ -3384,7 +3358,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. */ @@ -3419,7 +3393,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"); } @@ -3484,7 +3458,7 @@ Tcl_Close( cbPtr = statePtr->closeCbPtr; statePtr->closeCbPtr = cbPtr->nextPtr; cbPtr->proc(cbPtr->clientData); - ckfree(cbPtr); + Tcl_Free(cbPtr); } ResetFlag(statePtr, CHANNEL_INCLOSE); @@ -3494,20 +3468,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 @@ -3604,7 +3568,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( @@ -3971,7 +3935,7 @@ Tcl_ClearChannelHandlers( for (chPtr = statePtr->chPtr; chPtr != NULL; chPtr = chNext) { chNext = chPtr->nextPtr; - ckfree(chPtr); + Tcl_Free(chPtr); } statePtr->chPtr = NULL; @@ -3998,7 +3962,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; } @@ -4017,8 +3981,8 @@ Tcl_ClearChannelHandlers( * No encoding conversions are applied to the bytes being read. * * Results: - * The number of bytes written or -1 in case of error. If -1, - * Tcl_GetErrno will return the error code. + * The number of bytes written or TCL_IO_FAILURE in case of error. If + * TCL_IO_FAILURE, Tcl_GetErrno will return the error code. * * Side effects: * May buffer up output and may cause output to be produced on the @@ -4027,11 +3991,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(). */ { /* @@ -4045,14 +4009,14 @@ Tcl_Write( chanPtr = statePtr->topChanPtr; if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) { - return -1; + return TCL_IO_FAILURE; } - if (srcLen < 0) { + if (srcLen == TCL_INDEX_NONE) { srcLen = strlen(src); } - if (WriteBytes(chanPtr, src, srcLen) < 0) { - return -1; + if (WriteBytes(chanPtr, src, srcLen) == -1) { + return TCL_IO_FAILURE; } return srcLen; } @@ -4071,8 +4035,8 @@ Tcl_Write( * No encoding conversions are applied to the bytes being read. * * Results: - * The number of bytes written or -1 in case of error. If -1, - * Tcl_GetErrno will return the error code. + * The number of bytes written or TCL_IO_FAILURE in case of error. If + * TCL_IO_FAILURE, Tcl_GetErrno will return the error code. * * Side effects: * May buffer up output and may cause output to be produced on the @@ -4081,23 +4045,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 -1; + return TCL_IO_FAILURE; } - if (srcLen < 0) { + if (srcLen == TCL_INDEX_NONE) { srcLen = strlen(src); } @@ -4107,7 +4072,7 @@ Tcl_WriteRaw( */ written = ChanWrite(chanPtr, src, srcLen, &errorCode); - if (written < 0) { + if (written == TCL_IO_FAILURE) { Tcl_SetErrno(errorCode); } @@ -4127,8 +4092,8 @@ Tcl_WriteRaw( * specified channel to the topmost channel in a stack. * * Results: - * The number of bytes written or -1 in case of error. If -1, - * Tcl_GetErrno will return the error code. + * The number of bytes written or TCL_IO_FAILURE in case of error. If + * TCL_IO_FAILURE, Tcl_GetErrno will return the error code. * * Side effects: * May buffer up output and may cause output to be produced on the @@ -4137,12 +4102,12 @@ 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 < 0 for + size_t len) /* Length of string in bytes, or -1 for * strlen(). */ { Channel *chanPtr = (Channel *) chan; @@ -4151,12 +4116,12 @@ Tcl_WriteChars( Tcl_Obj *objPtr; if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) { - return -1; + return TCL_IO_FAILURE; } chanPtr = statePtr->topChanPtr; - if (len < 0) { + if (len == TCL_INDEX_NONE) { len = strlen(src); } if (statePtr->encoding) { @@ -4175,7 +4140,7 @@ Tcl_WriteChars( } objPtr = Tcl_NewStringObj(src, len); - src = (char *) Tcl_GetByteArrayFromObj(objPtr, &len); + src = (char *) TclGetByteArrayFromObj(objPtr, &len); result = WriteBytes(chanPtr, src, len); TclDecrRefCount(objPtr); return result; @@ -4206,7 +4171,7 @@ Tcl_WriteChars( *---------------------------------------------------------------------- */ -int +size_t Tcl_WriteObj( Tcl_Channel chan, /* The channel to buffer output for. */ Tcl_Obj *objPtr) /* The object to write. */ @@ -4218,16 +4183,16 @@ 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; if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) { - return -1; + return TCL_IO_FAILURE; } if (statePtr->encoding == NULL) { - src = (char *) Tcl_GetByteArrayFromObj(objPtr, &srcLen); + src = (char *) TclGetByteArrayFromObj(objPtr, &srcLen); return WriteBytes(chanPtr, src, srcLen); } else { src = TclGetStringFromObj(objPtr, &srcLen); @@ -4242,9 +4207,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; @@ -4267,9 +4229,6 @@ WillRead( 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 @@ -4444,7 +4403,7 @@ Write( * beginning of the next buffer. */ - saved = -SpaceLeft(bufPtr); + saved = 1 + ~SpaceLeft(bufPtr); memcpy(safe, dst + dstLen, saved); bufPtr->nextAdded = bufPtr->bufLength; } @@ -4508,7 +4467,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 @@ -4517,11 +4476,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); @@ -4551,7 +4510,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 @@ -4562,13 +4521,14 @@ Tcl_GetsObj( ChannelState *statePtr = chanPtr->state; /* State info for channel */ ChannelBuffer *bufPtr; - int inEofChar, skip, copiedTotal, oldLength, oldFlags, oldRemoved; + int inEofChar, skip, copiedTotal, oldFlags, oldRemoved; + size_t oldLength; Tcl_Encoding encoding; char *dst, *dstEnd, *eol, *eof; Tcl_EncodingState oldState; if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) { - return -1; + return TCL_IO_FAILURE; } /* @@ -4583,7 +4543,7 @@ Tcl_GetsObj( /* TODO: Do we need this? */ UpdateInterest(chanPtr); - return -1; + return TCL_IO_FAILURE; } /* @@ -4613,7 +4573,7 @@ Tcl_GetsObj( * newline in the available input. */ - TclGetStringFromObj(objPtr, &oldLength); + (void)TclGetStringFromObj(objPtr, &oldLength); oldFlags = statePtr->inputEncodingFlags; oldState = statePtr->inputEncodingState; oldRemoved = BUFFER_PADDING; @@ -4710,7 +4670,7 @@ Tcl_GetsObj( */ if (eol >= dstEnd) { - int offset; + size_t offset; if (eol != eof) { offset = eol - objPtr->bytes; @@ -4977,8 +4937,9 @@ TclGetsObjBinary( ChannelState *statePtr = chanPtr->state; /* State info for channel */ ChannelBuffer *bufPtr; - int inEofChar, skip, copiedTotal, oldLength, oldFlags, oldRemoved; - int rawLen, byteLen, eolChar; + int inEofChar, skip, copiedTotal, oldFlags, oldRemoved; + size_t rawLen, byteLen = 0, oldLength; + int eolChar; unsigned char *dst, *dstEnd, *eol, *eof, *byteArray; /* @@ -4995,7 +4956,7 @@ TclGetsObjBinary( * newline in the available input. */ - byteArray = Tcl_GetByteArrayFromObj(objPtr, &byteLen); + byteArray = TclGetByteArrayFromObj(objPtr, &byteLen); oldFlags = statePtr->inputEncodingFlags; oldRemoved = BUFFER_PADDING; oldLength = byteLen; @@ -5241,7 +5202,7 @@ FreeBinaryEncoding( } static Tcl_Encoding -GetBinaryEncoding(void) +GetBinaryEncoding() { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -5438,7 +5399,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; } @@ -5618,11 +5579,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; @@ -5635,7 +5596,7 @@ Tcl_Read( chanPtr = statePtr->topChanPtr; if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) { - return -1; + return TCL_IO_FAILURE; } return DoRead(chanPtr, dst, bytesToRead, 0); @@ -5663,11 +5624,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; @@ -5676,7 +5637,7 @@ Tcl_ReadRaw( assert(bytesToRead > 0); if (CheckChannelErrors(statePtr, TCL_READABLE | CHANNEL_RAW_MODE) != 0) { - return -1; + return TCL_IO_FAILURE; } /* @@ -5686,8 +5647,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. @@ -5730,13 +5691,7 @@ Tcl_ReadRaw( if (bytesToRead > 0) { int nread = ChanRead(chanPtr, readBuf, bytesToRead); - if (nread > 0) { - /* - * Successful read (short is OK) - add to bytes copied. - */ - - copied += nread; - } else 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 @@ -5750,6 +5705,12 @@ Tcl_ReadRaw( if (!GotFlag(statePtr, CHANNEL_BLOCKED) || copied == 0) { copied = -1; } + } else if (nread > 0) { + /* + * Successful read (short is OK) - add to bytes copied. + */ + + copied += nread; } else { /* * nread == 0. Driver is at EOF. Let that state filter up. @@ -5781,11 +5742,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 * -1 to read all available data (up to EOF or * when channel blocks). */ int appendFlag) /* If non-zero, data read from the channel @@ -5841,7 +5802,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 * -1 to read all available data (up to EOF or * when channel blocks). */ int appendFlag) /* If non-zero, data read from the channel @@ -5931,7 +5892,7 @@ DoReadChars( } ResetFlag(statePtr, CHANNEL_BLOCKED|CHANNEL_EOF); statePtr->inputEncodingFlags &= ~TCL_ENCODING_END; - for (copied = 0; (unsigned) toRead > 0; ) { + for (copied = 0; toRead > 0; ) { copiedNow = -1; if (statePtr->inQueueHead != NULL) { if (binaryMode) { @@ -6049,7 +6010,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 @@ -6126,7 +6087,8 @@ ReadChars( int savedIEFlags = statePtr->inputEncodingFlags; int savedFlags = statePtr->flags; char *dst, *src = RemovePoint(bufPtr); - int numBytes, srcLen = BytesLeft(bufPtr); + size_t numBytes; + int srcLen = BytesLeft(bufPtr); /* * One src byte can yield at most one character. So when the number of @@ -6149,7 +6111,7 @@ ReadChars( (void) TclGetStringFromObj(objPtr, &numBytes); Tcl_AppendToObj(objPtr, NULL, dstLimit); if (toRead == srcLen) { - unsigned int size; + size_t size; dst = TclGetStringStorage(objPtr, &size) + numBytes; dstLimit = size - numBytes; @@ -6655,7 +6617,7 @@ TranslateInputEOL( * channel, at either the head or tail of the queue. * * Results: - * The number of bytes stored in the channel, or -1 on error. + * The number of bytes stored in the channel, or TCL_IO_FAILURE on error. * * Side effects: * Adds input to the input queue of a channel. @@ -6663,11 +6625,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. */ { @@ -6691,7 +6653,7 @@ Tcl_Ungets( flags = statePtr->flags; if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) { - len = -1; + len = TCL_IO_FAILURE; goto done; } statePtr->flags = flags; @@ -7034,9 +6996,6 @@ Tcl_Seek( */ if ((Tcl_ChannelWideSeekProc(chanPtr->typePtr) == NULL) -#ifndef TCL_NO_DEPRECATED - && (Tcl_ChannelSeekProc(chanPtr->typePtr) == NULL) -#endif ) { Tcl_SetErrno(EINVAL); return -1; @@ -7202,9 +7161,6 @@ Tcl_Tell( */ if ((Tcl_ChannelWideSeekProc(chanPtr->typePtr) == NULL) -#ifndef TCL_NO_DEPRECATED - && (Tcl_ChannelSeekProc(chanPtr->typePtr) == NULL) -#endif ) { Tcl_SetErrno(EINVAL); return -1; @@ -7291,7 +7247,7 @@ Tcl_TruncateChannel( WillWrite(chanPtr); - if (WillRead(chanPtr) < 0) { + if (WillRead(chanPtr) == -1) { return TCL_ERROR; } @@ -7719,7 +7675,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; @@ -8110,7 +8066,7 @@ Tcl_SetChannelOption( "bad value for -eofchar: must be non-NUL ASCII" " character", -1)); } - ckfree(argv); + Tcl_Free((void *)argv); return TCL_ERROR; } if (GotFlag(statePtr, TCL_READABLE)) { @@ -8125,11 +8081,11 @@ Tcl_SetChannelOption( "bad value for -eofchar: should be a list of zero," " one, or two elements", -1)); } - ckfree(argv); + Tcl_Free((void *)argv); return TCL_ERROR; } if (argv != NULL) { - ckfree(argv); + Tcl_Free((void *)argv); } /* @@ -8163,7 +8119,7 @@ Tcl_SetChannelOption( "bad value for -translation: must be a one or two" " element list", -1)); } - ckfree(argv); + Tcl_Free((void *)argv); return TCL_ERROR; } @@ -8193,7 +8149,7 @@ Tcl_SetChannelOption( "bad value for -translation: must be one of " "auto, binary, cr, lf, crlf, or platform", -1)); } - ckfree(argv); + Tcl_Free((void *)argv); return TCL_ERROR; } @@ -8243,11 +8199,11 @@ Tcl_SetChannelOption( "bad value for -translation: must be one of " "auto, binary, cr, lf, crlf, or platform", -1)); } - 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, @@ -8306,7 +8262,7 @@ CleanupChannelHandlers( TclChannelEventScriptInvoker, sPtr); TclDecrRefCount(sPtr->scriptPtr); - ckfree(sPtr); + Tcl_Free(sPtr); } else { prevPtr = sPtr; } @@ -8691,7 +8647,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; @@ -8795,7 +8751,7 @@ Tcl_DeleteChannelHandler( } else { prevChPtr->nextPtr = chPtr->nextPtr; } - ckfree(chPtr); + Tcl_Free(chPtr); /* * Recompute the interest list for the channel, so that infinite loops @@ -8854,7 +8810,7 @@ DeleteScriptRecord( TclChannelEventScriptInvoker, esPtr); TclDecrRefCount(esPtr->scriptPtr); - ckfree(esPtr); + Tcl_Free(esPtr); break; } @@ -8903,7 +8859,7 @@ CreateScriptRecord( makeCH = (esPtr == NULL); if (makeCH) { - esPtr = (EventScriptRecord *)ckalloc(sizeof(EventScriptRecord)); + esPtr = (EventScriptRecord *)Tcl_Alloc(sizeof(EventScriptRecord)); } /* @@ -9140,20 +9096,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. */ @@ -9236,7 +9178,7 @@ TclCopyChannel( * completed. */ - csPtr = (CopyState *)ckalloc(sizeof(CopyState) + !moveBytes * inStatePtr->bufSize); + csPtr = (CopyState *)Tcl_Alloc(sizeof(CopyState) + !moveBytes * inStatePtr->bufSize); csPtr->bufSize = !moveBytes * inStatePtr->bufSize; csPtr->readPtr = inPtr; csPtr->writePtr = outPtr; @@ -9530,7 +9472,8 @@ CopyData( Tcl_Obj *cmdPtr, *errObj = NULL, *bufObj = NULL, *msg = NULL; Tcl_Channel inChan, outChan; ChannelState *inStatePtr, *outStatePtr; - int result = TCL_OK, size, sizeb; + int result = TCL_OK, size; + size_t sizeb; Tcl_WideInt total; const char *buffer; int inBinary, outBinary, sameEncoding; @@ -9596,7 +9539,7 @@ CopyData( || (csPtr->toRead > (Tcl_WideInt) csPtr->bufSize)) { sizeb = csPtr->bufSize; } else { - sizeb = (int) csPtr->toRead; + sizeb = csPtr->toRead; } if (inBinary || sameEncoding) { @@ -9606,7 +9549,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) { @@ -9690,7 +9633,7 @@ CopyData( * unsuitable for updating totals and toRead. */ - if (sizeb < 0) { + if (sizeb == TCL_INDEX_NONE) { writeError: if (interp) { TclNewObj(errObj); @@ -9858,14 +9801,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. * @@ -9919,7 +9860,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; @@ -10163,7 +10104,7 @@ StopCopy( } inStatePtr->csPtrR = NULL; outStatePtr->csPtrW = NULL; - ckfree(csPtr); + Tcl_Free(csPtr); } /* @@ -10465,7 +10406,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); } /* @@ -10561,16 +10502,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; } @@ -10594,46 +10525,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. @@ -10706,32 +10603,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. @@ -10846,11 +10717,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; } @@ -10875,11 +10741,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; } @@ -10904,11 +10765,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; } @@ -10934,11 +10790,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; } @@ -11116,7 +10967,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 @@ -11169,7 +11020,7 @@ FixLevelCode( msg = Tcl_NewListObj(j, lvn); - ckfree(lvn); + Tcl_Free(lvn); return msg; } @@ -11251,9 +11102,6 @@ Tcl_ChannelTruncateProc( const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */ { - if (Tcl_ChannelVersion(chanTypePtr) < TCL_CHANNEL_VERSION_5) { - return NULL; - } return chanTypePtr->truncateProc; } @@ -11317,7 +11165,7 @@ FreeChannelIntRep( return; } Tcl_Release(resPtr->statePtr); - ckfree(resPtr); + Tcl_Free(resPtr); } #if 0 diff --git a/generic/tclIO.h b/generic/tclIO.h index 54aa5af..d12c02e 100644 --- a/generic/tclIO.h +++ b/generic/tclIO.h @@ -36,7 +36,7 @@ */ typedef struct ChannelBuffer { - int refCount; /* Current uses count */ + size_t refCount; /* Current uses count */ int nextAdded; /* The next position into which a character * will be put in the buffer. */ int nextRemoved; /* Position of next byte to be removed from @@ -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. */ - int refCount; + size_t refCount; } Channel; /* @@ -163,7 +163,7 @@ typedef struct ChannelState { int unreportedError; /* Non-zero if an error report was deferred * because it happened in the background. The * value is the POSIX error code. */ - int 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 diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c index e28f9de..34c12f5 100644 --- a/generic/tclIOCmd.c +++ b/generic/tclIOCmd.c @@ -15,7 +15,7 @@ * Callback structure for accept callback in a TCP server. */ -typedef struct AcceptCallback { +typedef struct { Tcl_Obj *script; /* Script to invoke. */ Tcl_Interp *interp; /* Interpreter in which to run it. */ } AcceptCallback; @@ -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; } } @@ -431,25 +418,11 @@ Tcl_ReadObjCmd( if (i < objc) { if ((TclGetIntFromObj(interp, objv[i], &toRead) != TCL_OK) || (toRead < 0)) { -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 - /* - * The code below provides backwards compatibility with an old - * form of the command that is no longer recommended or - * documented. See also [Bug #3151675]. Will be removed in Tcl 9, - * maybe even earlier. - */ - - if (strcmp(TclGetString(objv[i]), "nonewline") != 0) { -#endif Tcl_SetObjResult(interp, Tcl_ObjPrintf( "expected non-negative integer but got \"%s\"", TclGetString(objv[i]))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "NUMBER", NULL); return TCL_ERROR; -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 - } - newline = 1; -#endif } } @@ -481,7 +454,7 @@ Tcl_ReadObjCmd( if ((charactersRead > 0) && (newline != 0)) { const char *result; - int length; + size_t length; result = TclGetStringFromObj(resultPtr, &length); if (result[length - 1] == '\n') { @@ -724,7 +697,7 @@ Tcl_CloseObjCmd( Tcl_Obj *resultPtr = Tcl_GetObjResult(interp); const char *string; - int len; + size_t len; if (Tcl_IsShared(resultPtr)) { resultPtr = Tcl_DuplicateObj(resultPtr); @@ -883,8 +856,8 @@ Tcl_ExecObjCmd( * on the _Tcl_ stack. */ const char *string; Tcl_Channel chan; - int argc, background, i, index, keepNewline, result, skip, length; - int ignoreStderr; + int argc, background, i, index, keepNewline, result, skip, ignoreStderr; + 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)); /* @@ -1176,7 +1149,7 @@ Tcl_OpenObjCmd( Tcl_SetChannelOption(interp, chan, "-translation", "binary"); } } - ckfree(cmdArgv); + Tcl_Free((void *)cmdArgv); } if (chan == NULL) { return TCL_ERROR; @@ -1224,7 +1197,7 @@ TcpAcceptCallbacksDeleteProc( acceptCallbackPtr->interp = NULL; } Tcl_DeleteHashTable(hTblPtr); - ckfree(hTblPtr); + Tcl_Free(hTblPtr); } /* @@ -1264,7 +1237,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); @@ -1401,7 +1374,7 @@ AcceptCallbackProc( * the client socket - just close it. */ - Tcl_Close(NULL, chan); + Tcl_CloseEx(NULL, chan, 0); } } @@ -1439,7 +1412,7 @@ TcpServerCloseProc( acceptCallbackPtr); } Tcl_DecrRefCount(acceptCallbackPtr->script); - ckfree(acceptCallbackPtr); + Tcl_Free(acceptCallbackPtr); } /* @@ -1486,7 +1459,7 @@ Tcl_SocketObjCmd( } for (a = 1; a < objc; a++) { - const char *arg = Tcl_GetString(objv[a]); + const char *arg = TclGetString(objv[a]); if (arg[0] != '-') { break; @@ -1635,7 +1608,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; @@ -1645,7 +1618,7 @@ Tcl_SocketObjCmd( AcceptCallbackProc, acceptCallbackPtr); if (chan == NULL) { Tcl_DecrRefCount(script); - ckfree(acceptCallbackPtr); + Tcl_Free(acceptCallbackPtr); return TCL_ERROR; } diff --git a/generic/tclIOGT.c b/generic/tclIOGT.c index 353998f..512825c 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); } /* @@ -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; @@ -448,7 +440,7 @@ ExecuteCallback( break; } resObj = Tcl_GetObjResult(eval); - resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen); + resBuf = TclGetByteArrayFromObj(resObj, &resLen); Tcl_WriteRaw(Tcl_GetStackedChannel(dataPtr->self), (char *) resBuf, resLen); break; @@ -458,13 +450,13 @@ ExecuteCallback( break; } resObj = Tcl_GetObjResult(eval); - resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen); + resBuf = TclGetByteArrayFromObj(resObj, &resLen); Tcl_WriteRaw(dataPtr->self, (char *) resBuf, resLen); break; case TRANSMIT_IBUF: resObj = Tcl_GetObjResult(eval); - resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen); + resBuf = TclGetByteArrayFromObj(resObj, &resLen); ResultAdd(&dataPtr->result, resBuf, resLen); break; @@ -821,75 +813,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 +840,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); ClientData parentData = Tcl_GetChannelInstanceData(parent); @@ -932,10 +852,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 +884,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 +1192,7 @@ ResultClear( r->used = 0; if (r->allocated) { - ckfree(r->buf); + Tcl_Free(r->buf); r->buf = NULL; r->allocated = 0; } @@ -1438,10 +1336,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 e50c96f..2076f00 100644 --- a/generic/tclIORChan.c +++ b/generic/tclIORChan.c @@ -46,10 +46,6 @@ static int ReflectEventDelete(Tcl_Event *ev, ClientData cd); #endif static Tcl_WideInt ReflectSeekWide(ClientData clientData, Tcl_WideInt offset, int mode, int *errorCodePtr); -#ifndef TCL_NO_DEPRECATED -static int ReflectSeek(ClientData clientData, long offset, - int mode, int *errorCodePtr); -#endif static int ReflectGetOption(ClientData clientData, Tcl_Interp *interp, const char *optionName, Tcl_DString *dsPtr); @@ -67,14 +63,10 @@ static void TimerRunWrite(ClientData 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 */ @@ -269,7 +261,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 { @@ -402,7 +394,7 @@ static void SrcExitProc(ClientData clientData); #define FreeReceivedError(p) \ if ((p)->base.mustFree) { \ - ckfree((p)->base.msgStr); \ + Tcl_Free((p)->base.msgStr); \ } #define PassReceivedErrorInterp(i,p) \ if ((i) != NULL) { \ @@ -686,7 +678,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)); @@ -701,9 +693,6 @@ TclChanCreateObjCmd( clonePtr->blockModeProc = NULL; } if (!(methods & FLAG(METH_SEEK))) { -#ifndef TCL_NO_DEPRECATED - clonePtr->seekProc = NULL; -#endif clonePtr->wideSeekProc = NULL; } @@ -743,7 +732,7 @@ TclChanCreateObjCmd( Tcl_DecrRefCount(rcPtr->name); Tcl_DecrRefCount(rcPtr->methods); Tcl_DecrRefCount(rcPtr->cmd); - ckfree(rcPtr); + Tcl_Free(rcPtr); return TCL_ERROR; #undef MODE @@ -952,7 +941,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; @@ -1210,7 +1199,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) { @@ -1285,7 +1274,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) { @@ -1323,7 +1312,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' */ @@ -1351,7 +1340,7 @@ ReflectInput( PassReceivedError(rcPtr->chan, &p); *errorCodePtr = EINVAL; } - p.input.toRead = -1; + p.input.toRead = TCL_INDEX_NONE; } else { *errorCodePtr = EOK; } @@ -1380,16 +1369,16 @@ ReflectInput( goto invalid; } - bytev = Tcl_GetByteArrayFromObj(resObj, &bytec); + bytev = TclGetByteArrayFromObj(resObj, &bytec); - if (toRead < bytec) { + 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); } @@ -1625,26 +1614,6 @@ ReflectSeekWide( newLoc = -1; goto stop; } - -#ifndef TCL_NO_DEPRECATED -static int -ReflectSeek( - ClientData 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 /* *---------------------------------------------------------------------- @@ -2023,7 +1992,7 @@ ReflectGetOption( (listc == 1 ? "" : "s"))); goto error; } else { - int len; + size_t len; const char *str = TclGetStringFromObj(resObj, &len); if (len) { @@ -2190,7 +2159,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. */ @@ -2277,7 +2246,7 @@ FreeReflectedChannel( if (rcPtr->cmd) { Tcl_DecrRefCount(rcPtr->cmd); } - ckfree(rcPtr); + Tcl_Free(rcPtr); } /* @@ -2398,7 +2367,7 @@ InvokeTclMethod( */ if (result != TCL_ERROR) { - int cmdLen; + size_t cmdLen; const char *cmdString = TclGetStringFromObj(cmd, &cmdLen); Tcl_IncrRefCount(cmd); @@ -2513,7 +2482,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); } @@ -2601,7 +2570,7 @@ DeleteReflectedChannelMap( Tcl_DeleteHashEntry(hPtr); } Tcl_DeleteHashTable(&rcmPtr->map); - ckfree(&rcmPtr->map); + Tcl_Free(&rcmPtr->map); #if TCL_THREADS /* @@ -2713,7 +2682,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); } @@ -2836,7 +2805,7 @@ DeleteThreadReflectedChannelMap( MarkDead(rcPtr); Tcl_DeleteHashEntry(hPtr); } - ckfree(rcmPtr); + Tcl_Free(rcmPtr); } static void @@ -2876,8 +2845,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; @@ -2959,7 +2928,7 @@ ForwardOpToHandlerThread( Tcl_DeleteThreadExitHandler(SrcExitProc, evPtr); - ckfree(resultPtr); + Tcl_Free(resultPtr); } static int @@ -3061,22 +3030,22 @@ 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); + bytev = TclGetByteArrayFromObj(resObj, &bytec); if (paramPtr->input.toRead < bytec) { ForwardSetStaticError(paramPtr, msg_read_toomuch); - paramPtr->input.toRead = -1; + paramPtr->input.toRead = TCL_IO_FAILURE; } else { - if (bytec > 0) { + if (bytec + 1 > 1) { memcpy(paramPtr->input.buf, bytev, bytec); } paramPtr->input.toRead = bytec; @@ -3259,14 +3228,14 @@ 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}", listc, (listc == 1 ? "element" : "elements")); ForwardSetDynamicError(paramPtr, buf); } else { - int len; + size_t len; const char *str = TclGetStringFromObj(resObj, &len); if (len) { @@ -3365,11 +3334,11 @@ ForwardSetObjError( ForwardParam *paramPtr, Tcl_Obj *obj) { - int len; + size_t len; const char *msgStr = TclGetStringFromObj(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 3c5f133..698f3ce 100644 --- a/generic/tclIORTrans.c +++ b/generic/tclIORTrans.c @@ -41,10 +41,6 @@ static void ReflectWatch(ClientData clientData, int mask); static int ReflectBlock(ClientData clientData, int mode); static Tcl_WideInt ReflectSeekWide(ClientData clientData, Tcl_WideInt offset, int mode, int *errorCodePtr); -#ifndef TCL_NO_DEPRECATED -static int ReflectSeek(ClientData clientData, long offset, - int mode, int *errorCodePtr); -#endif static int ReflectGetOption(ClientData clientData, Tcl_Interp *interp, const char *optionName, Tcl_DString *dsPtr); @@ -62,14 +58,10 @@ static int ReflectNotify(ClientData 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. */ @@ -91,8 +83,8 @@ static const Tcl_ChannelType tclRTransformType = { typedef struct { unsigned char *buf; /* Reference to the buffer area. */ - int allocated; /* Allocated size of the buffer area. */ - int used; /* Number of bytes in the buffer, + size_t allocated; /* Allocated size of the buffer area. */ + size_t used; /* Number of bytes in the buffer, * <= allocated. */ } ResultBuffer; @@ -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(ClientData clientData); #define FreeReceivedError(p) \ do { \ if ((p)->base.mustFree) { \ - ckfree((p)->base.msgStr); \ + Tcl_Free((p)->base.msgStr); \ } \ } while (0) #define PassReceivedErrorInterp(i,p) \ @@ -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; } @@ -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( - ClientData 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 /* *---------------------------------------------------------------------- @@ -1762,7 +1723,7 @@ NewReflectedTransform( 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 +1770,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 +1878,8 @@ FreeReflectedTransform( FreeReflectedTransformArgs(rtPtr); - ckfree(rtPtr->argv); - ckfree(rtPtr); + Tcl_Free(rtPtr->argv); + Tcl_Free(rtPtr); } /* @@ -2044,7 +2005,7 @@ InvokeTclMethod( */ if (result != TCL_ERROR) { Tcl_Obj *cmd = Tcl_NewListObj(cmdc, rtPtr->argv); - int cmdLen; + size_t cmdLen; const char *cmdString = TclGetStringFromObj(cmd, &cmdLen); Tcl_IncrRefCount(cmd); @@ -2117,7 +2078,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); @@ -2182,7 +2143,7 @@ DeleteReflectedTransformMap( Tcl_DeleteHashEntry(hPtr); } Tcl_DeleteHashTable(&rtmPtr->map); - ckfree(&rtmPtr->map); + Tcl_Free(&rtmPtr->map); #if TCL_THREADS /* @@ -2280,7 +2241,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); } @@ -2338,7 +2299,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 @@ -2415,8 +2376,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; @@ -2496,7 +2457,7 @@ ForwardOpToOwnerThread( Tcl_DeleteThreadExitHandler(SrcExitProc, evPtr); - ckfree(resultPtr); + Tcl_Free(resultPtr); } static int @@ -2593,23 +2554,23 @@ 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 */ - bytev = Tcl_GetByteArrayFromObj(resObj, &bytec); + bytev = TclGetByteArrayFromObj(resObj, &bytec); 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; @@ -2627,23 +2588,23 @@ 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 */ - bytev = Tcl_GetByteArrayFromObj(resObj, &bytec); + bytev = TclGetByteArrayFromObj(resObj, &bytec); 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; @@ -2657,22 +2618,22 @@ 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); + bytev = TclGetByteArrayFromObj(resObj, &bytec); 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; @@ -2683,23 +2644,23 @@ 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 */ - bytev = Tcl_GetByteArrayFromObj(resObj, &bytec); + bytev = TclGetByteArrayFromObj(resObj, &bytec); 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; @@ -2808,11 +2769,11 @@ ForwardSetObjError( ForwardParam *paramPtr, Tcl_Obj *obj) { - int len; + size_t len; const char *msgStr = TclGetStringFromObj(obj, &len); len++; - ForwardSetDynamicError(paramPtr, ckalloc(len)); + ForwardSetDynamicError(paramPtr, Tcl_Alloc(len)); memcpy(paramPtr->base.msgStr, msgStr, len); } #endif /* TCL_THREADS */ @@ -2957,7 +2918,7 @@ ResultClear( return; } - ckfree(rPtr->buf); + Tcl_Free(rPtr->buf); rPtr->buf = NULL; rPtr->allocated = 0; } @@ -2992,10 +2953,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)); } } @@ -3040,7 +3001,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. */ @@ -3048,7 +3009,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. @@ -3083,7 +3044,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 */ /* @@ -3094,7 +3055,7 @@ TransformRead( if (rtPtr->thread != Tcl_GetCurrentThread()) { ForwardParam p; - p.transform.buf = (char *) Tcl_GetByteArrayFromObj(bufObj, + p.transform.buf = (char *) TclGetByteArrayFromObj(bufObj, &(p.transform.size)); ForwardOpToOwnerThread(rtPtr, ForwardedInput, &p); @@ -3107,7 +3068,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 */ @@ -3122,7 +3083,7 @@ TransformRead( return 0; } - bytev = Tcl_GetByteArrayFromObj(resObj, &bytec); + bytev = TclGetByteArrayFromObj(resObj, &bytec); ResultAdd(&rtPtr->result, bytev, bytec); Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ @@ -3138,7 +3099,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; @@ -3164,7 +3125,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 */ { @@ -3184,7 +3145,7 @@ TransformWrite( *errorCodePtr = EOK; - bytev = Tcl_GetByteArrayFromObj(resObj, &bytec); + bytev = TclGetByteArrayFromObj(resObj, &bytec); res = Tcl_WriteRaw(rtPtr->parent, (char *) bytev, bytec); Tcl_DecrRefCount(bufObj); @@ -3205,7 +3166,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 */ /* @@ -3226,7 +3187,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 */ { @@ -3237,7 +3198,7 @@ TransformDrain( return 0; } - bytev = Tcl_GetByteArrayFromObj(resObj, &bytec); + bytev = TclGetByteArrayFromObj(resObj, &bytec); ResultAdd(&rtPtr->result, bytev, bytec); Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ @@ -3254,7 +3215,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; @@ -3281,7 +3242,7 @@ TransformFlush( } else { res = 0; } - ckfree(p.transform.buf); + Tcl_Free(p.transform.buf); } else #endif /* TCL_THREADS */ { @@ -3293,7 +3254,7 @@ TransformFlush( } if (op == FLUSH_WRITE) { - bytev = Tcl_GetByteArrayFromObj(resObj, &bytec); + bytev = TclGetByteArrayFromObj(resObj, &bytec); res = Tcl_WriteRaw(rtPtr->parent, (char *) bytev, bytec); } else { res = 0; diff --git a/generic/tclIOSock.c b/generic/tclIOSock.c index adf729a..531c38b 100644 --- a/generic/tclIOSock.c +++ b/generic/tclIOSock.c @@ -224,7 +224,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 fcce215..4cd2c6d 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -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,7 +521,7 @@ TclFSCwdPointerEquals( if (tsdPtr->cwdPathPtr == *pathPtrPtr) { return 1; } else { - int len1, len2; + size_t len1, len2; const char *str1, *str2; str1 = TclGetStringFromObj(tsdPtr->cwdPathPtr, &len1); @@ -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; } @@ -663,7 +663,7 @@ FsUpdateCwd( Tcl_Obj *cwdObj, ClientData clientData) { - int len; + size_t len = 0; const char *str = NULL; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey); @@ -770,7 +770,7 @@ TclFinalizeFilesystem(void) */ if (fsRecPtr != &nativeFilesystemRecord) { - ckfree(fsRecPtr); + Tcl_Free(fsRecPtr); } fsRecPtr = tmpFsRecPtr; } @@ -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 { @@ -1145,7 +1145,7 @@ FsAddMountsToGlobResult( } if (!found && dir) { Tcl_Obj *norm; - int len, mlen; + size_t len, mlen; /* * mElt is normalized and lies inside pathPtr so @@ -1325,7 +1325,7 @@ TclFSNormalizeToUniquePath( { FilesystemRecord *fsRecPtr, *firstFsRecPtr; - int i; + size_t i; int isVfsPath = 0; const char *path; @@ -1338,7 +1338,7 @@ TclFSNormalizeToUniquePath( * We check these first to avoid useless calls to the native filesystem's * normalizePathProc. */ - path = Tcl_GetStringFromObj(pathPtr, &i); + path = TclGetStringFromObj(pathPtr, &i); if ( (i >= 3) && ( (path[0] == '/' && path[1] == '/') || (path[0] == '\\' && path[1] == '\\') ) ) { @@ -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,14 +1703,14 @@ 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; } @@ -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; } @@ -1800,12 +1801,12 @@ Tcl_FSEvalFileEx( */ const char *pathString = TclGetStringFromObj(pathPtr, &length); - int limit = 150; + 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,17 +1838,17 @@ 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 @@ -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; } @@ -1951,14 +1952,14 @@ EvalFileCallback( * Record information about where the error occurred. */ - int length; + size_t length; const char *pathString = TclGetStringFromObj(pathPtr, &length); - const int limit = 150; + 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; } @@ -2793,7 +2794,7 @@ 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); @@ -3126,7 +3127,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; } @@ -3202,7 +3203,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; } @@ -3239,11 +3240,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) { @@ -3357,7 +3358,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 @@ -3398,7 +3399,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; @@ -3536,8 +3537,8 @@ DivertUnloadFile( Tcl_DecrRefCount(tvdlPtr->divertedFile); } - ckfree(tvdlPtr); - ckfree(loadHandle); + Tcl_Free(tvdlPtr); + Tcl_Free(loadHandle); } /* @@ -3677,7 +3678,7 @@ TclFSUnloadTempFile( Tcl_DecrRefCount(tvdlPtr->divertedFile); } - ckfree(tvdlPtr); + Tcl_Free(tvdlPtr); } /* @@ -3893,7 +3894,7 @@ Tcl_FSSplitPath( if (sep != NULL) { Tcl_IncrRefCount(sep); - separator = Tcl_GetString(sep)[0]; + separator = TclGetString(sep)[0]; Tcl_DecrRefCount(sep); } } @@ -3905,7 +3906,7 @@ Tcl_FSSplitPath( */ TclNewObj(result); - p = Tcl_GetString(pathPtr); + p = TclGetString(pathPtr); Tcl_ListObjAppendElement(NULL, result, Tcl_NewStringObj(p, driveNameLength)); p += driveNameLength; @@ -3974,7 +3975,7 @@ TclGetPathType( * refCount of 1, and whose value is the name * of the volume. */ { - int pathLen; + size_t pathLen; const char *path = TclGetStringFromObj(pathPtr, &pathLen); Tcl_PathType type; @@ -4077,13 +4078,13 @@ TclFSNonnativePathType( } while (numVolumes > 0) { Tcl_Obj *vol; - int len; + size_t len; const char *strVol; numVolumes--; Tcl_ListObjIndex(NULL, thisFsVolumes, numVolumes, &vol); strVol = TclGetStringFromObj(vol,&len); - if (pathLen < len) { + if ((size_t) pathLen < len) { continue; } if (strncmp(strVol, path, len) == 0) { @@ -4243,7 +4244,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; } @@ -4260,8 +4261,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. @@ -4425,14 +4426,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); 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]. @@ -4572,7 +4573,7 @@ static void NativeFreeInternalRep( ClientData clientData) { - ckfree(clientData); + Tcl_Free(clientData); } /* diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c index 6ae2075..89582b7 100644 --- a/generic/tclIndexObj.c +++ b/generic/tclIndexObj.c @@ -60,8 +60,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; /* @@ -78,75 +78,6 @@ typedef struct { /* *---------------------------------------------------------------------- * - * Tcl_GetIndexFromObj -- - * - * This function looks up an object's value in a table of strings and - * returns the index of the matching string, if any. - * - * Results: - * If the value of objPtr is identical to or a unique abbreviation for - * one of the entries in tablePtr, then the return value is TCL_OK and the - * index of the matching entry is stored at *indexPtr. If there isn't a - * proper match, then TCL_ERROR is returned and an error message is left - * in interp's result (unless interp is NULL). The msg argument is used - * in the error message; for example, if msg has the value "option" then - * the error message will say something flag 'bad option "foo": must be - * ...' - * - * Side effects: - * The result of the lookup is cached as the internal rep of objPtr, so - * that repeated lookups can be done quickly. - * - *---------------------------------------------------------------------- - */ - -#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_ObjIntRep *irPtr = TclFetchIntRep(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 */ - -/* - *---------------------------------------------------------------------- - * * GetIndexFromObjList -- * * This procedure looks up an object's value in a table of strings and @@ -199,26 +130,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; } @@ -258,7 +189,7 @@ 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 or TCL_EXACT */ @@ -273,8 +204,8 @@ Tcl_GetIndexFromObjStruct( const Tcl_ObjIntRep *irPtr; /* Protect against invalid values, like -1 or 0. */ - if (offset < (int)sizeof(char *)) { - offset = (int)sizeof(char *); + if (offset+1 <= sizeof(char *)) { + offset = sizeof(char *); } /* * See if there is a valid cached result from a previous lookup. @@ -351,7 +282,7 @@ Tcl_GetIndexFromObjStruct( } else { Tcl_ObjIntRep ir; - indexRep = (IndexRep*)ckalloc(sizeof(IndexRep)); + indexRep = (IndexRep*)Tcl_Alloc(sizeof(IndexRep)); ir.twoPtrValue.ptr1 = indexRep; Tcl_StoreIntRep(objPtr, &indexType, &ir); } @@ -453,7 +384,7 @@ DupIndex( Tcl_Obj *dupPtr) { Tcl_ObjIntRep ir; - IndexRep *dupIndexRep = (IndexRep *)ckalloc(sizeof(IndexRep)); + IndexRep *dupIndexRep = (IndexRep *)Tcl_Alloc(sizeof(IndexRep)); memcpy(dupIndexRep, TclFetchIntRep(srcPtr, &indexType)->twoPtrValue.ptr1, sizeof(IndexRep)); @@ -483,7 +414,7 @@ static void FreeIndex( Tcl_Obj *objPtr) { - ckfree(TclFetchIntRep(objPtr, &indexType)->twoPtrValue.ptr1); + Tcl_Free(TclFetchIntRep(objPtr, &indexType)->twoPtrValue.ptr1); objPtr->typePtr = NULL; } @@ -579,7 +510,7 @@ PrefixMatchObjCmd( return TCL_ERROR; } i++; - message = Tcl_GetString(objv[i]); + message = TclGetString(objv[i]); break; case PRFMATCH_ERROR: if (i > objc-4) { @@ -669,7 +600,8 @@ PrefixAllObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int tableObjc, result, t, length, elemLength; + int tableObjc, result, t; + size_t length, elemLength; const char *string, *elemString; Tcl_Obj **tableObjv, *resultPtr; @@ -726,7 +658,8 @@ PrefixLongestObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int tableObjc, result, i, t, length, elemLength, resultLength; + int tableObjc, result, t; + size_t i, length, elemLength, resultLength; const char *string, *elemString, *resultString; Tcl_Obj **tableObjv; @@ -849,34 +782,12 @@ Tcl_WrongNumArgs( * NULL. */ { Tcl_Obj *objPtr; - int i, len, elemLen; + int i; + size_t 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; @@ -943,7 +854,7 @@ Tcl_WrongNumArgs( 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, @@ -954,8 +865,6 @@ 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). @@ -994,7 +903,7 @@ Tcl_WrongNumArgs( 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, @@ -1006,8 +915,6 @@ 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). @@ -1030,8 +937,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 } /* @@ -1090,7 +995,7 @@ Tcl_ParseArgsObjv( * being processed, primarily for error * reporting. */ int objc; /* # arguments in objv still to process. */ - int length; /* Number of characters in current argument */ + size_t length; /* Number of characters in current argument */ if (remObjv != NULL) { /* @@ -1101,7 +1006,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; @@ -1187,7 +1092,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++; @@ -1198,7 +1103,7 @@ Tcl_ParseArgsObjv( goto missingArg; } *((const char **) infoPtr->dstPtr) = - Tcl_GetString(objv[srcIndex]); + TclGetString(objv[srcIndex]); srcIndex++; objc--; break; @@ -1220,7 +1125,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++; @@ -1285,7 +1190,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; /* @@ -1298,7 +1203,7 @@ Tcl_ParseArgsObjv( "\"%s\" option requires an additional argument", str)); error: if (leftovers != NULL) { - ckfree(leftovers); + Tcl_Free(leftovers); } return TCL_ERROR; } @@ -1342,13 +1247,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; } } diff --git a/generic/tclInt.decls b/generic/tclInt.decls index 0addf66..5b02fb4 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -48,12 +48,13 @@ declare 6 { void TclCleanupCommand(Command *cmdPtr) } declare 7 { - int TclCopyAndCollapse(int 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) + size_t TclCopyAndCollapse(size_t count, const char *src, char *dst) } +# Removed in 9.0: +#declare 8 { +# int TclCopyChannelOld(Tcl_Interp *interp, Tcl_Channel inChan, +# Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr) +#} # TclCreatePipeline unofficially exported for use by BLT. @@ -79,7 +80,7 @@ declare 12 { # Tcl_DString *headPtr, char *tail, Tcl_GlobTypeData *types) #} declare 14 { - int TclDumpMemoryInfo(ClientData clientData, int flags) + int TclDumpMemoryInfo(void *clientData, int flags) } # Removed in 8.1: # declare 15 { @@ -107,14 +108,14 @@ declare 16 { declare 22 { int TclFindElement(Tcl_Interp *interp, const char *listStr, int listLength, const char **elementPtr, const char **nextPtr, - int *sizePtr, int *bracePtr) + size_t *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) + size_t TclFormatInt(char *buffer, Tcl_WideInt n) } declare 25 { void TclFreePackageInfo(Interp *iPtr) @@ -151,10 +152,11 @@ declare 32 { #declare 33 { # TclCmdProcType TclGetInterpProc(void) #} -declare 34 {deprecated {Use Tcl_GetIntForIndex}} { - int TclGetIntForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr, - int endValue, int *indexPtr) -} +# Removed in 9.0: +#declare 34 {deprecated {Use Tcl_GetIntForIndex}} { +# int TclGetIntForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr, +# int endValue, int *indexPtr) +#} # Removed in 8.4b2: #declare 35 { # Tcl_Obj *TclGetIndexedScalar(Tcl_Interp *interp, int localIndex, @@ -164,9 +166,10 @@ declare 34 {deprecated {Use Tcl_GetIntForIndex}} { #declare 36 { # int TclGetLong(Tcl_Interp *interp, const char *str, long *longPtr) #} -declare 37 { - int TclGetLoadedPackages(Tcl_Interp *interp, const char *targetName) -} +# Removed in 9.0: +#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, @@ -183,16 +186,17 @@ declare 41 { Tcl_Command TclGetOriginalCommand(Tcl_Command command) } declare 42 { - CONST86 char *TclpGetUserHome(const char *name, Tcl_DString *bufferPtr) + const char *TclpGetUserHome(const char *name, Tcl_DString *bufferPtr) } # Removed in 8.5a2: #declare 43 { # int TclGlobalInvoke(Tcl_Interp *interp, int argc, const char **argv, # int flags) #} -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) } @@ -213,10 +217,11 @@ declare 46 { # Tcl_Obj *TclIncrVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr, # Tcl_Obj *part2Ptr, long incrAmount, int part1NotParsed) #} -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) } @@ -226,11 +231,11 @@ declare 51 { # int flags) #} declare 53 { - int TclInvokeObjectCommand(ClientData clientData, Tcl_Interp *interp, + int TclInvokeObjectCommand(void *clientData, Tcl_Interp *interp, int argc, const char **argv) } declare 54 { - int TclInvokeStringCommand(ClientData clientData, Tcl_Interp *interp, + int TclInvokeStringCommand(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) } declare 55 { @@ -266,7 +271,7 @@ declare 62 { int TclObjCommandComplete(Tcl_Obj *cmdPtr) } declare 63 { - int TclObjInterpProc(ClientData clientData, Tcl_Interp *interp, + int TclObjInterpProc(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) } declare 64 { @@ -289,7 +294,7 @@ declare 64 { # int TclpAccess(const char *path, int mode) #} declare 69 { - void *TclpAlloc(unsigned int size) + void *TclpAlloc(size_t size) } #declare 70 { # int TclpCopyFile(const char *source, const char *dest) @@ -308,14 +313,16 @@ declare 74 { void TclpFree(void *ptr) } declare 75 { - unsigned long TclpGetClicks(void) + Tcl_WideUInt TclpGetClicks(void) } declare 76 { - unsigned long TclpGetSeconds(void) -} -declare 77 {deprecated {}} { - void TclpGetTime(Tcl_Time *time) + Tcl_WideUInt TclpGetSeconds(void) } + +# Removed in 9.0: +#declare 77 { +# void TclpGetTime(Tcl_Time *time) +#} # Removed in 8.6: #declare 78 { # int TclpGetTimeZone(unsigned long time) @@ -330,7 +337,7 @@ declare 77 {deprecated {}} { # char *modeString, int permissions) #} declare 81 { - void *TclpRealloc(void *ptr, unsigned int size) + void *TclpRealloc(void *ptr, size_t size) } #declare 82 { # int TclpRemoveDirectory(const char *path, int recursive, @@ -355,10 +362,11 @@ declare 81 { # declare 87 { # void TclPlatformInit(Tcl_Interp *interp) # } -declare 88 {deprecated {}} { - char *TclPrecTraceProc(ClientData clientData, Tcl_Interp *interp, - const char *name1, const char *name2, int flags) -} +# 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) @@ -376,7 +384,7 @@ declare 92 { const char *procName) } declare 93 { - void TclProcDeleteProc(ClientData clientData) + void TclProcDeleteProc(void *clientData) } # Removed in 8.5: #declare 94 { @@ -408,7 +416,7 @@ declare 98 { # Tcl_Obj *objPtr, int flags) #} declare 101 { - CONST86 char *TclSetPreInitScript(const char *string) + const char *TclSetPreInitScript(const char *string) } declare 102 { void TclSetupEnv(Tcl_Interp *interp) @@ -417,9 +425,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) +#} # Replaced by Tcl_FSStat in 8.4: #declare 105 { # int TclStat(const char *path, Tcl_StatBuf *buf) @@ -452,29 +461,35 @@ 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, - ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc) -} -declare 114 { - void TclDeleteNamespace(Tcl_Namespace *nsPtr) -} -declare 115 { - int TclExport(Tcl_Interp *interp, Tcl_Namespace *nsPtr, - const char *pattern, int resetListFirst) -} -declare 116 { - Tcl_Command TclFindCommand(Tcl_Interp *interp, const char *name, - Tcl_Namespace *contextNsPtr, int flags) -} -declare 117 { - Tcl_Namespace *TclFindNamespace(Tcl_Interp *interp, const char *name, - Tcl_Namespace *contextNsPtr, int flags) -} +# Removed in 9.0: +#declare 112 { +# int Tcl_AppendExportList(Tcl_Interp *interp, Tcl_Namespace *nsPtr, +# Tcl_Obj *objPtr) +#} +# Removed in 9.0: +#declare 113 { +# Tcl_Namespace *Tcl_CreateNamespace(Tcl_Interp *interp, const char *name, +# void *clientData, Tcl_NamespaceDeleteProc *deleteProc) +#} +# Removed in 9.0: +#declare 114 { +# void Tcl_DeleteNamespace(Tcl_Namespace *nsPtr) +#} +# Removed in 9.0: +#declare 115 { +# int Tcl_Export(Tcl_Interp *interp, Tcl_Namespace *nsPtr, +# const char *pattern, int resetListFirst) +#} +# Removed in 9.0: +#declare 116 { +# Tcl_Command Tcl_FindCommand(Tcl_Interp *interp, const char *name, +# Tcl_Namespace *contextNsPtr, int flags) +#} +# Removed in 9.0: +#declare 117 { +# Tcl_Namespace *Tcl_FindNamespace(Tcl_Interp *interp, const char *name, +# Tcl_Namespace *contextNsPtr, int flags) +#} declare 118 { int Tcl_GetInterpResolvers(Tcl_Interp *interp, const char *name, Tcl_ResolverInfo *resInfo) @@ -487,31 +502,37 @@ 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 Tcl_ForgetImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr, +# const char *pattern) +#} +# Removed in 9.0: +#declare 122 { +# Tcl_Command Tcl_GetCommandFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr) +#} +# Removed in 9.0: +#declare 123 { +# void Tcl_GetCommandFullName(Tcl_Interp *interp, Tcl_Command command, +# Tcl_Obj *objPtr) +#} +# Removed in 9.0: +#declare 124 { +# Tcl_Namespace *Tcl_GetCurrentNamespace(Tcl_Interp *interp) +#} +# Removed in 9.0: +#declare 125 { +# Tcl_Namespace *Tcl_GetGlobalNamespace(Tcl_Interp *interp) +#} declare 126 { void Tcl_GetVariableFullName(Tcl_Interp *interp, Tcl_Var variable, Tcl_Obj *objPtr) } -declare 127 { - int TclImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr, - const char *pattern, int allowOverwrite) -} +# Removed in 9.0: +#declare 127 { +# int Tcl_Import(Tcl_Interp *interp, Tcl_Namespace *nsPtr, +# const char *pattern, int allowOverwrite) +#} declare 128 { void Tcl_PopCallFrame(Tcl_Interp *interp) } @@ -530,9 +551,10 @@ declare 131 { declare 132 { int TclpHasSockets(Tcl_Interp *interp) } -declare 133 {deprecated {}} { - struct tm *TclpGetDate(const time_t *time, int useGMT) -} +# Removed in 9.0 +#declare 133 { +# struct tm *TclpGetDate(const time_t *time, int useGMT) +#} # Removed in 8.5 #declare 134 { # size_t TclpStrftime(char *s, size_t maxsize, const char *format, @@ -564,7 +586,7 @@ declare 141 { } declare 142 { int TclSetByteCodeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr, - CompileHookProc *hookProc, ClientData clientData) + CompileHookProc *hookProc, void *clientData) } declare 143 { int TclAddLiteralObj(struct CompileEnv *envPtr, Tcl_Obj *objPtr, @@ -596,8 +618,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, size_t index, size_t *startPtr, + size_t *endPtr) } declare 152 { void TclSetLibraryPath(Tcl_Obj *pathPtr) @@ -623,12 +645,14 @@ 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 - use public Tcl_SetStartupScript() +#declare 158 { +# void TclSetStartupScriptFileName(const char *filename) +#} +# REMOVED - use public Tcl_GetStartupScript() +#declare 159 { +# const char *TclGetStartupScriptFileName(void) +#} #declare 160 { # int TclpMatchFilesTypes(Tcl_Interp *interp, char *separators, # Tcl_DString *dirPtr, char *pattern, char *tail, @@ -641,7 +665,7 @@ declare 161 { Tcl_Obj *cmdObjPtr) } declare 162 { - void TclChannelEventScriptInvoker(ClientData clientData, int flags) + void TclChannelEventScriptInvoker(void *clientData, int flags) } # ALERT: The result of 'TclGetInstructionTable' is actually a @@ -672,24 +696,27 @@ declare 166 { int 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) -} +# VFS-aware versions of Tcl*StartupScriptFileName (158 and 159 above) +# REMOVED - use public Tcl_SetStartupScript() +#declare 167 { +# void TclSetStartupScriptPath(Tcl_Obj *pathPtr) +#} +# REMOVED - use public Tcl_GetStartupScript() +#declare 168 { +# Tcl_Obj *TclGetStartupScriptPath(void) +#} # 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, + size_t numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]) } declare 171 { int TclCheckExecutionTraces(Tcl_Interp *interp, const char *command, - int numChars, Command *cmdPtr, int result, int traceFlags, + size_t numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]) } declare 172 { @@ -699,8 +726,8 @@ declare 172 { # added for 8.4.2 declare 173 { - int TclUniCharMatch(const Tcl_UniChar *string, int strLen, - const Tcl_UniChar *pattern, int ptnLen, int flags) + int TclUniCharMatch(const Tcl_UniChar *string, size_t strLen, + const Tcl_UniChar *pattern, size_t ptnLen, int flags) } # added for 8.4.3 @@ -723,12 +750,13 @@ 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) -} +# TIP 338 made these public - now declared in tcl.h +#declare 178 { +# void Tcl_SetStartupScript(Tcl_Obj *pathPtr, const char *encodingName) +#} +#declare 179 { +# Tcl_Obj *Tcl_GetStartupScript(const char **encodingNamePtr) +#} # REMOVED # Allocate lists without copying arrays @@ -740,12 +768,14 @@ declare 179 { # const char *file, int line) #} -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 182 { +# struct tm *TclpLocaltime(const time_t *clock) +#} +# Removed in 9.0 +#declare 183 { +# struct tm *TclpGmtime(const time_t *clock) +#} # For the new "Thread Storage" subsystem. @@ -860,7 +890,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, size_t numBytes) } declare 216 { void TclStackFree(Tcl_Interp *interp, void *freePtr) @@ -887,7 +917,7 @@ declare 226 { int TclObjBeingDeleted(Tcl_Obj *objPtr) } declare 227 { - void TclSetNsPath(Namespace *nsPtr, int pathLength, + void TclSetNsPath(Namespace *nsPtr, size_t pathLength, Tcl_Namespace *pathAry[]) } # Used to be needed for TclOO-extension; unneeded now that TclOO is in the @@ -927,9 +957,12 @@ declare 234 { declare 235 { void TclInitVarHashTable(TclVarHashTable *tablePtr, Namespace *nsPtr) } -declare 236 {deprecated {use Tcl_BackgroundException}} { - void TclBackgroundException(Tcl_Interp *interp, int code) -} + + +# TIP 337 made this one public +#declare 236 { +# void TclBackgroundException(Tcl_Interp *interp, int code) +#} # TIP #285: Script cancellation support. declare 237 { @@ -939,7 +972,7 @@ declare 237 { # NRE functions for "rogue" extensions to exploit NRE; they will need to # include NRE.h too. declare 238 { - int TclNRInterpProc(ClientData clientData, Tcl_Interp *interp, + int TclNRInterpProc(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) } declare 239 { @@ -972,8 +1005,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, size_t numRemoved, + size_t numInserted, Tcl_Obj *const *objv) } declare 247 { void TclResetRewriteEnsemble(Tcl_Interp *interp, int isRootEnsemble) @@ -996,7 +1029,7 @@ declare 250 { # Allow extensions for optimization declare 251 { int TclRegisterLiteral(void *envPtr, - const char *bytes, int length, int flags) + const char *bytes, size_t length, int flags) } # Exporting of the internal API to variables. @@ -1034,15 +1067,17 @@ declare 258 { Tcl_Obj *TclpCreateTemporaryDirectory(Tcl_Obj *dirObj, Tcl_Obj *basenameObj) } - +# TIP 542 declare 259 { - unsigned char *TclGetBytesFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, - int *lengthPtr) + void TclAppendUnicodeToObj(Tcl_Obj *objPtr, + const Tcl_UniChar *unicode, size_t length) } declare 260 { - void TclUnusedStubEntry(void) + unsigned char *TclGetBytesFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, + size_t *lengthPtr) } + ############################################################################## @@ -1055,21 +1090,24 @@ 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) + void TclWinConvertError(int errCode) } +# Removed in 9.0: +#declare 1 win { +# void TclWinConvertWSAError(int errCode) +#} +# Removed in 9.0: +#declare 2 win { +# struct servent *TclWinGetServByName(const char *nm, +# const char *proto) +#} +# Removed in 9.0: +#declare 3 win { +# int TclWinGetSockOpt(SOCKET s, int level, int optname, +# char *optval, int *optlen) +#} declare 4 win { - HINSTANCE TclWinGetTclInstance(void) + void *TclWinGetTclInstance(void) } # new for 8.4.20+/8.5.12+ Cygwin only declare 5 win { @@ -1079,23 +1117,26 @@ declare 5 win { # declare 5 win { # HINSTANCE TclWinLoadLibrary(char *name) # } -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) -} +# Removed in 9.0: +#declare 6 win { +# unsigned short TclWinNToHS(unsigned short ns) +#} +# Removed in 9.0: +#declare 7 win { +# int TclWinSetSockOpt(SOCKET s, int level, int optname, +# const char *optval, int optlen) +#} declare 8 win { - int TclpGetPid(Tcl_Pid pid) -} -declare 9 win { - int TclWinGetPlatformId(void) -} -# new for 8.4.20+/8.5.12+ Cygwin only -declare 10 win { - Tcl_DirEntry *TclpReaddir(TclDIR *dir) + size_t TclpGetPid(Tcl_Pid pid) } +# Removed in 9.0: +#declare 9 win { +# int TclWinGetPlatformId(void) +#} +# Removed in 9.0: +#declare 10 win { +# Tcl_DirEntry *TclpReaddir(TclDIR *dir) +#} # Removed in 8.3.1 (for Win32s only): #declare 10 win { # int TclWinSynchSpawn(void *args, int type, void **trans, Tcl_Pid *pidPtr) @@ -1144,11 +1185,12 @@ declare 19 win { TclFile TclpOpenFile(const char *fname, int mode) } declare 20 win { - void TclWinAddProcess(HANDLE hProcess, DWORD id) -} -declare 21 win { - char *TclpInetNtoa(struct in_addr addr) + void TclWinAddProcess(void *hProcess, size_t id) } +# Removed in 9.0: +#declare 21 win { +# char *TclpInetNtoa(struct in_addr addr) +#} # removed permanently for 8.4 #declare 21 win { # void TclpAsyncMark(Tcl_AsyncHandler async) @@ -1169,9 +1211,10 @@ declare 24 win { #declare 25 win { # TclPlatformType *TclWinGetPlatform(void) #} -declare 26 win { - void TclWinSetInterfaces(int wide) -} +# Removed in 9.0: +#declare 26 win { +# void TclWinSetInterfaces(int wide) +#} # Added in Tcl 8.3.3 / 8.4 @@ -1181,9 +1224,10 @@ declare 27 win { # Added in 8.4.2 -declare 28 win { - void TclWinResetInterfaces(void) -} +# Removed in 9.0: +#declare 28 win { +# void TclWinResetInterfaces(void) +#} ################################ # Unix specific functions @@ -1229,20 +1273,22 @@ declare 9 unix { # 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) -} +# Removed in 9.0: +#declare 10 unix { +# Tcl_DirEntry *TclpReaddir(TclDIR *dir) +#} +# Removed in 9.0: +#declare 11 unix { +# struct tm *TclpLocaltime_unix(const time_t *clock) +#} +# Removed in 9.0: +#declare 12 unix { +# struct tm *TclpGmtime_unix(const time_t *clock) +#} +# Removed in 9.0: +#declare 13 unix { +# char *TclpInetNtoa(struct in_addr addr) +#} # Added in 8.5: diff --git a/generic/tclInt.h b/generic/tclInt.h index 9dde88b..2a0dfa6 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 @@ -225,9 +212,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 @@ -300,16 +284,16 @@ typedef struct Namespace { * strings; values have type (Namespace *). If * NULL, there are no children. */ #endif - unsigned long nsId; /* Unique id for the namespace. */ - Tcl_Interp *interp; /* The interpreter containing this + size_t nsId; /* Unique id for the namespace. */ + Tcl_Interp *interp; /* The interpreter containing this * namespace. */ int flags; /* OR-ed combination of the namespace status * flags NS_DYING and NS_DEAD listed below. */ - int activationCount; /* Number of "activations" or active call + size_t activationCount; /* Number of "activations" or active call * frames for this namespace that are on the * Tcl call stack. The namespace won't be * freed until activationCount becomes zero. */ - unsigned int refCount; /* Count of references by namespaceName + size_t refCount; /* Count of references by namespaceName * objects. The namespace can't be freed until * refCount becomes zero. */ Tcl_HashTable cmdTable; /* Contains all the commands currently @@ -330,16 +314,16 @@ typedef struct Namespace { * commands; however, no namespace qualifiers * are allowed. NULL if no export patterns are * registered. */ - int numExportPatterns; /* Number of export patterns currently + size_t numExportPatterns; /* Number of export patterns currently * registered using "namespace export". */ - int maxExportPatterns; /* Mumber of export patterns for which space + size_t maxExportPatterns; /* Number of export patterns for which space * is currently allocated. */ - unsigned int cmdRefEpoch; /* Incremented if a newly added command + size_t cmdRefEpoch; /* Incremented if a newly added command * shadows a command for which this namespace * has already cached a Command* pointer; this * causes all its cached Command* pointers to * be invalidated. */ - unsigned int resolverEpoch; /* Incremented whenever (a) the name + size_t resolverEpoch; /* Incremented whenever (a) the name * resolution rules change for this namespace * or (b) a newly added command shadows a * command that is compiled to bytecodes. This @@ -366,7 +350,7 @@ typedef struct Namespace { * LookupCompiledLocal to resolve variable * references within the namespace at compile * time. */ - unsigned int exportLookupEpoch; /* Incremented whenever a command is added to + size_t exportLookupEpoch; /* Incremented whenever a command is added to * a namespace, removed from a namespace or * the exports of a namespace are changed. * Allows TIP#112-driven command lists to be @@ -377,7 +361,7 @@ typedef struct Namespace { Tcl_Obj *unknownHandlerPtr; /* A script fragment to be used when command * resolution in this namespace fails. TIP * 181. */ - int commandPathLength; /* The length of the explicit path. */ + size_t commandPathLength; /* The length of the explicit path. */ NamespacePathEntry *commandPathArray; /* The explicit path of the namespace as an * array. */ @@ -467,7 +451,7 @@ typedef struct EnsembleConfig { * if the command has been deleted (or never * existed; the global namespace never has an * ensemble command.) */ - unsigned int epoch; /* The epoch at which this ensemble's table of + size_t epoch; /* The epoch at which this ensemble's table of * exported commands is valid. */ char **subcommandArrayPtr; /* Array of ensemble subcommand names. At all * consistent points, this will have the same @@ -580,7 +564,7 @@ typedef struct CommandTrace { struct CommandTrace *nextPtr; /* Next in list of traces associated with a * particular command. */ - unsigned int refCount; /* Used to ensure this structure is not + size_t refCount; /* Used to ensure this structure is not * deleted too early. Keeps track of how many * pieces of code have a pointer to this * structure. */ @@ -643,7 +627,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 @@ -653,7 +637,7 @@ typedef struct Var { typedef struct VarInHash { Var var; - unsigned int refCount; /* Counts number of active uses of this + size_t refCount; /* Counts number of active uses of this * variable: 1 for the entry in the hash * table, 1 for each additional variable whose * linkPtr points here, 1 for each nested @@ -956,7 +940,7 @@ typedef struct CompiledLocal { /* Next compiler-recognized local variable for * this procedure, or NULL if this is the last * local. */ - int nameLength; /* The number of bytes in local variable's name. + size_t nameLength; /* The number of bytes in local variable's name. * Among others used to speed up var lookups. */ int frameIndex; /* Index in the array of compiler-assigned * variables in the procedure call frame. */ @@ -990,7 +974,7 @@ typedef struct CompiledLocal { typedef struct Proc { struct Interp *iPtr; /* Interpreter for which this command is * defined. */ - unsigned int refCount; /* Reference count: 1 if still present in + size_t refCount; /* Reference count: 1 if still present in * command table plus 1 for each call to the * procedure that is currently active. This * structure can be freed when refCount @@ -1107,7 +1091,7 @@ typedef struct AssocData { */ typedef struct LocalCache { - unsigned int refCount; + size_t refCount; int numVars; Tcl_Obj *varName0; } LocalCache; @@ -1262,7 +1246,7 @@ typedef struct CmdFrame { } data; Tcl_Obj *cmdObj; const char *cmd; /* The executed command, if possible... */ - int len; /* ... and its length. */ + size_t len; /* ... and its length. */ const struct CFWordBC *litarg; /* Link to set of literal arguments which have * ben pushed on the lineLABCPtr stack by @@ -1273,13 +1257,13 @@ typedef struct CmdFrame { typedef struct CFWord { CmdFrame *framePtr; /* CmdFrame to access. */ int word; /* Index of the word in the command. */ - unsigned int refCount; /* Number of times the word is on the + size_t refCount; /* Number of times the word is on the * stack. */ } CFWord; typedef struct CFWordBC { CmdFrame *framePtr; /* CmdFrame to access. */ - int pc; /* Instruction pointer of a command in + size_t pc; /* Instruction pointer of a command in * ExtCmdLoc.loc[.] */ int word; /* Index of word in * ExtCmdLoc.loc[cmd]->line[.] */ @@ -1360,7 +1344,7 @@ typedef struct { * proc field is NULL. */ } ExtraFrameInfoField; typedef struct { - int length; /* Length of array. */ + size_t length; /* Length of array. */ ExtraFrameInfoField fields[2]; /* Really as long as necessary, but this is * long enough for nearly anything. */ @@ -1449,7 +1433,7 @@ typedef int (CompileProc)(Tcl_Interp *interp, Tcl_Parse *parsePtr, */ typedef int (CompileHookProc)(Tcl_Interp *interp, - struct CompileEnv *compEnvPtr, ClientData clientData); + struct CompileEnv *compEnvPtr, void *clientData); /* * The data structure for a (linked list of) execution stacks. @@ -1536,11 +1520,11 @@ typedef struct LiteralEntry { * NULL if end of chain. */ Tcl_Obj *objPtr; /* Points to Tcl object that holds the * literal's bytes and length. */ - unsigned int refCount; /* If in an interpreter's global literal + size_t refCount; /* If in an interpreter's global literal * table, the number of ByteCode structures * that share the literal object; the literal * entry can be freed when refCount drops to - * 0. If in a local literal table, (unsigned)-1. */ + * 0. If in a local literal table, TCL_INDEX_NONE. */ Namespace *nsPtr; /* Namespace in which this literal is used. We * try to avoid sharing literal non-FQ command * names among different namespaces to reduce @@ -1554,13 +1538,13 @@ typedef struct LiteralTable { LiteralEntry *staticBuckets[TCL_SMALL_HASH_TABLE]; /* Bucket array used for small tables to avoid * mallocs and frees. */ - unsigned int numBuckets; /* Total number of buckets allocated at + size_t numBuckets; /* Total number of buckets allocated at * **buckets. */ - unsigned int numEntries; /* Total number of entries present in + size_t numEntries; /* Total number of entries present in * table. */ - unsigned int rebuildSize; /* Enlarge table when numEntries gets to be + size_t rebuildSize; /* Enlarge table when numEntries gets to be * this large. */ - unsigned int mask; /* Mask value used in hashing function. */ + size_t mask; /* Mask value used in hashing function. */ } LiteralTable; /* @@ -1678,12 +1662,12 @@ typedef struct Command { * recreated). */ Namespace *nsPtr; /* Points to the namespace containing this * command. */ - unsigned int refCount; /* 1 if in command hashtable plus 1 for each + size_t refCount; /* 1 if in command hashtable plus 1 for each * reference from a CmdName Tcl object * representing a command's name in a ByteCode * instruction sequence. This structure can be * freed when refCount becomes zero. */ - unsigned int cmdEpoch; /* Incremented to invalidate any references + size_t cmdEpoch; /* Incremented to invalidate any references * that point to this command when it is * renamed, deleted, hidden, or exposed. */ CompileProc *compileProc; /* Procedure called to compile command. NULL @@ -1804,7 +1788,7 @@ typedef struct AllocCache { struct Cache *nextPtr; /* Linked list of cache entries. */ Tcl_ThreadId owner; /* Which thread's cache is this? */ Tcl_Obj *firstObjPtr; /* List of free objects for thread. */ - int numObjects; /* Number of objects for thread. */ + size_t numObjects; /* Number of objects for thread. */ } AllocCache; /* @@ -1818,41 +1802,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,15 +1839,7 @@ typedef struct Interp { void *interpInfo; /* Information used by tclInterp.c to keep * track of parent/child interps on a * per-interp basis. */ - union { - void (*optimizer)(void *envPtr); - Tcl_HashTable unused2; /* No longer used (was mathFuncTable). The - * unused space in interp was repurposed for - * pluggable bytecode optimizers. The core - * contains one optimizer, which can be - * selectively overridden by extensions. */ - } extra; - + void (*optimizer)(void *envPtr); /* * Information related to procedures and variables. See tclProc.c and * tclVar.c for usage. @@ -1903,25 +1869,6 @@ typedef struct Interp { * TCL_EVAL_INVOKE call to Tcl_EvalObjv. */ /* - * Information used by Tcl_AppendResult to keep track of partial results. - * See Tcl_AppendResult code for details. - */ - -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 - char *appendResult; /* Storage space for results generated by - * Tcl_AppendResult. Ckalloc-ed. NULL means - * not yet allocated. */ - int appendAvl; /* Total amount of space available at - * partialResult. */ - int appendUsed; /* Number of non-null bytes currently stored - * at partialResult. */ -#else - char *appendResultDontUse; - int appendAvlDontUse; - int appendUsedDontUse; -#endif - - /* * Information about packages. Used only in tclPkg.c. */ @@ -1937,19 +1884,18 @@ typedef struct Interp { * Miscellaneous information: */ - int cmdCount; /* Total number of times a command procedure + size_t cmdCount; /* Total number of times a command procedure * has been called for this interpreter. */ int evalFlags; /* Flags to control next call to Tcl_Eval. * Normally zero, but may be set before * calling Tcl_Eval. See below for valid * values. */ - int unused1; /* No longer used (was termOffset) */ LiteralTable literalTable; /* Contains LiteralEntry's describing all Tcl * objects holding literals of scripts * compiled by the interpreter. Indexed by the * string representations of literals. Used to * avoid creating duplicate objects. */ - unsigned int compileEpoch; /* Holds the current "compilation epoch" for + size_t compileEpoch; /* Holds the current "compilation epoch" for * this interpreter. This is incremented to * invalidate existing ByteCodes when, e.g., a * command with a compile procedure is @@ -1981,14 +1927,6 @@ typedef struct Interp { * string. Returned by Tcl_ObjSetVar2 when * variable traces change a variable in a * gross way. */ -#if TCL_MAJOR_VERSION < 9 -# if !defined(TCL_NO_DEPRECATED) - char resultSpace[TCL_DSTRING_STATIC_SIZE+1]; - /* Static space holding small results. */ -# else - char resultSpaceDontUse[TCL_DSTRING_STATIC_SIZE+1]; -# endif -#endif Tcl_Obj *objResultPtr; /* If the last command returned an object * result, this points to it. Should not be * accessed directly; see comment above. */ @@ -2031,7 +1969,7 @@ typedef struct Interp { * as flag values the same as the 'active' * field. */ - int cmdCount; /* Limit for how many commands to execute in + size_t cmdCount; /* Limit for how many commands to execute in * the interpreter. */ LimitHandler *cmdHandlers; /* Handlers to execute when the limit is @@ -2067,9 +2005,9 @@ typedef struct Interp { * *root* ensemble command? (Nested ensembles * don't rewrite this.) NULL if we're not * processing an ensemble. */ - int numRemovedObjs; /* How many arguments have been stripped off + size_t numRemovedObjs; /* How many arguments have been stripped off * because of ensemble processing. */ - int numInsertedObjs; /* How many of the current arguments were + size_t numInsertedObjs; /* How many of the current arguments were * inserted by an ensemble. */ } ensembleRewrite; @@ -2386,7 +2324,7 @@ typedef struct Interp { */ #define TclOOM(ptr, size) \ - ((size) && ((ptr)||(Tcl_Panic("unable to alloc %u bytes", (size)),1))) + ((size) && ((ptr)||(Tcl_Panic("unable to alloc %" TCL_Z_MODIFIER "u bytes", (size_t)(size)),1))) /* * The following enum values are used to specify the runtime platform setting @@ -2439,7 +2377,7 @@ typedef enum TclEolTranslation { */ typedef struct List { - unsigned int refCount; + size_t refCount; int maxElemCount; /* Total number of element array slots. */ int elemCount; /* Current number of list elements. */ int canonicalFlag; /* Set if the string representation was @@ -2453,7 +2391,7 @@ typedef struct List { #define LIST_MAX \ (1 + (int)(((size_t)UINT_MAX - sizeof(List))/sizeof(Tcl_Obj *))) #define LIST_SIZE(numElems) \ - (unsigned)(sizeof(List) + (((numElems) - 1) * sizeof(Tcl_Obj *))) + (sizeof(List) + (((numElems) - 1) * sizeof(Tcl_Obj *))) /* * Macro used to get the elements of a list object. @@ -2502,10 +2440,9 @@ typedef struct List { */ #define TclGetBooleanFromObj(interp, objPtr, boolPtr) \ - (((objPtr)->typePtr == &tclIntType) \ + (((objPtr)->typePtr == &tclIntType \ + || (objPtr)->typePtr == &tclBooleanType) \ ? (*(boolPtr) = ((objPtr)->internalRep.wideValue!=0), TCL_OK) \ - : ((objPtr)->typePtr == &tclBooleanType) \ - ? (*(boolPtr) = ((objPtr)->internalRep.longValue!=0), TCL_OK) \ : Tcl_GetBooleanFromObj((interp), (objPtr), (boolPtr))) #ifdef TCL_WIDE_INT_IS_LONG @@ -2530,8 +2467,8 @@ typedef struct List { : Tcl_GetIntFromObj((interp), (objPtr), (intPtr))) #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) \ + && ((Tcl_WideUInt)(objPtr)->internalRep.wideValue <= (size_t)(endValue) + 1)) \ + ? ((*(idxPtr) = (size_t)(objPtr)->internalRep.wideValue), TCL_OK) \ : Tcl_GetIntForIndex((interp), (objPtr), (endValue), (idxPtr))) /* @@ -2589,7 +2526,7 @@ typedef struct List { */ #define TCL_FILESYSTEM_VERSION_2 ((Tcl_FSVersion) 0x2) -typedef ClientData (TclFSGetCwdProc2)(ClientData clientData); +typedef void *(TclFSGetCwdProc2)(void *clientData); typedef int (Tcl_FSLoadFileProc2) (Tcl_Interp *interp, Tcl_Obj *pathPtr, Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr, int flags); @@ -2661,7 +2598,7 @@ typedef Tcl_ObjCmdProc *TclObjCmdProcType; *---------------------------------------------------------------- */ -typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, unsigned int *lengthPtr, +typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, size_t *lengthPtr, Tcl_Encoding *encodingPtr); /* @@ -2673,9 +2610,9 @@ typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, unsigned int *leng */ typedef struct ProcessGlobalValue { - unsigned int epoch; /* Epoch counter to detect changes in the + size_t epoch; /* Epoch counter to detect changes in the * global value. */ - unsigned int numBytes; /* Length of the global string. */ + size_t numBytes; /* Length of the global string. */ char *value; /* The global string value. */ Tcl_Encoding encoding; /* system encoding when global string was * initialized. */ @@ -2721,10 +2658,6 @@ typedef struct ProcessGlobalValue { */ #define TCL_NUMBER_INT 2 -#if (TCL_MAJOR_VERSION < 9) && !defined(TCL_NO_DEPRECATED) -# define TCL_NUMBER_LONG 1 /* deprecated, not used any more */ -# define TCL_NUMBER_WIDE TCL_NUMBER_INT /* deprecated */ -#endif #define TCL_NUMBER_BIG 3 #define TCL_NUMBER_DOUBLE 4 #define TCL_NUMBER_NAN 5 @@ -2750,7 +2683,7 @@ MODULE_SCOPE Tcl_Encoding tclIdentityEncoding; MODULE_SCOPE Tcl_GetTimeProc *tclGetTimeProcPtr; MODULE_SCOPE Tcl_ScaleTimeProc *tclScaleTimeProcPtr; -MODULE_SCOPE ClientData tclTimeClientData; +MODULE_SCOPE void *tclTimeClientData; /* * Variables denoting the Tcl object types defined in the core. @@ -2906,7 +2839,7 @@ struct Tcl_LoadHandle_ { */ 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, @@ -2919,22 +2852,20 @@ 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, CmdFrame **cfPtrPtr, int *wordPtr); 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); @@ -2949,11 +2880,11 @@ MODULE_SCOPE void TclContinuationsEnterDerived(Tcl_Obj *objPtr, 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, - Tcl_ObjCmdProc *proc, ClientData clientData, + Tcl_ObjCmdProc *proc, void *clientData, Tcl_CmdDeleteProc *deleteProc); MODULE_SCOPE Tcl_Command TclCreateEnsembleInNs(Tcl_Interp *interp, const char *name, Tcl_Namespace *nameNamespacePtr, @@ -2962,10 +2893,10 @@ MODULE_SCOPE void TclDeleteNamespaceVars(Namespace *nsPtr); MODULE_SCOPE int TclFindDictElement(Tcl_Interp *interp, const char *dict, int 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, int line, int *clNextOuter, const char *outerScript); MODULE_SCOPE Tcl_ObjCmdProc TclFileAttrsCmd; MODULE_SCOPE Tcl_ObjCmdProc TclFileCopyCmd; @@ -2977,9 +2908,9 @@ MODULE_SCOPE Tcl_ObjCmdProc TclFileRenameCmd; MODULE_SCOPE Tcl_ObjCmdProc TclFileTempDirCmd; MODULE_SCOPE Tcl_ObjCmdProc TclFileTemporaryCmd; MODULE_SCOPE void TclCreateLateExitHandler(Tcl_ExitProc *proc, - ClientData clientData); + void *clientData); MODULE_SCOPE void TclDeleteLateExitHandler(Tcl_ExitProc *proc, - ClientData clientData); + void *clientData); MODULE_SCOPE char * TclDStringAppendObj(Tcl_DString *dsPtr, Tcl_Obj *objPtr); MODULE_SCOPE char * TclDStringAppendDString(Tcl_DString *dsPtr, @@ -3018,7 +2949,7 @@ MODULE_SCOPE int TclFSFileAttrIndex(Tcl_Obj *pathPtr, MODULE_SCOPE Tcl_Command TclNRCreateCommandInNs(Tcl_Interp *interp, const char *cmdName, Tcl_Namespace *nsPtr, Tcl_ObjCmdProc *proc, Tcl_ObjCmdProc *nreProc, - ClientData clientData, + void *clientData, Tcl_CmdDeleteProc *deleteProc); MODULE_SCOPE int TclNREvalFile(Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *encodingName); @@ -3034,7 +2965,7 @@ MODULE_SCOPE int TclGetCompletionCodeFromObj(Tcl_Interp *interp, MODULE_SCOPE Proc * TclGetLambdaFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj **nsObjPtrPtr); MODULE_SCOPE int TclGetNumberFromObj(Tcl_Interp *interp, - Tcl_Obj *objPtr, ClientData *clientDataPtr, + Tcl_Obj *objPtr, void **clientDataPtr, int *typePtr); MODULE_SCOPE int TclGetOpenModeEx(Tcl_Interp *interp, const char *modeString, int *seekFlagPtr, @@ -3043,7 +2974,7 @@ MODULE_SCOPE Tcl_Obj * TclGetProcessGlobalValue(ProcessGlobalValue *pgvPtr); MODULE_SCOPE Tcl_Obj * TclGetSourceFromFrame(CmdFrame *cfPtr, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE char * TclGetStringStorage(Tcl_Obj *objPtr, - unsigned int *sizePtr); + size_t *sizePtr); MODULE_SCOPE int TclGetLoadedPackagesEx(Tcl_Interp *interp, const char *targetName, const char *packageName); @@ -3056,16 +2987,16 @@ MODULE_SCOPE int TclIncrObj(Tcl_Interp *interp, Tcl_Obj *valuePtr, Tcl_Obj *incrPtr); MODULE_SCOPE Tcl_Obj * TclIncrObjVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, int flags); -MODULE_SCOPE int TclInfoExistsCmd(ClientData dummy, Tcl_Interp *interp, +MODULE_SCOPE int TclInfoExistsCmd(void *dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int TclInfoCoroutineCmd(ClientData dummy, Tcl_Interp *interp, +MODULE_SCOPE int TclInfoCoroutineCmd(void *dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE Tcl_Obj * TclInfoFrame(Tcl_Interp *interp, CmdFrame *framePtr); -MODULE_SCOPE int TclInfoGlobalsCmd(ClientData dummy, Tcl_Interp *interp, +MODULE_SCOPE int TclInfoGlobalsCmd(void *dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int TclInfoLocalsCmd(ClientData dummy, Tcl_Interp *interp, +MODULE_SCOPE int TclInfoLocalsCmd(void *dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int TclInfoVarsCmd(ClientData dummy, Tcl_Interp *interp, +MODULE_SCOPE int TclInfoVarsCmd(void *dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE void TclInitAlloc(void); MODULE_SCOPE void TclInitDbCkalloc(void); @@ -3093,8 +3024,8 @@ MODULE_SCOPE Tcl_Obj * TclLindexFlat(Tcl_Interp *interp, Tcl_Obj *listPtr, MODULE_SCOPE void TclListLines(Tcl_Obj *listObj, int line, int n, int *lines, Tcl_Obj *const *elems); MODULE_SCOPE Tcl_Obj * TclListObjCopy(Tcl_Interp *interp, Tcl_Obj *listPtr); -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, @@ -3102,7 +3033,7 @@ MODULE_SCOPE Tcl_Obj * TclLsetFlat(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *valuePtr); MODULE_SCOPE Tcl_Command TclMakeEnsemble(Tcl_Interp *interp, const char *name, const EnsembleImplMap map[]); -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, @@ -3120,22 +3051,22 @@ 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); 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 int TclpDeleteFile(const void *path); MODULE_SCOPE void TclpFinalizeCondition(Tcl_Condition *condPtr); MODULE_SCOPE void TclpFinalizeMutex(Tcl_Mutex *mutexPtr); @@ -3146,11 +3077,11 @@ MODULE_SCOPE int TclCreateSocketAddress(Tcl_Interp *interp, const char *host, int port, int willBind, const char **errorMsgPtr); MODULE_SCOPE int TclpThreadCreate(Tcl_ThreadId *idPtr, - Tcl_ThreadCreateProc *proc, ClientData clientData, - int stackSize, int flags); -MODULE_SCOPE int TclpFindVariable(const char *name, int *lengthPtr); + Tcl_ThreadCreateProc *proc, void *clientData, + size_t stackSize, int flags); +MODULE_SCOPE size_t TclpFindVariable(const char *name, size_t *lengthPtr); MODULE_SCOPE void TclpInitLibraryPath(char **valuePtr, - unsigned int *lengthPtr, Tcl_Encoding *encodingPtr); + size_t *lengthPtr, Tcl_Encoding *encodingPtr); MODULE_SCOPE void TclpInitLock(void); MODULE_SCOPE void TclpInitPlatform(void); MODULE_SCOPE void TclpInitUnlock(void); @@ -3170,7 +3101,7 @@ MODULE_SCOPE int TclCrossFilesystemCopy(Tcl_Interp *interp, MODULE_SCOPE int TclpMatchInDirectory(Tcl_Interp *interp, Tcl_Obj *resultPtr, Tcl_Obj *pathPtr, const char *pattern, Tcl_GlobTypeData *types); -MODULE_SCOPE ClientData TclpGetNativeCwd(ClientData 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); @@ -3194,9 +3125,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 int TclScanElement(const char *string, int length, +MODULE_SCOPE size_t TclScanElement(const char *string, size_t length, char *flagPtr); MODULE_SCOPE void TclSetBgErrorHandler(Tcl_Interp *interp, Tcl_Obj *cmdPrefix); @@ -3211,44 +3142,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, int 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, int line, struct CompileEnv *envPtr); MODULE_SCOPE int TclSubstOptions(Tcl_Interp *interp, int 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, 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) @@ -3262,7 +3193,7 @@ MODULE_SCOPE int TclUtfCount(int ch); ? ((length) >= 4) : Tcl_UtfCharComplete((src), (length))) # define TclChar16Complete Tcl_UtfCharComplete #endif -MODULE_SCOPE Tcl_Obj * TclpNativeToNormalized(ClientData clientData); +MODULE_SCOPE Tcl_Obj * TclpNativeToNormalized(void *clientData); MODULE_SCOPE Tcl_Obj * TclpFilesystemPathType(Tcl_Obj *pathPtr); MODULE_SCOPE int TclpDlopen(Tcl_Interp *interp, Tcl_Obj *pathPtr, Tcl_LoadHandle *loadHandle, @@ -3278,13 +3209,6 @@ MODULE_SCOPE void TclInitThreadStorage(void); MODULE_SCOPE void TclFinalizeThreadDataThread(void); MODULE_SCOPE void TclFinalizeThreadStorage(void); -/* TclWideMUInt -- wide integer used for measurement calculations: */ -#if (!defined(_WIN32) || !defined(_MSC_VER) || (_MSC_VER >= 1400)) -# define TclWideMUInt Tcl_WideUInt -#else -/* older MSVS may not allow conversions between unsigned __int64 and double) */ -# define TclWideMUInt Tcl_WideInt -#endif #ifdef TCL_WIDE_CLICKS MODULE_SCOPE Tcl_WideInt TclpGetWideClicks(void); MODULE_SCOPE double TclpWideClicksToNanoseconds(Tcl_WideInt clicks); @@ -3306,7 +3230,7 @@ MODULE_SCOPE void TclpThreadDeleteKey(void *keyPtr); MODULE_SCOPE void TclpThreadSetGlobalTSD(void *tsdKeyPtr, void *ptr); MODULE_SCOPE void * TclpThreadGetGlobalTSD(void *tsdKeyPtr); MODULE_SCOPE void TclErrorStackResetIf(Tcl_Interp *interp, - const char *msg, int length); + const char *msg, size_t length); /* Tip 430 */ MODULE_SCOPE int TclZipfs_Init(Tcl_Interp *interp); @@ -3327,60 +3251,55 @@ MODULE_SCOPE int TclIsSpaceProc(int byte); *---------------------------------------------------------------- */ -MODULE_SCOPE int Tcl_AfterObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_AfterObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_AppendObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_AppendObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_ApplyObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_ApplyObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE Tcl_Command TclInitArrayCmd(Tcl_Interp *interp); MODULE_SCOPE Tcl_Command TclInitBinaryCmd(Tcl_Interp *interp); -MODULE_SCOPE int Tcl_BreakObjCmd(ClientData clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 -MODULE_SCOPE int Tcl_CaseObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_BreakObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -#endif -MODULE_SCOPE int Tcl_CatchObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_CatchObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_CdObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_CdObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE Tcl_Command TclInitChanCmd(Tcl_Interp *interp); -MODULE_SCOPE int TclChanCreateObjCmd(ClientData clientData, +MODULE_SCOPE int TclChanCreateObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int TclChanPostEventObjCmd(ClientData clientData, +MODULE_SCOPE int TclChanPostEventObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int TclChanPopObjCmd(ClientData clientData, +MODULE_SCOPE int TclChanPopObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int TclChanPushObjCmd(ClientData clientData, +MODULE_SCOPE int TclChanPushObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE void TclClockInit(Tcl_Interp *interp); MODULE_SCOPE int TclClockOldscanObjCmd( void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_CloseObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_CloseObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_ConcatObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_ConcatObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_ContinueObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_ContinueObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE Tcl_TimerToken TclCreateAbsoluteTimerHandler( Tcl_Time *timePtr, Tcl_TimerProc *proc, - ClientData clientData); + void *clientData); MODULE_SCOPE int TclDefaultBgErrorHandlerObjCmd( - ClientData clientData, Tcl_Interp *interp, + void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE Tcl_Command TclInitDictCmd(Tcl_Interp *interp); MODULE_SCOPE int TclDictWithFinish(Tcl_Interp *interp, Var *varPtr, @@ -3389,236 +3308,236 @@ MODULE_SCOPE int TclDictWithFinish(Tcl_Interp *interp, Var *varPtr, Tcl_Obj *const pathv[], Tcl_Obj *keysPtr); MODULE_SCOPE Tcl_Obj * TclDictWithInit(Tcl_Interp *interp, Tcl_Obj *dictPtr, int pathc, Tcl_Obj *const pathv[]); -MODULE_SCOPE int Tcl_DisassembleObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_DisassembleObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* Assemble command function */ -MODULE_SCOPE int Tcl_AssembleObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_AssembleObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int TclNRAssembleObjCmd(ClientData clientData, +MODULE_SCOPE int TclNRAssembleObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE Tcl_Command TclInitEncodingCmd(Tcl_Interp *interp); -MODULE_SCOPE int Tcl_EofObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_EofObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_ErrorObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_ErrorObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_EvalObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_EvalObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_ExecObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_ExecObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_ExitObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_ExitObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_ExprObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_ExprObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_FblockedObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_FblockedObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_FconfigureObjCmd( - ClientData clientData, Tcl_Interp *interp, + void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_FcopyObjCmd(ClientData dummy, +MODULE_SCOPE int Tcl_FcopyObjCmd(void *dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE Tcl_Command TclInitFileCmd(Tcl_Interp *interp); -MODULE_SCOPE int Tcl_FileEventObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_FileEventObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_FlushObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_FlushObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_ForObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_ForObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_ForeachObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_ForeachObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_FormatObjCmd(ClientData dummy, +MODULE_SCOPE int Tcl_FormatObjCmd(void *dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_GetsObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_GetsObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_GlobalObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_GlobalObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_GlobObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_GlobObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_IfObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_IfObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_IncrObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_IncrObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE Tcl_Command TclInitInfoCmd(Tcl_Interp *interp); -MODULE_SCOPE int Tcl_InterpObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_InterpObjCmd(void *clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_JoinObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_JoinObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_LappendObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_LappendObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_LassignObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_LassignObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_LindexObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_LindexObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_LinsertObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_LinsertObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_LlengthObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_LlengthObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_ListObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_ListObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_LmapObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_LmapObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_LoadObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_LoadObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_LpopObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_LpopObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_LrangeObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_LrangeObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_LremoveObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_LremoveObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_LrepeatObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_LrepeatObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_LreplaceObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_LreplaceObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_LreverseObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_LreverseObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_LsearchObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_LsearchObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_LsetObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_LsetObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_LsortObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_LsortObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE Tcl_Command TclInitNamespaceCmd(Tcl_Interp *interp); -MODULE_SCOPE int TclNamespaceEnsembleCmd(ClientData dummy, +MODULE_SCOPE int TclNamespaceEnsembleCmd(void *dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_OpenObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_OpenObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_PackageObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_PackageObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_PidObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_PidObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE Tcl_Command TclInitPrefixCmd(Tcl_Interp *interp); -MODULE_SCOPE int Tcl_PutsObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_PutsObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_PwdObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_PwdObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_ReadObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_ReadObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_RegexpObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_RegexpObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_RegsubObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_RegsubObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_RenameObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_RenameObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_RepresentationCmd(ClientData clientData, +MODULE_SCOPE int Tcl_RepresentationCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_ReturnObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_ReturnObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_ScanObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_ScanObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_SeekObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_SeekObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_SetObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_SetObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_SplitObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_SplitObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_SocketObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_SocketObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_SourceObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_SourceObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE Tcl_Command TclInitStringCmd(Tcl_Interp *interp); -MODULE_SCOPE int Tcl_SubstObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_SubstObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_SwitchObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_SwitchObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_TellObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_TellObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_ThrowObjCmd(ClientData dummy, Tcl_Interp *interp, +MODULE_SCOPE int Tcl_ThrowObjCmd(void *dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_TimeObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_TimeObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_TimeRateObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_TimeRateObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_TraceObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_TraceObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_TryObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_TryObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_UnloadObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_UnloadObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_UnsetObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_UnsetObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_UpdateObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_UpdateObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_UplevelObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_UplevelObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_UpvarObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_UpvarObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_VariableObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_VariableObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_VwaitObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_VwaitObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_WhileObjCmd(ClientData clientData, +MODULE_SCOPE int Tcl_WhileObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); @@ -3950,103 +3869,103 @@ MODULE_SCOPE int TclCompileBasicMin2ArgCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclInvertOpCmd(ClientData clientData, +MODULE_SCOPE int TclInvertOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileInvertOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclNotOpCmd(ClientData clientData, +MODULE_SCOPE int TclNotOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileNotOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclAddOpCmd(ClientData clientData, +MODULE_SCOPE int TclAddOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileAddOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclMulOpCmd(ClientData clientData, +MODULE_SCOPE int TclMulOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileMulOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclAndOpCmd(ClientData clientData, +MODULE_SCOPE int TclAndOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileAndOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclOrOpCmd(ClientData clientData, +MODULE_SCOPE int TclOrOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileOrOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclXorOpCmd(ClientData clientData, +MODULE_SCOPE int TclXorOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileXorOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclPowOpCmd(ClientData clientData, +MODULE_SCOPE int TclPowOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompilePowOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclLshiftOpCmd(ClientData clientData, +MODULE_SCOPE int TclLshiftOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileLshiftOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclRshiftOpCmd(ClientData clientData, +MODULE_SCOPE int TclRshiftOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileRshiftOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclModOpCmd(ClientData clientData, +MODULE_SCOPE int TclModOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileModOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclNeqOpCmd(ClientData clientData, +MODULE_SCOPE int TclNeqOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileNeqOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclStrneqOpCmd(ClientData clientData, +MODULE_SCOPE int TclStrneqOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileStrneqOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclInOpCmd(ClientData clientData, +MODULE_SCOPE int TclInOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileInOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclNiOpCmd(ClientData clientData, +MODULE_SCOPE int TclNiOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileNiOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclMinusOpCmd(ClientData clientData, +MODULE_SCOPE int TclMinusOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileMinusOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclDivOpCmd(ClientData clientData, +MODULE_SCOPE int TclDivOpCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileDivOpCmd(Tcl_Interp *interp, @@ -4095,13 +4014,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); @@ -4166,6 +4085,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. */ @@ -4201,7 +4133,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] */ @@ -4215,12 +4147,12 @@ 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); /* Constants used in index value encoding routines. */ -#define TCL_INDEX_END (-2) -#define TCL_INDEX_START (0) +#define TCL_INDEX_END ((size_t)-2) +#define TCL_INDEX_START ((size_t)0) /* *---------------------------------------------------------------- @@ -4287,7 +4219,7 @@ MODULE_SCOPE int TclIndexDecode(int encoded, int endValue); /* * 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'. + * 'length == TCL_INDEX_NONE'. * Use empty 'if ; else' to handle use in unbraced outer if/else conditions. */ @@ -4297,9 +4229,9 @@ MODULE_SCOPE int TclIndexDecode(int encoded, int endValue); TCL_DTRACE_OBJ_FREE(objPtr); \ if ((objPtr)->bytes \ && ((objPtr)->bytes != &tclEmptyString)) { \ - ckfree((objPtr)->bytes); \ + Tcl_Free((objPtr)->bytes); \ } \ - (objPtr)->length = -1; \ + (objPtr)->length = TCL_INDEX_NONE; \ TclFreeObjStorage(objPtr); \ TclIncrObjsFreed(); \ } else { \ @@ -4321,10 +4253,10 @@ MODULE_SCOPE int TclIndexDecode(int encoded, int endValue); */ # 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 @@ -4452,7 +4384,7 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file, * is referenced multiple times, it should be as simple an expression as * possible. The ANSI C "prototype" for this macro is: * - * MODULE_SCOPE void TclInitStringRep(Tcl_Obj *objPtr, char *bytePtr, int len); + * MODULE_SCOPE void TclInitStringRep(Tcl_Obj *objPtr, char *bytePtr, size_t len); * * This macro should only be called on an unshared objPtr where * objPtr->typePtr->freeIntRepProc == NULL @@ -4464,7 +4396,7 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file, (objPtr)->bytes = &tclEmptyString; \ (objPtr)->length = 0; \ } else { \ - (objPtr)->bytes = (char *) ckalloc((len) + 1); \ + (objPtr)->bytes = (char *)Tcl_Alloc((len) + 1); \ memcpy((objPtr)->bytes, (bytePtr) ? (bytePtr) : &tclEmptyString, (len)); \ (objPtr)->bytes[len] = '\0'; \ (objPtr)->length = (len); \ @@ -4485,10 +4417,38 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file, #define TclGetString(objPtr) \ ((objPtr)->bytes? (objPtr)->bytes : Tcl_GetString(objPtr)) +#if 0 + static inline char *TclGetStringFromObj(Tcl_Obj *objPtr, size_t *lenPtr) { + char *response = Tcl_GetString(objPtr); + *(lenPtr) = objPtr->length; + return response; + } + static inline Tcl_UniChar *TclGetUnicodeFromObj(Tcl_Obj *objPtr, size_t *lenPtr) { + Tcl_UniChar *response = Tcl_GetUnicodeFromObj(objPtr, NULL); + *(lenPtr) = *((size_t *) (objPtr)->internalRep.twoPtrValue.ptr1); + return response; + } + static inline unsigned char *TclGetByteArrayFromObj(Tcl_Obj *objPtr, size_t *lenPtr) { + unsigned char *response = Tcl_GetByteArrayFromObj(objPtr, NULL); + if (response) { + *(lenPtr) = *((size_t *) (objPtr)->internalRep.twoPtrValue.ptr1 + 1); + } + return response; + } +#else #define TclGetStringFromObj(objPtr, lenPtr) \ - ((objPtr)->bytes \ - ? (*(lenPtr) = (objPtr)->length, (objPtr)->bytes) \ - : Tcl_GetStringFromObj((objPtr), (lenPtr))) + (((objPtr)->bytes \ + ? NULL : Tcl_GetString((objPtr)), \ + *(lenPtr) = (objPtr)->length, (objPtr)->bytes)) +#define TclGetUnicodeFromObj(objPtr, lenPtr) \ + (Tcl_GetUnicodeFromObj((objPtr), NULL), \ + *(lenPtr) = *((size_t *) (objPtr)->internalRep.twoPtrValue.ptr1), \ + Tcl_GetUnicodeFromObj((objPtr), NULL)) +#define TclGetByteArrayFromObj(objPtr, lenPtr) \ + (Tcl_GetByteArrayFromObj((objPtr), NULL) ? \ + (*(lenPtr) = *((size_t *) (objPtr)->internalRep.twoPtrValue.ptr1 + 1), \ + (unsigned char *)(((size_t *) (objPtr)->internalRep.twoPtrValue.ptr1) + 3)) : NULL) +#endif /* *---------------------------------------------------------------- @@ -4522,7 +4482,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; \ } \ @@ -4628,20 +4588,20 @@ MODULE_SCOPE const TclFileAttrProcs tclpFileAttrProcs[]; if (allocated > TCL_MAX_TOKENS) { \ allocated = TCL_MAX_TOKENS; \ } \ - newPtr = (Tcl_Token *) attemptckrealloc((char *) oldPtr, \ - allocated * sizeof(Tcl_Token)); \ + 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, \ - allocated * sizeof(Tcl_Token)); \ + newPtr = (Tcl_Token *) Tcl_Realloc((char *) oldPtr, \ + (allocated * sizeof(Tcl_Token))); \ } \ (available) = allocated; \ if (oldPtr == NULL) { \ memcpy(newPtr, staticPtr, \ - (used) * sizeof(Tcl_Token)); \ + ((used) * sizeof(Tcl_Token))); \ } \ (tokenPtr) = newPtr; \ } \ @@ -4684,13 +4644,13 @@ MODULE_SCOPE const TclFileAttrProcs tclpFileAttrProcs[]; * "prototype" for this macro is: * * MODULE_SCOPE void TclNumUtfChars(int numChars, const char *bytes, - * int numBytes); + * size_t numBytes); *---------------------------------------------------------------- */ #define TclNumUtfChars(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; \ @@ -4743,8 +4703,6 @@ MODULE_SCOPE int TclIsPureByteArray(Tcl_Obj *objPtr); #ifdef WORDS_BIGENDIAN # define TclUniCharNcmp(cs,ct,n) memcmp((cs),(ct),(n)*sizeof(Tcl_UniChar)) -#else /* !WORDS_BIGENDIAN */ -# define TclUniCharNcmp Tcl_UniCharNcmp #endif /* WORDS_BIGENDIAN */ /* @@ -4838,7 +4796,7 @@ MODULE_SCOPE Tcl_PackageInitProc 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); * *---------------------------------------------------------------- @@ -4856,6 +4814,18 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; TCL_DTRACE_OBJ_CREATE(objPtr); \ } while (0) +#define TclNewIndexObj(objPtr, w) \ + do { \ + size_t _w = (w); \ + TclIncrObjsAllocated(); \ + TclAllocObjStorage(objPtr); \ + (objPtr)->refCount = 0; \ + (objPtr)->bytes = NULL; \ + (objPtr)->internalRep.wideValue = ((_w) == TCL_INDEX_NONE) ? -1 : (Tcl_WideInt)(_w); \ + (objPtr)->typePtr = &tclIntType; \ + TCL_DTRACE_OBJ_CREATE(objPtr); \ + } while (0) + #define TclNewDoubleObj(objPtr, d) \ do { \ TclIncrObjsAllocated(); \ @@ -4881,6 +4851,9 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; #define TclNewIntObj(objPtr, w) \ (objPtr) = Tcl_NewWideIntObj(w) +#define TclNewIndexObj(objPtr, w) \ + (objPtr) = ((w) == TCL_INDEX_NONE) ? Tcl_NewWideIntObj(-1) : Tcl_NewWideIntObj(w) + #define TclNewDoubleObj(objPtr, d) \ (objPtr) = Tcl_NewDoubleObj(d) @@ -4893,7 +4866,7 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; * sizeof(sLiteral "") will fail to compile otherwise. */ #define TclNewLiteralStringObj(objPtr, sLiteral) \ - TclNewStringObj((objPtr), (sLiteral), (int) (sizeof(sLiteral "") - 1)) + TclNewStringObj((objPtr), (sLiteral), sizeof(sLiteral "") - 1) /* *---------------------------------------------------------------- @@ -4906,7 +4879,7 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; */ #define TclDStringAppendLiteral(dsPtr, sLiteral) \ - Tcl_DStringAppend((dsPtr), (sLiteral), (int) (sizeof(sLiteral "") - 1)) + Tcl_DStringAppend((dsPtr), (sLiteral), sizeof(sLiteral "") - 1) #define TclDStringClear(dsPtr) \ Tcl_DStringSetLength((dsPtr), 0) @@ -4931,14 +4904,6 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; # endif #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)) @@ -4964,7 +4929,7 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; #define TclCleanupCommandMacro(cmdPtr) \ do { \ if ((cmdPtr)->refCount-- <= 1) { \ - ckfree(cmdPtr); \ + Tcl_Free(cmdPtr); \ } \ } while (0) @@ -4977,7 +4942,7 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; (cmdPtr)->refCount++; \ if ((location) != NULL \ && (location--) <= 1) { \ - ckfree(((location))); \ + Tcl_Free(((location))); \ } \ (location) = (cmdPtr); \ } while (0) @@ -5052,7 +5017,7 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; #define TclSmallFreeEx(interp, memPtr) \ do { \ - TclFreeObjStorageEx((interp), (Tcl_Obj *) (memPtr)); \ + TclFreeObjStorageEx((interp), (Tcl_Obj *)memPtr); \ TclIncrObjsFreed(); \ } while (0) @@ -5111,7 +5076,7 @@ void Tcl_Panic(const char *, ...) __attribute__((analyzer_noreturn)); typedef struct NRE_callback { Tcl_NRPostProc *procPtr; - ClientData data[4]; + void *data[4]; struct NRE_callback *nextPtr; } NRE_callback; @@ -5126,10 +5091,10 @@ typedef struct NRE_callback { NRE_callback *_callbackPtr; \ TCLNR_ALLOC((interp), (_callbackPtr)); \ _callbackPtr->procPtr = (postProcPtr); \ - _callbackPtr->data[0] = (ClientData)(data0); \ - _callbackPtr->data[1] = (ClientData)(data1); \ - _callbackPtr->data[2] = (ClientData)(data2); \ - _callbackPtr->data[3] = (ClientData)(data3); \ + _callbackPtr->data[0] = (void *)(data0); \ + _callbackPtr->data[1] = (void *)(data1); \ + _callbackPtr->data[2] = (void *)(data2); \ + _callbackPtr->data[3] = (void *)(data3); \ _callbackPtr->nextPtr = TOP_CB(interp); \ TOP_CB(interp) = _callbackPtr; \ } while (0) @@ -5140,8 +5105,8 @@ typedef struct NRE_callback { #define TCLNR_FREE(interp, ptr) TclSmallFreeEx((interp), (ptr)) #else #define TCLNR_ALLOC(interp, ptr) \ - (ptr = ((ClientData) 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 @@ -5154,9 +5119,9 @@ typedef struct NRE_callback { #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 #endif /* _TCLINT */ diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index 71d9f5c..e870aac 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 @@ -72,13 +55,9 @@ EXTERN int TclCleanupChildren(Tcl_Interp *interp, int numPids, /* 6 */ EXTERN void TclCleanupCommand(Command *cmdPtr); /* 7 */ -EXTERN int TclCopyAndCollapse(int count, const char *src, +EXTERN size_t TclCopyAndCollapse(size_t 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, const char **argv, Tcl_Pid **pidArrayPtr, @@ -96,7 +75,7 @@ EXTERN void TclDeleteVars(Interp *iPtr, TclVarHashTable *tablePtr); /* Slot 13 is reserved */ /* 14 */ -EXTERN int TclDumpMemoryInfo(ClientData clientData, int flags); +EXTERN int TclDumpMemoryInfo(void *clientData, int flags); /* Slot 15 is reserved */ /* 16 */ EXTERN void TclExprFloatError(Tcl_Interp *interp, double value); @@ -109,12 +88,12 @@ EXTERN void TclExprFloatError(Tcl_Interp *interp, double value); EXTERN int TclFindElement(Tcl_Interp *interp, const char *listStr, int listLength, const char **elementPtr, - const char **nextPtr, int *sizePtr, + const char **nextPtr, size_t *sizePtr, int *bracePtr); /* 23 */ EXTERN Proc * TclFindProc(Interp *iPtr, const char *procName); /* 24 */ -EXTERN int TclFormatInt(char *buffer, Tcl_WideInt n); +EXTERN size_t TclFormatInt(char *buffer, Tcl_WideInt n); /* 25 */ EXTERN void TclFreePackageInfo(Interp *iPtr); /* Slot 26 is reserved */ @@ -129,15 +108,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, @@ -153,12 +127,10 @@ EXTERN int TclGetOpenMode(Tcl_Interp *interp, const char *str, /* 41 */ EXTERN Tcl_Command TclGetOriginalCommand(Tcl_Command command); /* 42 */ -EXTERN CONST86 char * TclpGetUserHome(const char *name, +EXTERN const char * TclpGetUserHome(const char *name, Tcl_DString *bufferPtr); /* Slot 43 is reserved */ -/* 44 */ -EXTERN int TclGuessPackageName(const char *fileName, - Tcl_DString *bufPtr); +/* Slot 44 is reserved */ /* 45 */ EXTERN int TclHideUnsafeCommands(Tcl_Interp *interp); /* 46 */ @@ -166,18 +138,16 @@ 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 */ /* 53 */ -EXTERN int TclInvokeObjectCommand(ClientData clientData, +EXTERN int TclInvokeObjectCommand(void *clientData, Tcl_Interp *interp, int argc, const char **argv); /* 54 */ -EXTERN int TclInvokeStringCommand(ClientData clientData, +EXTERN int TclInvokeStringCommand(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 55 */ @@ -197,7 +167,7 @@ EXTERN Tcl_Obj * TclNewProcBodyObj(Proc *procPtr); /* 62 */ EXTERN int TclObjCommandComplete(Tcl_Obj *cmdPtr); /* 63 */ -EXTERN int TclObjInterpProc(ClientData clientData, +EXTERN int TclObjInterpProc(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 64 */ @@ -208,7 +178,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(size_t size); /* Slot 70 is reserved */ /* Slot 71 is reserved */ /* Slot 72 is reserved */ @@ -216,28 +186,22 @@ EXTERN void * TclpAlloc(unsigned int size); /* 74 */ EXTERN void TclpFree(void *ptr); /* 75 */ -EXTERN unsigned long TclpGetClicks(void); +EXTERN Tcl_WideUInt TclpGetClicks(void); /* 76 */ -EXTERN unsigned long TclpGetSeconds(void); -/* 77 */ -TCL_DEPRECATED("") -void TclpGetTime(Tcl_Time *time); +EXTERN Tcl_WideUInt 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, size_t 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(ClientData 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); @@ -250,7 +214,7 @@ EXTERN int TclProcCompileProc(Tcl_Interp *interp, Proc *procPtr, const char *description, const char *procName); /* 93 */ -EXTERN void TclProcDeleteProc(ClientData clientData); +EXTERN void TclProcDeleteProc(void *clientData); /* Slot 94 is reserved */ /* Slot 95 is reserved */ /* 96 */ @@ -264,15 +228,13 @@ EXTERN int TclServiceIdle(void); /* Slot 99 is reserved */ /* Slot 100 is reserved */ /* 101 */ -EXTERN CONST86 char * TclSetPreInitScript(const char *string); +EXTERN const char * TclSetPreInitScript(const char *string); /* 102 */ EXTERN void TclSetupEnv(Tcl_Interp *interp); /* 103 */ EXTERN int TclSockGetPort(Tcl_Interp *interp, const char *str, const char *proto, int *portPtr); -/* 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 */ @@ -288,25 +250,12 @@ EXTERN void Tcl_AddInterpResolvers(Tcl_Interp *interp, 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, ClientData clientData, - Tcl_NamespaceDeleteProc *deleteProc); -/* 114 */ -EXTERN void TclDeleteNamespace(Tcl_Namespace *nsPtr); -/* 115 */ -EXTERN int TclExport(Tcl_Interp *interp, Tcl_Namespace *nsPtr, - const char *pattern, int resetListFirst); -/* 116 */ -EXTERN Tcl_Command TclFindCommand(Tcl_Interp *interp, const char *name, - Tcl_Namespace *contextNsPtr, int flags); -/* 117 */ -EXTERN Tcl_Namespace * TclFindNamespace(Tcl_Interp *interp, - const char *name, - Tcl_Namespace *contextNsPtr, int flags); +/* 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); @@ -318,25 +267,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 */ @@ -354,9 +293,7 @@ EXTERN void Tcl_SetNamespaceResolvers( Tcl_ResolveCompiledVarProc *compiledVarProc); /* 132 */ EXTERN int TclpHasSockets(Tcl_Interp *interp); -/* 133 */ -TCL_DEPRECATED("") -struct tm * TclpGetDate(const time_t *time, int useGMT); +/* Slot 133 is reserved */ /* Slot 134 is reserved */ /* Slot 135 is reserved */ /* Slot 136 is reserved */ @@ -370,7 +307,7 @@ EXTERN const char * TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr); /* 142 */ EXTERN int TclSetByteCodeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr, CompileHookProc *hookProc, - ClientData clientData); + void *clientData); /* 143 */ EXTERN int TclAddLiteralObj(struct CompileEnv *envPtr, Tcl_Obj *objPtr, LiteralEntry **litPtrPtr); @@ -390,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, size_t index, + size_t *startPtr, size_t *endPtr); /* 152 */ EXTERN void TclSetLibraryPath(Tcl_Obj *pathPtr); /* 153 */ @@ -404,18 +341,14 @@ 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, Tcl_Channel chan, Tcl_Obj *cmdObjPtr); /* 162 */ -EXTERN void TclChannelEventScriptInvoker(ClientData clientData, +EXTERN void TclChannelEventScriptInvoker(void *clientData, int flags); /* 163 */ EXTERN const void * TclGetInstructionTable(void); @@ -427,31 +360,27 @@ EXTERN void TclpSetInitialEncodings(void); EXTERN int TclListObjSetElement(Tcl_Interp *interp, Tcl_Obj *listPtr, int 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, size_t numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]); /* 171 */ EXTERN int TclCheckExecutionTraces(Tcl_Interp *interp, - const char *command, int numChars, + const char *command, size_t numChars, Command *cmdPtr, int result, int traceFlags, int 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); + size_t strLen, const Tcl_UniChar *pattern, + size_t ptnLen, int flags); /* Slot 174 is reserved */ /* 175 */ EXTERN int TclCallVarTraces(Interp *iPtr, Var *arrayPtr, @@ -464,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 */ @@ -529,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, size_t numBytes); /* 216 */ EXTERN void TclStackFree(Tcl_Interp *interp, void *freePtr); /* 217 */ @@ -553,7 +475,7 @@ EXTERN Tcl_Obj * TclTraceDictPath(Tcl_Interp *interp, /* 226 */ EXTERN int TclObjBeingDeleted(Tcl_Obj *objPtr); /* 227 */ -EXTERN void TclSetNsPath(Namespace *nsPtr, int pathLength, +EXTERN void TclSetNsPath(Namespace *nsPtr, size_t pathLength, Tcl_Namespace *pathAry[]); /* Slot 228 is reserved */ /* 229 */ @@ -579,15 +501,12 @@ 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 */ -EXTERN int TclNRInterpProc(ClientData clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); +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, @@ -610,7 +529,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, + size_t numRemoved, size_t numInserted, Tcl_Obj *const *objv); /* 247 */ EXTERN void TclResetRewriteEnsemble(Tcl_Interp *interp, @@ -627,7 +546,7 @@ EXTERN void TclSetChildCancelFlags(Tcl_Interp *interp, int flags, int force); /* 251 */ EXTERN int TclRegisterLiteral(void *envPtr, const char *bytes, - int length, int flags); + size_t length, int flags); /* 252 */ EXTERN Tcl_Obj * TclPtrGetVar(Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, @@ -659,10 +578,11 @@ EXTERN void TclStaticPackage(Tcl_Interp *interp, EXTERN Tcl_Obj * TclpCreateTemporaryDirectory(Tcl_Obj *dirObj, Tcl_Obj *basenameObj); /* 259 */ -EXTERN unsigned char * TclGetBytesFromObj(Tcl_Interp *interp, - Tcl_Obj *objPtr, int *lengthPtr); +EXTERN void TclAppendUnicodeToObj(Tcl_Obj *objPtr, + const Tcl_UniChar *unicode, size_t length); /* 260 */ -EXTERN void TclUnusedStubEntry(void); +EXTERN unsigned char * TclGetBytesFromObj(Tcl_Interp *interp, + Tcl_Obj *objPtr, size_t *lengthPtr); typedef struct TclIntStubs { int magic; @@ -675,14 +595,14 @@ typedef struct TclIntStubs { void (*reserved4)(void); int (*tclCleanupChildren) (Tcl_Interp *interp, int numPids, Tcl_Pid *pidPtr, Tcl_Channel errorChan); /* 5 */ void (*tclCleanupCommand) (Command *cmdPtr); /* 6 */ - int (*tclCopyAndCollapse) (int count, const char *src, char *dst); /* 7 */ - TCL_DEPRECATED_API("") int (*tclCopyChannelOld) (Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr); /* 8 */ + size_t (*tclCopyAndCollapse) (size_t count, const char *src, char *dst); /* 7 */ + void (*reserved8)(void); int (*tclCreatePipeline) (Tcl_Interp *interp, int argc, const char **argv, Tcl_Pid **pidArrayPtr, TclFile *inPipePtr, TclFile *outPipePtr, TclFile *errFilePtr); /* 9 */ int (*tclCreateProc) (Tcl_Interp *interp, Namespace *nsPtr, const char *procName, Tcl_Obj *argsPtr, Tcl_Obj *bodyPtr, Proc **procPtrPtr); /* 10 */ void (*tclDeleteCompiledLocalVars) (Interp *iPtr, CallFrame *framePtr); /* 11 */ void (*tclDeleteVars) (Interp *iPtr, TclVarHashTable *tablePtr); /* 12 */ void (*reserved13)(void); - int (*tclDumpMemoryInfo) (ClientData clientData, int flags); /* 14 */ + int (*tclDumpMemoryInfo) (void *clientData, int flags); /* 14 */ void (*reserved15)(void); void (*tclExprFloatError) (Tcl_Interp *interp, double value); /* 16 */ void (*reserved17)(void); @@ -690,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, int listLength, const char **elementPtr, const char **nextPtr, size_t *sizePtr, int *bracePtr); /* 22 */ Proc * (*tclFindProc) (Interp *iPtr, const char *procName); /* 23 */ - int (*tclFormatInt) (char *buffer, Tcl_WideInt n); /* 24 */ + size_t (*tclFormatInt) (char *buffer, Tcl_WideInt n); /* 24 */ void (*tclFreePackageInfo) (Interp *iPtr); /* 25 */ void (*reserved26)(void); void (*reserved27)(void); @@ -702,27 +622,27 @@ 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 */ TclObjCmdProcType (*tclGetObjInterpProc) (void); /* 39 */ int (*tclGetOpenMode) (Tcl_Interp *interp, const char *str, int *seekFlagPtr); /* 40 */ Tcl_Command (*tclGetOriginalCommand) (Tcl_Command command); /* 41 */ - CONST86 char * (*tclpGetUserHome) (const char *name, Tcl_DString *bufferPtr); /* 42 */ + const char * (*tclpGetUserHome) (const char *name, Tcl_DString *bufferPtr); /* 42 */ void (*reserved43)(void); - int (*tclGuessPackageName) (const char *fileName, Tcl_DString *bufPtr); /* 44 */ + 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) (ClientData clientData, Tcl_Interp *interp, int argc, const char **argv); /* 53 */ - int (*tclInvokeStringCommand) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 54 */ + int (*tclInvokeObjectCommand) (void *clientData, Tcl_Interp *interp, int argc, const char **argv); /* 53 */ + int (*tclInvokeStringCommand) (void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 54 */ Proc * (*tclIsProc) (Command *cmdPtr); /* 55 */ void (*reserved56)(void); void (*reserved57)(void); @@ -731,37 +651,37 @@ typedef struct TclIntStubs { int (*tclNeedSpace) (const char *start, const char *end); /* 60 */ Tcl_Obj * (*tclNewProcBodyObj) (Proc *procPtr); /* 61 */ int (*tclObjCommandComplete) (Tcl_Obj *cmdPtr); /* 62 */ - int (*tclObjInterpProc) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 63 */ + int (*tclObjInterpProc) (void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 63 */ int (*tclObjInvoke) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags); /* 64 */ void (*reserved65)(void); void (*reserved66)(void); void (*reserved67)(void); void (*reserved68)(void); - void * (*tclpAlloc) (unsigned int size); /* 69 */ + void * (*tclpAlloc) (size_t 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 */ + Tcl_WideUInt (*tclpGetClicks) (void); /* 75 */ + Tcl_WideUInt (*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, size_t 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) (ClientData 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 */ int (*tclProcCompileProc) (Tcl_Interp *interp, Proc *procPtr, Tcl_Obj *bodyPtr, Namespace *nsPtr, const char *description, const char *procName); /* 92 */ - void (*tclProcDeleteProc) (ClientData clientData); /* 93 */ + void (*tclProcDeleteProc) (void *clientData); /* 93 */ void (*reserved94)(void); void (*reserved95)(void); int (*tclRenameCommand) (Tcl_Interp *interp, const char *oldName, const char *newName); /* 96 */ @@ -769,10 +689,10 @@ typedef struct TclIntStubs { int (*tclServiceIdle) (void); /* 98 */ void (*reserved99)(void); void (*reserved100)(void); - CONST86 char * (*tclSetPreInitScript) (const char *string); /* 101 */ + const char * (*tclSetPreInitScript) (const char *string); /* 101 */ void (*tclSetupEnv) (Tcl_Interp *interp); /* 102 */ int (*tclSockGetPort) (Tcl_Interp *interp, const char *str, const char *proto, int *portPtr); /* 103 */ - TCL_DEPRECATED_API("") int (*tclSockMinimumBuffersOld) (int sock, int size); /* 104 */ + void (*reserved104)(void); void (*reserved105)(void); void (*reserved106)(void); void (*reserved107)(void); @@ -780,28 +700,28 @@ typedef struct TclIntStubs { int (*tclUpdateReturnInfo) (Interp *iPtr); /* 109 */ int (*tclSockMinimumBuffers) (void *sock, int size); /* 110 */ void (*tcl_AddInterpResolvers) (Tcl_Interp *interp, const char *name, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc); /* 111 */ - int (*tclAppendExportList) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *objPtr); /* 112 */ - Tcl_Namespace * (*tclCreateNamespace) (Tcl_Interp *interp, const char *name, ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc); /* 113 */ - void (*tclDeleteNamespace) (Tcl_Namespace *nsPtr); /* 114 */ - int (*tclExport) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int resetListFirst); /* 115 */ - Tcl_Command (*tclFindCommand) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 116 */ - Tcl_Namespace * (*tclFindNamespace) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 117 */ + 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 */ int (*tclpHasSockets) (Tcl_Interp *interp); /* 132 */ - TCL_DEPRECATED_API("") struct tm * (*tclpGetDate) (const time_t *time, int useGMT); /* 133 */ + void (*reserved133)(void); void (*reserved134)(void); void (*reserved135)(void); void (*reserved136)(void); @@ -810,7 +730,7 @@ typedef struct TclIntStubs { void (*reserved139)(void); void (*reserved140)(void); const char * (*tclpGetCwd) (Tcl_Interp *interp, Tcl_DString *cwdPtr); /* 141 */ - int (*tclSetByteCodeFromAny) (Tcl_Interp *interp, Tcl_Obj *objPtr, CompileHookProc *hookProc, ClientData clientData); /* 142 */ + int (*tclSetByteCodeFromAny) (Tcl_Interp *interp, Tcl_Obj *objPtr, CompileHookProc *hookProc, void *clientData); /* 142 */ int (*tclAddLiteralObj) (struct CompileEnv *envPtr, Tcl_Obj *objPtr, LiteralEntry **litPtrPtr); /* 143 */ void (*tclHideLiteral) (Tcl_Interp *interp, struct CompileEnv *envPtr, int index); /* 144 */ const struct AuxDataType * (*tclGetAuxDataType) (const char *typeName); /* 145 */ @@ -819,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, size_t index, size_t *startPtr, size_t *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) (ClientData clientData, int flags); /* 162 */ + 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 */ + 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, size_t numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]); /* 170 */ + int (*tclCheckExecutionTraces) (Tcl_Interp *interp, const char *command, size_t numChars, Command *cmdPtr, int result, int traceFlags, int 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, size_t strLen, const Tcl_UniChar *pattern, size_t 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); @@ -883,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, size_t 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,7 +815,7 @@ typedef struct TclIntStubs { TclPlatformType * (*tclGetPlatform) (void); /* 224 */ Tcl_Obj * (*tclTraceDictPath) (Tcl_Interp *interp, Tcl_Obj *rootPtr, int 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, size_t 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, const int createPart1, const int createPart2, Var **arrayPtrPtr); /* 230 */ @@ -904,9 +824,9 @@ 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) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 238 */ + 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 (*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 */ @@ -914,12 +834,12 @@ typedef struct TclIntStubs { 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, size_t numRemoved, size_t 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, Tcl_WideInt 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 */ + int (*tclRegisterLiteral) (void *envPtr, const char *bytes, size_t length, int flags); /* 251 */ Tcl_Obj * (*tclPtrGetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const int flags); /* 252 */ Tcl_Obj * (*tclPtrSetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, const int flags); /* 253 */ Tcl_Obj * (*tclPtrIncrObjVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, const int flags); /* 254 */ @@ -927,8 +847,8 @@ typedef struct TclIntStubs { int (*tclPtrUnsetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const int flags); /* 256 */ void (*tclStaticPackage) (Tcl_Interp *interp, const char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 257 */ Tcl_Obj * (*tclpCreateTemporaryDirectory) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj); /* 258 */ - unsigned char * (*tclGetBytesFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *lengthPtr); /* 259 */ - void (*tclUnusedStubEntry) (void); /* 260 */ + void (*tclAppendUnicodeToObj) (Tcl_Obj *objPtr, const Tcl_UniChar *unicode, size_t length); /* 259 */ + unsigned char * (*tclGetBytesFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, size_t *lengthPtr); /* 260 */ } TclIntStubs; extern const TclIntStubs *tclIntStubsPtr; @@ -955,8 +875,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 \ @@ -995,12 +914,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 \ @@ -1012,8 +929,7 @@ extern const TclIntStubs *tclIntStubsPtr; #define TclpGetUserHome \ (tclIntStubsPtr->tclpGetUserHome) /* 42 */ /* Slot 43 is reserved */ -#define TclGuessPackageName \ - (tclIntStubsPtr->tclGuessPackageName) /* 44 */ +/* Slot 44 is reserved */ #define TclHideUnsafeCommands \ (tclIntStubsPtr->tclHideUnsafeCommands) /* 45 */ #define TclInExit \ @@ -1021,8 +937,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 */ @@ -1063,8 +978,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 */ @@ -1076,8 +990,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 */ @@ -1103,8 +1016,7 @@ extern const TclIntStubs *tclIntStubsPtr; (tclIntStubsPtr->tclSetupEnv) /* 102 */ #define TclSockGetPort \ (tclIntStubsPtr->tclSockGetPort) /* 103 */ -#define TclSockMinimumBuffersOld \ - (tclIntStubsPtr->tclSockMinimumBuffersOld) /* 104 */ +/* Slot 104 is reserved */ /* Slot 105 is reserved */ /* Slot 106 is reserved */ /* Slot 107 is reserved */ @@ -1116,38 +1028,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 \ @@ -1158,8 +1058,7 @@ extern const TclIntStubs *tclIntStubsPtr; (tclIntStubsPtr->tcl_SetNamespaceResolvers) /* 131 */ #define TclpHasSockets \ (tclIntStubsPtr->tclpHasSockets) /* 132 */ -#define TclpGetDate \ - (tclIntStubsPtr->tclpGetDate) /* 133 */ +/* Slot 133 is reserved */ /* Slot 134 is reserved */ /* Slot 135 is reserved */ /* Slot 136 is reserved */ @@ -1200,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 */ @@ -1217,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 \ @@ -1238,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 */ @@ -1328,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 \ @@ -1374,48 +1264,22 @@ extern const TclIntStubs *tclIntStubsPtr; (tclIntStubsPtr->tclStaticPackage) /* 257 */ #define TclpCreateTemporaryDirectory \ (tclIntStubsPtr->tclpCreateTemporaryDirectory) /* 258 */ +#define TclAppendUnicodeToObj \ + (tclIntStubsPtr->tclAppendUnicodeToObj) /* 259 */ #define TclGetBytesFromObj \ - (tclIntStubsPtr->tclGetBytesFromObj) /* 259 */ -#define TclUnusedStubEntry \ - (tclIntStubsPtr->tclUnusedStubEntry) /* 260 */ + (tclIntStubsPtr->tclGetBytesFromObj) /* 260 */ #endif /* defined(USE_TCL_STUBS) */ /* !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_StaticPackage -# define Tcl_StaticPackage (tclIntStubsPtr->tclStaticPackage) -#endif +#undef Tcl_StaticPackage +#define Tcl_StaticPackage \ + (tclIntStubsPtr->tclStaticPackage) +#endif /* defined(USE_TCL_STUBS) */ -#undef TclGuessPackageName -#ifndef TCL_NO_DEPRECATED -# 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 de308de..7613264 100644 --- a/generic/tclIntPlatDecls.h +++ b/generic/tclIntPlatDecls.h @@ -67,14 +67,10 @@ EXTERN TclFile TclpOpenFile(const char *fname, int mode); EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout); /* 9 */ EXTERN TclFile TclpCreateTempFile(const char *contents); -/* 10 */ -EXTERN Tcl_DirEntry * TclpReaddir(TclDIR *dir); -/* 11 */ -EXTERN struct tm * TclpLocaltime_unix(const time_t *clock); -/* 12 */ -EXTERN struct tm * TclpGmtime_unix(const time_t *clock); -/* 13 */ -EXTERN char * TclpInetNtoa(struct in_addr addr); +/* Slot 10 is reserved */ +/* Slot 11 is reserved */ +/* Slot 12 is reserved */ +/* Slot 13 is reserved */ /* 14 */ EXTERN int TclUnixCopyFile(const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, @@ -118,30 +114,20 @@ EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj, #endif /* UNIX */ #if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ /* 0 */ -EXTERN void TclWinConvertError(DWORD errCode); -/* 1 */ -EXTERN void TclWinConvertWSAError(DWORD errCode); -/* 2 */ -EXTERN struct servent * TclWinGetServByName(const char *nm, - const char *proto); -/* 3 */ -EXTERN int TclWinGetSockOpt(SOCKET s, int level, int optname, - char *optval, int *optlen); +EXTERN void TclWinConvertError(int errCode); +/* Slot 1 is reserved */ +/* Slot 2 is reserved */ +/* Slot 3 is reserved */ /* 4 */ -EXTERN HINSTANCE TclWinGetTclInstance(void); +EXTERN void * TclWinGetTclInstance(void); /* 5 */ EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout); -/* 6 */ -EXTERN unsigned short TclWinNToHS(unsigned short ns); -/* 7 */ -EXTERN int TclWinSetSockOpt(SOCKET s, int level, int optname, - const char *optval, int optlen); +/* Slot 6 is reserved */ +/* Slot 7 is reserved */ /* 8 */ -EXTERN int TclpGetPid(Tcl_Pid pid); -/* 9 */ -EXTERN int TclWinGetPlatformId(void); -/* 10 */ -EXTERN Tcl_DirEntry * TclpReaddir(TclDIR *dir); +EXTERN size_t TclpGetPid(Tcl_Pid pid); +/* Slot 9 is reserved */ +/* Slot 10 is reserved */ /* 11 */ EXTERN void TclGetAndDetachPids(Tcl_Interp *interp, Tcl_Channel chan); @@ -169,21 +155,18 @@ EXTERN TclFile TclpMakeFile(Tcl_Channel channel, int direction); /* 19 */ EXTERN TclFile TclpOpenFile(const char *fname, int mode); /* 20 */ -EXTERN void TclWinAddProcess(HANDLE hProcess, DWORD id); -/* 21 */ -EXTERN char * TclpInetNtoa(struct in_addr addr); +EXTERN void TclWinAddProcess(void *hProcess, size_t id); +/* Slot 21 is reserved */ /* 22 */ EXTERN TclFile TclpCreateTempFile(const char *contents); /* Slot 23 is reserved */ /* 24 */ EXTERN char * TclWinNoBackslash(char *path); /* Slot 25 is reserved */ -/* 26 */ -EXTERN void TclWinSetInterfaces(int wide); +/* Slot 26 is reserved */ /* 27 */ EXTERN void TclWinFlushDirtyChannels(void); -/* 28 */ -EXTERN void TclWinResetInterfaces(void); +/* Slot 28 is reserved */ /* 29 */ EXTERN int TclWinCPUID(int index, int *regs); /* 30 */ @@ -218,14 +201,10 @@ EXTERN TclFile TclpOpenFile(const char *fname, int mode); EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout); /* 9 */ EXTERN TclFile TclpCreateTempFile(const char *contents); -/* 10 */ -EXTERN Tcl_DirEntry * TclpReaddir(TclDIR *dir); -/* 11 */ -EXTERN struct tm * TclpLocaltime_unix(const time_t *clock); -/* 12 */ -EXTERN struct tm * TclpGmtime_unix(const time_t *clock); -/* 13 */ -EXTERN char * TclpInetNtoa(struct in_addr addr); +/* Slot 10 is reserved */ +/* Slot 11 is reserved */ +/* Slot 12 is reserved */ +/* Slot 13 is reserved */ /* 14 */ EXTERN int TclUnixCopyFile(const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, @@ -283,10 +262,10 @@ typedef struct TclIntPlatStubs { TclFile (*tclpOpenFile) (const char *fname, int mode); /* 7 */ int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */ TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */ - Tcl_DirEntry * (*tclpReaddir) (TclDIR *dir); /* 10 */ - struct tm * (*tclpLocaltime_unix) (const time_t *clock); /* 11 */ - struct tm * (*tclpGmtime_unix) (const time_t *clock); /* 12 */ - char * (*tclpInetNtoa) (struct in_addr addr); /* 13 */ + void (*reserved10)(void); + void (*reserved11)(void); + void (*reserved12)(void); + void (*reserved13)(void); int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 14 */ int (*tclMacOSXGetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr); /* 15 */ int (*tclMacOSXSetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *attributePtr); /* 16 */ @@ -306,17 +285,17 @@ typedef struct TclIntPlatStubs { int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */ #endif /* UNIX */ #if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ - void (*tclWinConvertError) (DWORD errCode); /* 0 */ - void (*tclWinConvertWSAError) (DWORD errCode); /* 1 */ - struct servent * (*tclWinGetServByName) (const char *nm, const char *proto); /* 2 */ - int (*tclWinGetSockOpt) (SOCKET s, int level, int optname, char *optval, int *optlen); /* 3 */ - HINSTANCE (*tclWinGetTclInstance) (void); /* 4 */ + void (*tclWinConvertError) (int errCode); /* 0 */ + void (*reserved1)(void); + void (*reserved2)(void); + void (*reserved3)(void); + void * (*tclWinGetTclInstance) (void); /* 4 */ int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 5 */ - unsigned short (*tclWinNToHS) (unsigned short ns); /* 6 */ - int (*tclWinSetSockOpt) (SOCKET s, int level, int optname, const char *optval, int optlen); /* 7 */ - int (*tclpGetPid) (Tcl_Pid pid); /* 8 */ - int (*tclWinGetPlatformId) (void); /* 9 */ - Tcl_DirEntry * (*tclpReaddir) (TclDIR *dir); /* 10 */ + void (*reserved6)(void); + void (*reserved7)(void); + size_t (*tclpGetPid) (Tcl_Pid pid); /* 8 */ + void (*reserved9)(void); + void (*reserved10)(void); void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 11 */ int (*tclpCloseFile) (TclFile file); /* 12 */ Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 13 */ @@ -326,15 +305,15 @@ typedef struct TclIntPlatStubs { int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 17 */ TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 18 */ TclFile (*tclpOpenFile) (const char *fname, int mode); /* 19 */ - void (*tclWinAddProcess) (HANDLE hProcess, DWORD id); /* 20 */ - char * (*tclpInetNtoa) (struct in_addr addr); /* 21 */ + void (*tclWinAddProcess) (void *hProcess, size_t id); /* 20 */ + void (*reserved21)(void); TclFile (*tclpCreateTempFile) (const char *contents); /* 22 */ void (*reserved23)(void); char * (*tclWinNoBackslash) (char *path); /* 24 */ void (*reserved25)(void); - void (*tclWinSetInterfaces) (int wide); /* 26 */ + void (*reserved26)(void); void (*tclWinFlushDirtyChannels) (void); /* 27 */ - void (*tclWinResetInterfaces) (void); /* 28 */ + 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 */ #endif /* WIN */ @@ -349,10 +328,10 @@ typedef struct TclIntPlatStubs { TclFile (*tclpOpenFile) (const char *fname, int mode); /* 7 */ int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */ TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */ - Tcl_DirEntry * (*tclpReaddir) (TclDIR *dir); /* 10 */ - struct tm * (*tclpLocaltime_unix) (const time_t *clock); /* 11 */ - struct tm * (*tclpGmtime_unix) (const time_t *clock); /* 12 */ - char * (*tclpInetNtoa) (struct in_addr addr); /* 13 */ + void (*reserved10)(void); + void (*reserved11)(void); + void (*reserved12)(void); + void (*reserved13)(void); int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 14 */ int (*tclMacOSXGetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr); /* 15 */ int (*tclMacOSXSetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *attributePtr); /* 16 */ @@ -406,14 +385,10 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; (tclIntPlatStubsPtr->tclUnixWaitForFile) /* 8 */ #define TclpCreateTempFile \ (tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */ -#define TclpReaddir \ - (tclIntPlatStubsPtr->tclpReaddir) /* 10 */ -#define TclpLocaltime_unix \ - (tclIntPlatStubsPtr->tclpLocaltime_unix) /* 11 */ -#define TclpGmtime_unix \ - (tclIntPlatStubsPtr->tclpGmtime_unix) /* 12 */ -#define TclpInetNtoa \ - (tclIntPlatStubsPtr->tclpInetNtoa) /* 13 */ +/* Slot 10 is reserved */ +/* Slot 11 is reserved */ +/* Slot 12 is reserved */ +/* Slot 13 is reserved */ #define TclUnixCopyFile \ (tclIntPlatStubsPtr->tclUnixCopyFile) /* 14 */ #define TclMacOSXGetFileAttribute \ @@ -444,26 +419,19 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; #if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ #define TclWinConvertError \ (tclIntPlatStubsPtr->tclWinConvertError) /* 0 */ -#define TclWinConvertWSAError \ - (tclIntPlatStubsPtr->tclWinConvertWSAError) /* 1 */ -#define TclWinGetServByName \ - (tclIntPlatStubsPtr->tclWinGetServByName) /* 2 */ -#define TclWinGetSockOpt \ - (tclIntPlatStubsPtr->tclWinGetSockOpt) /* 3 */ +/* Slot 1 is reserved */ +/* Slot 2 is reserved */ +/* Slot 3 is reserved */ #define TclWinGetTclInstance \ (tclIntPlatStubsPtr->tclWinGetTclInstance) /* 4 */ #define TclUnixWaitForFile \ (tclIntPlatStubsPtr->tclUnixWaitForFile) /* 5 */ -#define TclWinNToHS \ - (tclIntPlatStubsPtr->tclWinNToHS) /* 6 */ -#define TclWinSetSockOpt \ - (tclIntPlatStubsPtr->tclWinSetSockOpt) /* 7 */ +/* Slot 6 is reserved */ +/* Slot 7 is reserved */ #define TclpGetPid \ (tclIntPlatStubsPtr->tclpGetPid) /* 8 */ -#define TclWinGetPlatformId \ - (tclIntPlatStubsPtr->tclWinGetPlatformId) /* 9 */ -#define TclpReaddir \ - (tclIntPlatStubsPtr->tclpReaddir) /* 10 */ +/* Slot 9 is reserved */ +/* Slot 10 is reserved */ #define TclGetAndDetachPids \ (tclIntPlatStubsPtr->tclGetAndDetachPids) /* 11 */ #define TclpCloseFile \ @@ -484,20 +452,17 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; (tclIntPlatStubsPtr->tclpOpenFile) /* 19 */ #define TclWinAddProcess \ (tclIntPlatStubsPtr->tclWinAddProcess) /* 20 */ -#define TclpInetNtoa \ - (tclIntPlatStubsPtr->tclpInetNtoa) /* 21 */ +/* Slot 21 is reserved */ #define TclpCreateTempFile \ (tclIntPlatStubsPtr->tclpCreateTempFile) /* 22 */ /* Slot 23 is reserved */ #define TclWinNoBackslash \ (tclIntPlatStubsPtr->tclWinNoBackslash) /* 24 */ /* Slot 25 is reserved */ -#define TclWinSetInterfaces \ - (tclIntPlatStubsPtr->tclWinSetInterfaces) /* 26 */ +/* Slot 26 is reserved */ #define TclWinFlushDirtyChannels \ (tclIntPlatStubsPtr->tclWinFlushDirtyChannels) /* 27 */ -#define TclWinResetInterfaces \ - (tclIntPlatStubsPtr->tclWinResetInterfaces) /* 28 */ +/* Slot 28 is reserved */ #define TclWinCPUID \ (tclIntPlatStubsPtr->tclWinCPUID) /* 29 */ #define TclUnixOpenTemporaryFile \ @@ -524,14 +489,10 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; (tclIntPlatStubsPtr->tclUnixWaitForFile) /* 8 */ #define TclpCreateTempFile \ (tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */ -#define TclpReaddir \ - (tclIntPlatStubsPtr->tclpReaddir) /* 10 */ -#define TclpLocaltime_unix \ - (tclIntPlatStubsPtr->tclpLocaltime_unix) /* 11 */ -#define TclpGmtime_unix \ - (tclIntPlatStubsPtr->tclpGmtime_unix) /* 12 */ -#define TclpInetNtoa \ - (tclIntPlatStubsPtr->tclpInetNtoa) /* 13 */ +/* Slot 10 is reserved */ +/* Slot 11 is reserved */ +/* Slot 12 is reserved */ +/* Slot 13 is reserved */ #define TclUnixCopyFile \ (tclIntPlatStubsPtr->tclUnixCopyFile) /* 14 */ #define TclMacOSXGetFileAttribute \ @@ -566,12 +527,7 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLIMPORT -#undef TclpLocaltime_unix -#undef TclpGmtime_unix -#undef TclWinConvertWSAError #define TclWinConvertWSAError TclWinConvertError -#undef TclpInetNtoa -#define TclpInetNtoa inet_ntoa #undef TclpCreateTempFile_ #undef TclUnixWaitForFile_ @@ -583,26 +539,9 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; #undef TclMacOSXNotifierAddRunLoopMode /* 19 */ #endif -#if defined(_WIN32) -# undef TclWinNToHS -# undef TclWinGetServByName -# undef TclWinGetSockOpt -# undef TclWinSetSockOpt -# undef TclWinGetPlatformId -# undef TclWinResetInterfaces -# undef TclWinSetInterfaces -# if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 -# define TclWinNToHS ntohs -# define TclWinGetServByName getservbyname -# define TclWinGetSockOpt getsockopt -# define TclWinSetSockOpt setsockopt -# define TclWinGetPlatformId() (2) /* VER_PLATFORM_WIN32_NT */ -# define TclWinResetInterfaces() /* nop */ -# define TclWinSetInterfaces(dummy) /* nop */ -# endif /* TCL_NO_DEPRECATED */ -#else +#if !defined(_WIN32) # 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 f724175..f7eff58 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -25,14 +25,14 @@ static const char *tclPreInitScript = NULL; struct Target; /* - * struct Alias: + * Alias: * * Stores information about an alias. Is stored in the 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 @@ -66,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 @@ -112,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 @@ -127,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 @@ -144,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 @@ -158,7 +158,7 @@ typedef struct InterpInfo { * likely to work properly on 64-bit architectures. */ -typedef struct ScriptLimitCallback { +typedef struct { Tcl_Interp *interp; /* The interpreter in which to execute the * callback. */ Tcl_Obj *scriptObj; /* The script to execute to perform the @@ -171,7 +171,7 @@ typedef struct ScriptLimitCallback { * table. */ } ScriptLimitCallback; -typedef struct ScriptLimitCallbackKey { +typedef struct { Tcl_Interp *interp; /* The interpreter that the limit callback was * attached to. This is not the interpreter * that the callback runs in! */ @@ -482,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; @@ -579,7 +579,7 @@ InterpInfoDeleteProc( } Tcl_DeleteHashTable(&childPtr->aliasTable); - ckfree(interpInfoPtr); + Tcl_Free(interpInfoPtr); } /* @@ -624,8 +624,11 @@ NRInterpCmd( "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", @@ -633,15 +636,19 @@ 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 }; if (objc < 2) { @@ -794,7 +801,7 @@ 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) { return TCL_ERROR; @@ -1028,8 +1035,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; @@ -1110,7 +1119,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; @@ -1119,7 +1128,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; @@ -1319,7 +1328,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]); } @@ -1525,7 +1534,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; @@ -1576,7 +1585,7 @@ AliasCreate( cmdPtr->deleteData = NULL; Tcl_DeleteCommandFromToken(childInterp, aliasPtr->childCmd); - ckfree(aliasPtr); + Tcl_Free(aliasPtr); /* * The result was already set by TclPreventAliasLoop. @@ -1633,7 +1642,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; @@ -1735,7 +1744,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; } @@ -1840,8 +1849,8 @@ AliasNRCmd( cmdv = &listRep->elements; prefv = &aliasPtr->objPtr; - memcpy(cmdv, prefv, prefc * sizeof(Tcl_Obj *)); - memcpy(cmdv+prefc, objv+1, (objc-1) * sizeof(Tcl_Obj *)); + memcpy(cmdv, prefv, (prefc * sizeof(Tcl_Obj *))); + memcpy(cmdv+prefc, objv+1, ((objc-1) * sizeof(Tcl_Obj *))); for (i=0; i<cmdc; i++) { Tcl_IncrRefCount(cmdv[i]); @@ -2068,8 +2077,8 @@ AliasObjCmdDeleteProc( targetPtr->nextPtr->prevPtr = targetPtr->prevPtr; } - ckfree(targetPtr); - ckfree(aliasPtr); + Tcl_Free(targetPtr); + Tcl_Free(aliasPtr); } /* @@ -3571,7 +3580,7 @@ RunLimitHandlers( if (handlerPtr->deleteProc != NULL) { handlerPtr->deleteProc(handlerPtr->clientData); } - ckfree(handlerPtr); + Tcl_Free(handlerPtr); } } } @@ -3608,14 +3617,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; @@ -3734,7 +3743,7 @@ Tcl_LimitRemoveHandler( if (handlerPtr->deleteProc != NULL) { handlerPtr->deleteProc(handlerPtr->clientData); } - ckfree(handlerPtr); + Tcl_Free(handlerPtr); } return; } @@ -3794,7 +3803,7 @@ TclLimitRemoveAllHandlers( if (handlerPtr->deleteProc != NULL) { handlerPtr->deleteProc(handlerPtr->clientData); } - ckfree(handlerPtr); + Tcl_Free(handlerPtr); } } @@ -3827,7 +3836,7 @@ TclLimitRemoveAllHandlers( if (handlerPtr->deleteProc != NULL) { handlerPtr->deleteProc(handlerPtr->clientData); } - ckfree(handlerPtr); + Tcl_Free(handlerPtr); } } @@ -4222,7 +4231,7 @@ DeleteScriptLimitCallback( if (limitCBPtr->entryPtr != NULL) { Tcl_DeleteHashEntry(limitCBPtr->entryPtr); } - ckfree(limitCBPtr); + Tcl_Free(limitCBPtr); } /* @@ -4322,7 +4331,7 @@ SetScriptLimitCallback( limitCBPtr); } - limitCBPtr = (ScriptLimitCallback *)ckalloc(sizeof(ScriptLimitCallback)); + limitCBPtr = (ScriptLimitCallback *)Tcl_Alloc(sizeof(ScriptLimitCallback)); limitCBPtr->interp = interp; limitCBPtr->scriptObj = scriptObj; limitCBPtr->entryPtr = hashPtr; @@ -4575,7 +4584,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; @@ -4780,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; diff --git a/generic/tclLink.c b/generic/tclLink.c index 13bf6c4..299e43d 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 { @@ -171,7 +171,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 +245,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 +259,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 +327,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 +348,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 +359,7 @@ Tcl_LinkArray( */ if (size > 1) { - linkPtr->lastValue.aryPtr = ckalloc(linkPtr->bytes); + linkPtr->lastValue.aryPtr = Tcl_Alloc(linkPtr->bytes); linkPtr->flags |= LINK_ALLOC_LAST; } @@ -631,20 +631,20 @@ SetInvalidRealFromAny( TCL_UNUSED(Tcl_Interp *), Tcl_Obj *objPtr) { - const char *str; - const char *endPtr; + size_t length; + const char *str, *endPtr; - str = TclGetString(objPtr); - if ((objPtr->length == 1) && (str[0] == '.')) { + str = TclGetStringFromObj(objPtr, &length); + if ((length == 1) && (str[0] == '.')) { objPtr->typePtr = &invalidRealType; objPtr->internalRep.doubleValue = 0.0; return TCL_OK; } - if (TclParseNumber(NULL, objPtr, NULL, str, objPtr->length, &endPtr, + if (TclParseNumber(NULL, objPtr, NULL, str, length, &endPtr, TCL_PARSE_DECIMAL_ONLY) == TCL_OK) { /* - * If number is followed by [eE][+-]?, then it is an invalid - * double, but it could be the start of a valid double. + * If number is followed by [eE][+-]?, then it is an invalid double, + * but it could be the start of a valid double. */ if (*endPtr == 'e' || *endPtr == 'E') { @@ -667,10 +667,10 @@ SetInvalidRealFromAny( } /* - * This function checks for integer representations, which are valid - * when linking with C variables, but which are invalid in other - * contexts in Tcl. Handled are "+", "-", "", "0x", "0b", "0d" and "0o" - * (upperand lowercase). See bug [39f6304c2e]. + * This function checks for integer representations, which are valid when + * linking with C variables, but which are invalid in other contexts in Tcl. + * Handled are "+", "-", "", "0x", "0b", "0d" and "0o" (upper- and + * lower-case). See bug [39f6304c2e]. */ static int @@ -678,13 +678,14 @@ GetInvalidIntFromObj( Tcl_Obj *objPtr, int *intPtr) { - const char *str = TclGetString(objPtr); + size_t length; + const char *str = TclGetStringFromObj(objPtr, &length); - if ((objPtr->length == 0) || ((objPtr->length == 2) && (str[0] == '0') - && strchr("xXbBoOdD", str[1]))) { + if ((length == 0) || + ((length == 2) && (str[0] == '0') && strchr("xXbBoOdD", str[1]))) { *intPtr = 0; return TCL_OK; - } else if ((objPtr->length == 1) && strchr("+-", str[0])) { + } else if ((length == 1) && strchr("+-", str[0])) { *intPtr = (str[0] == '+'); return TCL_OK; } @@ -692,10 +693,10 @@ GetInvalidIntFromObj( } /* - * This function checks for double representations, which are valid - * when linking with C variables, but which are invalid in other - * contexts in Tcl. Handled are "+", "-", "", ".", "0x", "0b" and "0o" - * (upper- and lowercase) and sequences like "1e-". See bug [39f6304c2e]. + * This function checks for double representations, which are valid when + * linking with C variables, but which are invalid in other contexts in Tcl. + * Handled are "+", "-", "", ".", "0x", "0b" and "0o" (upper- and lower-case) + * and sequences like "1e-". See bug [39f6304c2e]. */ static int @@ -754,7 +755,7 @@ LinkTraceProc( { Link *linkPtr = (Link *)clientData; int changed; - int valueLength; + size_t valueLength = 0; const char *value; char **pp; Tcl_Obj *valueObj; @@ -778,7 +779,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); } @@ -896,16 +897,15 @@ LinkTraceProc( switch (linkPtr->type) { case TCL_LINK_STRING: - value = TclGetString(valueObj); - valueLength = valueObj->length + 1; + value = TclGetStringFromObj(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 *) Tcl_GetStringFromObj(valueObj, &valueLength); + value = (char *) TclGetStringFromObj(valueObj, &valueLength); valueLength++; /* include end of string char */ if (valueLength > linkPtr->bytes) { return (char *) "wrong size of char* value"; @@ -920,7 +920,7 @@ LinkTraceProc( return NULL; case TCL_LINK_BINARY: - value = (char *) Tcl_GetByteArrayFromObj(valueObj, &valueLength); + value = (char *) TclGetByteArrayFromObj(valueObj, &valueLength); if (valueLength != linkPtr->bytes) { return (char *) "wrong size of binary value"; } @@ -948,7 +948,7 @@ LinkTraceProc( if (linkPtr->flags & LINK_ALLOC_LAST) { if (Tcl_ListObjGetElements(NULL, (valueObj), &objc, &objv) == TCL_ERROR - || objc != linkPtr->numElems) { + || (size_t)objc != linkPtr->numElems) { return (char *) "wrong dimension"; } } @@ -1288,18 +1288,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); @@ -1307,12 +1307,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); @@ -1320,12 +1320,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++) { objv[i] = Tcl_NewDoubleObj(linkPtr->lastValue.dPtr[i]); } resultObj = Tcl_NewListObj(linkPtr->numElems, objv); - ckfree(objv); + Tcl_Free(objv); return resultObj; } linkPtr->lastValue.d = LinkedVar(double); @@ -1333,12 +1333,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); @@ -1346,12 +1346,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); @@ -1359,12 +1359,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); @@ -1372,12 +1372,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); @@ -1385,12 +1385,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); @@ -1398,12 +1398,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); @@ -1412,12 +1412,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); @@ -1425,12 +1425,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); @@ -1439,12 +1439,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++) { objv[i] = Tcl_NewDoubleObj(linkPtr->lastValue.fPtr[i]); } resultObj = Tcl_NewListObj(linkPtr->numElems, objv); - ckfree(objv); + Tcl_Free(objv); return resultObj; } linkPtr->lastValue.f = LinkedVar(float); @@ -1452,13 +1452,13 @@ 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++) { TclNewIntObj(objv[i], (Tcl_WideInt) linkPtr->lastValue.uwPtr[i]); } resultObj = Tcl_NewListObj(linkPtr->numElems, objv); - ckfree(objv); + Tcl_Free(objv); return resultObj; } linkPtr->lastValue.uw = LinkedVar(Tcl_WideUInt); @@ -1526,12 +1526,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 332e6aa..3bba674 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -77,20 +77,22 @@ const Tcl_ObjType tclListType = { * * NewListIntRep -- * - * Creates a list internal rep with space for objc elements. objc - * must be > 0. If objv!=NULL, initializes with the first objc values - * in that array. If objv==NULL, initalize list internal rep to have - * 0 elements, with space to add objc more. Flag value "p" indicates + * Creates a 'List' structure with space for 'objc' elements. 'objc' must + * be > 0. If 'objv' is not NULL, The list is initialized with first + * 'objc' values in that array. Otherwise the list is initialized to have + * 0 elements, with space to add 'objc' more. Flag value 'p' indicates * how to behave on failure. * - * Results: - * A new List struct with refCount 0 is returned. If some failure - * prevents this then if p=0, NULL is returned and otherwise the - * routine panics. + * Value * - * Side effects: - * The ref counts of the elements in objv are incremented since the - * resulting list now refers to them. + * A new 'List' structure with refCount 0. If some failure + * prevents this NULL is returned if 'p' is 0 , and 'Tcl_Panic' + * is called if it is not. + * + * Effect + * + * The refCount of each value in 'objv' is incremented as it is added + * to the list. * *---------------------------------------------------------------------- */ @@ -122,10 +124,10 @@ NewListIntRep( return NULL; } - listRepPtr = (List *)attemptckalloc(LIST_SIZE(objc)); + listRepPtr = (List *)Tcl_AttemptAlloc(LIST_SIZE(objc)); if (listRepPtr == NULL) { if (p) { - 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; @@ -154,21 +156,9 @@ NewListIntRep( /* *---------------------------------------------------------------------- * - * AttemptNewList -- + * AttemptNewList -- * - * Creates a list internal rep with space for objc elements. objc - * must be > 0. If objv!=NULL, initializes with the first objc values - * in that array. If objv==NULL, initalize list internal rep to have - * 0 elements, with space to add objc more. - * - * Results: - * A new List struct with refCount 0 is returned. If some failure - * prevents this then NULL is returned, and an error message is left - * in the interp result, unless interp is NULL. - * - * Side effects: - * The ref counts of the elements in objv are incremented since the - * resulting list now refers to them. + * Like NewListIntRep, but additionally sets an error message on failure. * *---------------------------------------------------------------------- */ @@ -188,7 +178,7 @@ AttemptNewList( LIST_MAX)); } else { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "list creation failed: unable to alloc %u bytes", + "list creation failed: unable to alloc %" TCL_Z_MODIFIER "u bytes", LIST_SIZE(objc))); } Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); @@ -201,23 +191,20 @@ AttemptNewList( * * Tcl_NewListObj -- * - * This function is normally called when not debugging: i.e., when - * TCL_MEM_DEBUG is not defined. It creates a new list object from an - * (objc,objv) array: that is, each of the objc elements of the array - * referenced by objv is inserted as an element into a new Tcl object. + * Creates a new list object and adds values to it. When TCL_MEM_DEBUG is + * defined, 'Tcl_DbNewListObj' is called instead. * - * When TCL_MEM_DEBUG is defined, this function just returns the result - * of calling the debugging version Tcl_DbNewListObj. + * Value * - * Results: - * A new list object is returned that is initialized from the object - * pointers in objv. If objc is less than or equal to zero, an empty - * object is returned. The new object's string representation is left - * NULL. The resulting new list object has ref count 0. + * A new list 'Tcl_Obj' to which is appended values from 'objv', or if + * 'objc' is less than or equal to zero, a list 'Tcl_Obj' having no + * elements. The string representation of the new 'Tcl_Obj' is set to + * NULL. The refCount of the list is 0. * - * Side effects: - * The ref counts of the elements in objv are incremented since the - * resulting list now refers to them. + * Effect + * + * The refCount of each elements in 'objv' is incremented as it is added + * to the list. * *---------------------------------------------------------------------- */ @@ -268,28 +255,14 @@ Tcl_NewListObj( /* *---------------------------------------------------------------------- * - * Tcl_DbNewListObj -- - * - * This function is normally called when debugging: i.e., when - * TCL_MEM_DEBUG is defined. It creates new list objects. It is the same - * as the Tcl_NewListObj function above except that it calls - * Tcl_DbCkalloc directly with the file name and line number from its - * caller. This simplifies debugging since then the [memory active] - * command will report the correct file name and line number when - * reporting objects that haven't been freed. + * Tcl_DbNewListObj -- * - * When TCL_MEM_DEBUG is not defined, this function just returns the - * result of calling Tcl_NewListObj. + * Like 'Tcl_NewListObj', but it calls Tcl_DbCkalloc directly with the + * file name and line number from its caller. This simplifies debugging + * since the [memory active] command will report the correct file + * name and line number when reporting objects that haven't been freed. * - * Results: - * A new list object is returned that is initialized from the object - * pointers in objv. If objc is less than or equal to zero, an empty - * object is returned. The new object's string representation is left - * NULL. The new list object has ref count 0. - * - * Side effects: - * The ref counts of the elements in objv are incremented since the - * resulting list now refers to them. + * When TCL_MEM_DEBUG is not defined, 'Tcl_NewListObj' is called instead. * *---------------------------------------------------------------------- */ @@ -348,19 +321,8 @@ Tcl_DbNewListObj( * * Tcl_SetListObj -- * - * Modify an object to be a list containing each of the objc elements of - * the object array referenced by objv. - * - * Results: - * None. - * - * Side effects: - * The object is made a list object and is initialized from the object - * pointers in objv. If objc is less than or equal to zero, an empty - * object is returned. The new object's string representation is left - * NULL. The ref counts of the elements in objv are incremented since the - * list now refers to them. The object's old string and internal - * representations are freed and its type is set NULL. + * Like 'Tcl_NewListObj', but operates on an existing 'Tcl_Obj'instead of + * creating a new one. * *---------------------------------------------------------------------- */ @@ -403,18 +365,20 @@ Tcl_SetListObj( * * TclListObjCopy -- * - * Makes a "pure list" copy of a list value. This provides for the C - * level a counterpart of the [lrange $list 0 end] command, while using - * internals details to be as efficient as possible. + * Creates a new 'Tcl_Obj' which is a pure copy of a list value. This + * provides for the C level a counterpart of the [lrange $list 0 end] + * command, while using internals details to be as efficient as possible. * - * Results: - * Normally returns a pointer to a new Tcl_Obj, that contains the same - * list value as *listPtr does. The returned Tcl_Obj has a refCount of - * zero. If *listPtr does not hold a list, NULL is returned, and if - * interp is non-NULL, an error message is recorded there. + * Value * - * Side effects: - * None. + * The address of the new 'Tcl_Obj' which shares its internal + * representation with 'listPtr', and whose refCount is 0. If 'listPtr' + * is not actually a list, the value is NULL, and an error message is left + * in 'interp' if it is not NULL. + * + * Effect + * + * 'listPtr' is converted to a list if it isn't one already. * *---------------------------------------------------------------------- */ @@ -463,22 +427,23 @@ TclListObjCopy( Tcl_Obj * TclListObjRange( Tcl_Obj *listPtr, /* List object to take a range from. */ - int fromIdx, /* Index of first element to include. */ - int toIdx) /* Index of last element to include. */ + size_t fromIdx, /* Index of first element to include. */ + size_t toIdx) /* Index of last element to include. */ { Tcl_Obj **elemPtrs; - int listLen, i, newLen; + int listLen; + size_t i, newLen; List *listRepPtr; TclListObjGetElements(NULL, listPtr, &listLen, &elemPtrs); - if (fromIdx < 0) { + if (fromIdx == TCL_INDEX_NONE) { fromIdx = 0; } - if (toIdx >= listLen) { + if (toIdx + 1 >= (size_t)listLen + 1) { toIdx = listLen-1; } - if (fromIdx > toIdx) { + if (fromIdx + 1 > toIdx + 1) { Tcl_Obj *obj; TclNewObj(obj); return obj; @@ -509,7 +474,7 @@ TclListObjRange( for (i = 0; i < fromIdx; i++) { TclDecrRefCount(elemPtrs[i]); } - for (i = toIdx + 1; i < listLen; i++) { + for (i = toIdx + 1; i < (size_t)listLen; i++) { TclDecrRefCount(elemPtrs[i]); } @@ -529,27 +494,30 @@ TclListObjRange( * * Tcl_ListObjGetElements -- * - * This function returns an (objc,objv) array of the elements in a list - * object. + * Retreive the elements in a list 'Tcl_Obj'. * - * Results: - * The return value is normally TCL_OK; in this case *objcPtr is set to - * the count of list elements and *objvPtr is set to a pointer to an - * array of (*objcPtr) pointers to each list element. If listPtr does not - * refer to a list object and the object can not be converted to one, - * TCL_ERROR is returned and an error message will be left in the - * interpreter's result if interp is not NULL. - * - * The objects referenced by the returned array should be treated as - * readonly and their ref counts are _not_ incremented; the caller must - * do that if it holds on to a reference. Furthermore, the pointer and - * length returned by this function may change as soon as any function is - * called on the list object; be careful about retaining the pointer in a - * local data structure. + * Value * - * Side effects: - * The possible conversion of the object referenced by listPtr - * to a list object. + * TCL_OK + * + * A count of list elements is stored, 'objcPtr', And a pointer to the + * array of elements in the list is stored in 'objvPtr'. + * + * The elements accessible via 'objvPtr' should be treated as readonly + * and the refCount for each object is _not_ incremented; the caller + * must do that if it holds on to a reference. Furthermore, the + * pointer and length returned by this function may change as soon as + * any function is called on the list object. Be careful about + * retaining the pointer in a local data structure. + * + * TCL_ERROR + * + * 'listPtr' is not a valid list. An error message is left in the + * interpreter's result if 'interp' is not NULL. + * + * Effect + * + * 'listPtr' is converted to a list object if it isn't one already. * *---------------------------------------------------------------------- */ @@ -569,9 +537,10 @@ Tcl_ListObjGetElements( ListGetIntRep(listPtr, listRepPtr); if (listRepPtr == NULL) { - int result, length; + int result; + size_t length; - (void) Tcl_GetStringFromObj(listPtr, &length); + (void) TclGetStringFromObj(listPtr, &length); if (length == 0) { *objcPtr = 0; *objvPtr = NULL; @@ -593,20 +562,27 @@ Tcl_ListObjGetElements( * * Tcl_ListObjAppendList -- * - * This function appends the elements in the list value referenced by - * elemListPtr to the list value referenced by listPtr. + * Appends the elements of elemListPtr to those of listPtr. * - * Results: - * The return value is normally TCL_OK. If listPtr or elemListPtr do not - * refer to list values, TCL_ERROR is returned and an error message is - * left in the interpreter's result if interp is not NULL. + * Value * - * Side effects: - * The reference counts of the elements in elemListPtr are incremented - * since the list now refers to them. listPtr and elemListPtr are - * converted, if necessary, to list objects. Also, appending the new - * elements may cause listObj's array of element pointers to grow. - * listPtr's old string representation, if any, is invalidated. + * TCL_OK + * + * Success. + * + * TCL_ERROR + * + * 'listPtr' or 'elemListPtr' are not valid lists. An error + * message is left in the interpreter's result if 'interp' is not NULL. + * + * Effect + * + * The reference count of each element of 'elemListPtr' as it is added to + * 'listPtr'. 'listPtr' and 'elemListPtr' are converted to 'tclListType' + * if they are not already. Appending the new elements may cause the + * array of element pointers in 'listObj' to grow. If any objects are + * appended to 'listPtr'. Any preexisting string representation of + * 'listPtr' is invalidated. * *---------------------------------------------------------------------- */ @@ -645,24 +621,27 @@ Tcl_ListObjAppendList( * * Tcl_ListObjAppendElement -- * - * This function is a special purpose version of Tcl_ListObjAppendList: - * it appends a single object referenced by objPtr to the list object - * referenced by listPtr. If listPtr is not already a list object, an - * attempt will be made to convert it to one. + * Like 'Tcl_ListObjAppendList', but Appends a single value to a list. * - * Results: - * The return value is normally TCL_OK; in this case objPtr is added to - * the end of listPtr's list. If listPtr does not refer to a list object - * and the object can not be converted to one, TCL_ERROR is returned and - * an error message will be left in the interpreter's result if interp is - * not NULL. + * Value * - * Side effects: - * The ref count of objPtr is incremented since the list now refers to - * it. listPtr will be converted, if necessary, to a list object. Also, - * appending the new element may cause listObj's array of element - * pointers to grow. listPtr's old string representation, if any, is - * invalidated. + * TCL_OK + * + * 'objPtr' is appended to the elements of 'listPtr'. + * + * TCL_ERROR + * + * listPtr does not refer to a list object and the object can not be + * converted to one. An error message will be left in the + * interpreter's result if interp is not NULL. + * + * Effect + * + * If 'listPtr' is not already of type 'tclListType', it is converted. + * The 'refCount' of 'objPtr' is incremented as it is added to 'listPtr'. + * Appending the new element may cause the the array of element pointers + * in 'listObj' to grow. Any preexisting string representation of + * 'listPtr' is invalidated. * *---------------------------------------------------------------------- */ @@ -682,9 +661,10 @@ Tcl_ListObjAppendElement( ListGetIntRep(listPtr, listRepPtr); if (listRepPtr == NULL) { - int result, length; + int result; + size_t length; - (void) Tcl_GetStringFromObj(listPtr, &length); + (void) TclGetStringFromObj(listPtr, &length); if (length == 0) { Tcl_SetListObj(listPtr, 1, &objPtr); return TCL_OK; @@ -718,18 +698,18 @@ Tcl_ListObjAppendElement( attempt = 2 * numRequired; if (attempt <= LIST_MAX) { - newPtr = (List *)attemptckrealloc(listRepPtr, LIST_SIZE(attempt)); + newPtr = (List *)Tcl_AttemptRealloc(listRepPtr, LIST_SIZE(attempt)); } if (newPtr == NULL) { attempt = numRequired + 1 + TCL_MIN_ELEMENT_GROWTH; if (attempt > LIST_MAX) { attempt = LIST_MAX; } - newPtr = (List *)attemptckrealloc(listRepPtr, LIST_SIZE(attempt)); + newPtr = (List *)Tcl_AttemptRealloc(listRepPtr, LIST_SIZE(attempt)); } if (newPtr == NULL) { attempt = numRequired; - newPtr = (List *)attemptckrealloc(listRepPtr, LIST_SIZE(attempt)); + newPtr = (List *)Tcl_AttemptRealloc(listRepPtr, LIST_SIZE(attempt)); } if (newPtr) { listRepPtr = newPtr; @@ -787,7 +767,7 @@ Tcl_ListObjAppendElement( */ memcpy(dst, src, numElems * sizeof(Tcl_Obj *)); - ckfree(listRepPtr); + Tcl_Free(listRepPtr); } listRepPtr = newPtr; } @@ -820,23 +800,27 @@ Tcl_ListObjAppendElement( * * Tcl_ListObjIndex -- * - * This function returns a pointer to the index'th object from the list - * referenced by listPtr. The first element has index 0. If index is - * negative or greater than or equal to the number of elements in the - * list, a NULL is returned. If listPtr is not a list object, an attempt - * will be made to convert it to a list. + * Retrieve a pointer to the element of 'listPtr' at 'index'. The index + * of the first element is 0. * - * Results: - * The return value is normally TCL_OK; in this case objPtrPtr is set to - * the Tcl_Obj pointer for the index'th list element or NULL if index is - * out of range. This object should be treated as readonly and its ref - * count is _not_ incremented; the caller must do that if it holds on to - * the reference. If listPtr does not refer to a list and can't be - * converted to one, TCL_ERROR is returned and an error message is left - * in the interpreter's result if interp is not NULL. + * Value * - * Side effects: - * listPtr will be converted, if necessary, to a list object. + * TCL_OK + * + * A pointer to the element at 'index' is stored in 'objPtrPtr'. If + * 'index' is out of range, NULL is stored in 'objPtrPtr'. This + * object should be treated as readonly and its 'refCount' is _not_ + * incremented. The caller must do that if it holds on to the + * reference. + * + * TCL_ERROR + * + * 'listPtr' is not a valid list. An an error message is left in the + * interpreter's result if 'interp' is not NULL. + * + * Effect + * + * If 'listPtr' is not already of type 'tclListType', it is converted. * *---------------------------------------------------------------------- */ @@ -852,9 +836,10 @@ Tcl_ListObjIndex( ListGetIntRep(listPtr, listRepPtr); if (listRepPtr == NULL) { - int result, length; + int result; + size_t length; - (void) Tcl_GetStringFromObj(listPtr, &length); + (void) TclGetStringFromObj(listPtr, &length); if (length == 0) { *objPtrPtr = NULL; return TCL_OK; @@ -880,19 +865,20 @@ Tcl_ListObjIndex( * * Tcl_ListObjLength -- * - * This function returns the number of elements in a list object. If the - * object is not already a list object, an attempt will be made to - * convert it to one. + * Retrieve the number of elements in a list. * - * Results: - * The return value is normally TCL_OK; in this case *intPtr will be set - * to the integer count of list elements. If listPtr does not refer to a - * list object and the object can not be converted to one, TCL_ERROR is - * returned and an error message will be left in the interpreter's result - * if interp is not NULL. + * Value * - * Side effects: - * The possible conversion of the argument object to a list object. + * TCL_OK + * + * A count of list elements is stored at the address provided by + * 'intPtr'. If 'listPtr' is not already of type 'tclListPtr', it is + * converted. + * + * TCL_ERROR + * + * 'listPtr' is not a valid list. An error message will be left in + * the interpreter's result if 'interp' is not NULL. * *---------------------------------------------------------------------- */ @@ -907,9 +893,10 @@ Tcl_ListObjLength( ListGetIntRep(listPtr, listRepPtr); if (listRepPtr == NULL) { - int result, length; + int result; + size_t length; - (void) Tcl_GetStringFromObj(listPtr, &length); + (void) TclGetStringFromObj(listPtr, &length); if (length == 0) { *intPtr = 0; return TCL_OK; @@ -930,35 +917,36 @@ Tcl_ListObjLength( * * Tcl_ListObjReplace -- * - * This function replaces zero or more elements of the list referenced by - * listPtr with the objects from an (objc,objv) array. The objc elements - * of the array referenced by objv replace the count elements in listPtr - * starting at first. + * Replace values in a list. * - * If the argument first is zero or negative, it refers to the first - * element. If first is greater than or equal to the number of elements - * in the list, then no elements are deleted; the new elements are - * appended to the list. Count gives the number of elements to replace. - * If count is zero or negative then no elements are deleted; the new - * elements are simply inserted before first. + * If 'first' is zero or negative, it refers to the first element. If + * 'first' outside the range of elements in the list, no elements are + * deleted. * - * The argument objv refers to an array of objc pointers to the new - * elements to be added to listPtr in place of those that were deleted. - * If objv is NULL, no new elements are added. If listPtr is not a list - * object, an attempt will be made to convert it to one. + * If 'count' is zero or negative no elements are deleted, and any new + * elements are inserted at the beginning of the list. * - * Results: - * The return value is normally TCL_OK. If listPtr does not refer to a - * list object and can not be converted to one, TCL_ERROR is returned and - * an error message will be left in the interpreter's result if interp is - * not NULL. + * Value * - * Side effects: - * The ref counts of the objc elements in objv are incremented since the - * resulting list now refers to them. Similarly, the ref counts for - * replaced objects are decremented. listPtr is converted, if necessary, - * to a list object. listPtr's old string representation, if any, is - * freed. + * TCL_OK + * + * The first 'objc' values of 'objv' replaced 'count' elements in 'listPtr' + * starting at 'first'. If 'objc' 0, no new elements are added. + * + * TCL_ERROR + * + * 'listPtr' is not a valid list. An error message is left in the + * interpreter's result if 'interp' is not NULL. + * + * Effect + * + * If 'listPtr' is not of type 'tclListType', it is converted if possible. + * + * The 'refCount' of each element appended to the list is incremented. + * Similarly, the 'refCount' for each replaced element is decremented. + * + * If 'listPtr' is modified, any previous string representation is + * invalidated. * *---------------------------------------------------------------------- */ @@ -983,9 +971,9 @@ Tcl_ListObjReplace( ListGetIntRep(listPtr, listRepPtr); if (listRepPtr == NULL) { - int length; + size_t length; - (void) Tcl_GetStringFromObj(listPtr, &length); + (void) TclGetStringFromObj(listPtr, &length); if (length == 0) { if (objc == 0) { return TCL_OK; @@ -1047,18 +1035,18 @@ Tcl_ListObjReplace( List *newPtr = NULL; int attempt = 2 * numRequired; if (attempt <= LIST_MAX) { - newPtr = (List *)attemptckrealloc(listRepPtr, LIST_SIZE(attempt)); + newPtr = (List *)Tcl_AttemptRealloc(listRepPtr, LIST_SIZE(attempt)); } if (newPtr == NULL) { attempt = numRequired + 1 + TCL_MIN_ELEMENT_GROWTH; if (attempt > LIST_MAX) { attempt = LIST_MAX; } - newPtr = (List *)attemptckrealloc(listRepPtr, LIST_SIZE(attempt)); + newPtr = (List *)Tcl_AttemptRealloc(listRepPtr, LIST_SIZE(attempt)); } if (newPtr == NULL) { attempt = numRequired; - newPtr = (List *)attemptckrealloc(listRepPtr, LIST_SIZE(attempt)); + newPtr = (List *)Tcl_AttemptRealloc(listRepPtr, LIST_SIZE(attempt)); } if (newPtr) { listRepPtr = newPtr; @@ -1124,11 +1112,7 @@ Tcl_ListObjReplace( if (listRepPtr == NULL) { for (i = 0; i < objc; i++) { /* See bug 3598580 */ -#if TCL_MAJOR_VERSION > 8 Tcl_DecrRefCount(objv[i]); -#else - objv[i]->refCount--; -#endif } return TCL_ERROR; } @@ -1189,7 +1173,7 @@ Tcl_ListObjReplace( (size_t) numAfterLast * sizeof(Tcl_Obj *)); } - ckfree(oldListRepPtr); + Tcl_Free(oldListRepPtr); } } @@ -1226,22 +1210,19 @@ Tcl_ListObjReplace( * * TclLindexList -- * - * This procedure handles the 'lindex' command when objc==3. + * Implements the 'lindex' command when objc==3. * - * Results: - * Returns a pointer to the object extracted, or NULL if an error - * occurred. The returned object already includes one reference count for - * the pointer returned. + * Implemented entirely as a wrapper around 'TclLindexFlat'. Reconfigures + * the argument format into required form while taking care to manage + * shimmering so as to tend to keep the most useful intreps + * and/or avoid the most expensive conversions. * - * Side effects: - * None. + * Value * - * Notes: - * This procedure is implemented entirely as a wrapper around - * TclLindexFlat. All it does is reconfigure the argument format into the - * form required by TclLindexFlat, while taking care to manage shimmering - * in such a way that we tend to keep the most useful intreps and/or - * avoid the most expensive conversions. + * A pointer to the specified element, with its 'refCount' incremented, or + * NULL if an error occurred. + * + * Notes * *---------------------------------------------------------------------- */ @@ -1253,7 +1234,7 @@ TclLindexList( Tcl_Obj *argPtr) /* Index or index list. */ { - int index; /* Index into the list. */ + size_t index; /* Index into the list. */ Tcl_Obj *indexListCopy; List *listRepPtr; @@ -1265,7 +1246,7 @@ TclLindexList( ListGetIntRep(argPtr, listRepPtr); if ((listRepPtr == NULL) - && TclGetIntForIndexM(NULL , argPtr, INT_MAX - 1, &index) == TCL_OK) { + && TclGetIntForIndexM(NULL , argPtr, (size_t)WIDE_MAX - 1, &index) == TCL_OK) { /* * argPtr designates a single index. */ @@ -1308,25 +1289,20 @@ TclLindexList( /* *---------------------------------------------------------------------- * - * TclLindexFlat -- + * TclLindexFlat -- * - * This procedure is the core of the 'lindex' command, with all index - * arguments presented as a flat list. + * The core of the 'lindex' command, with all index + * arguments presented as a flat list. * - * Results: - * Returns a pointer to the object extracted, or NULL if an error - * occurred. The returned object already includes one reference count for - * the pointer returned. + * Value * - * Side effects: - * None. + * A pointer to the object extracted, with its 'refCount' incremented, or + * NULL if an error occurred. Thus, the calling code will usually do + * something like: + * + * Tcl_SetObjResult(interp, result); + * Tcl_DecrRefCount(result); * - * Notes: - * The reference count of the returned object includes one reference - * corresponding to the pointer returned. Thus, the calling code will - * usually do something like: - * Tcl_SetObjResult(interp, result); - * Tcl_DecrRefCount(result); * *---------------------------------------------------------------------- */ @@ -1344,7 +1320,8 @@ TclLindexFlat( Tcl_IncrRefCount(listPtr); for (i=0 ; i<indexCount && listPtr ; i++) { - int index, listLen = 0; + size_t index; + int listLen = 0; Tcl_Obj **elemPtrs = NULL, *sublistCopy; /* @@ -1368,14 +1345,14 @@ TclLindexFlat( if (TclGetIntForIndexM(interp, indexArray[i], /*endValue*/ listLen-1, &index) == TCL_OK) { - if (index<0 || index>=listLen) { + if (index >= (size_t)listLen) { /* * Index is out of range. Break out of loop with empty result. * First check remaining indices for validity */ while (++i < indexCount) { - if (TclGetIntForIndexM(interp, indexArray[i], INT_MAX - 1, &index) + if (TclGetIntForIndexM(interp, indexArray[i], (size_t)WIDE_MAX - 1, &index) != TCL_OK) { Tcl_DecrRefCount(sublistCopy); return NULL; @@ -1402,24 +1379,17 @@ TclLindexFlat( * * TclLsetList -- * - * Core of the 'lset' command when objc == 4. Objv[2] may be either a + * The core of [lset] when objc == 4. Objv[2] may be either a * scalar index or a list of indices. * It also handles 'lpop' when given a NULL value. * - * Results: - * Returns the new value of the list variable, or NULL if there was an - * error. The returned object includes one reference count for the - * pointer returned. + * Implemented entirely as a wrapper around 'TclLindexFlat', as described + * for 'TclLindexList'. * - * Side effects: - * None. + * Value * - * Notes: - * This procedure is implemented entirely as a wrapper around - * TclLsetFlat. All it does is reconfigure the argument format into the - * form required by TclLsetFlat, while taking care to manage shimmering - * in such a way that we tend to keep the most useful intreps and/or - * avoid the most expensive conversions. + * The new list, with the 'refCount' of 'valuPtr' incremented, or NULL if + * there was an error. * *---------------------------------------------------------------------- */ @@ -1434,7 +1404,7 @@ TclLsetList( int indexCount = 0; /* Number of indices in the index list. */ Tcl_Obj **indices = NULL; /* Vector of indices in the index list. */ Tcl_Obj *retValuePtr; /* Pointer to the list to be returned. */ - int index; /* Current index in the list - discarded. */ + size_t index; /* Current index in the list - discarded. */ Tcl_Obj *indexListCopy; List *listRepPtr; @@ -1446,7 +1416,7 @@ TclLsetList( ListGetIntRep(indexArgPtr, listRepPtr); if (listRepPtr == NULL - && TclGetIntForIndexM(NULL, indexArgPtr, INT_MAX - 1, &index) == TCL_OK) { + && TclGetIntForIndexM(NULL, indexArgPtr, (size_t)WIDE_MAX - 1, &index) == TCL_OK) { /* * indexArgPtr designates a single index. */ @@ -1484,36 +1454,39 @@ TclLsetList( * Core engine of the 'lset' command. * It also handles 'lpop' when given a NULL value. * - * Results: - * Returns the new value of the list variable, or NULL if an error - * occurred. The returned object includes one reference count for the - * pointer returned. + * Value * - * Side effects: - * On entry, the reference count of the variable value does not reflect - * any references held on the stack. The first action of this function is - * to determine whether the object is shared, and to duplicate it if it - * is. The reference count of the duplicate is incremented. At this - * point, the reference count will be 1 for either case, so that the - * object will appear to be unshared. - * - * If an error occurs, and the object has been duplicated, the reference - * count on the duplicate is decremented so that it is now 0: this - * dismisses any memory that was allocated by this function. - * - * If no error occurs, the reference count of the original object is - * incremented if the object has not been duplicated, and nothing is done - * to a reference count of the duplicate. Now the reference count of an - * unduplicated object is 2 (the returned pointer, plus the one stored in - * the variable). The reference count of a duplicate object is 1, - * reflecting that the returned pointer is the only active reference. The - * caller is expected to store the returned value back in the variable - * and decrement its reference count. (INST_STORE_* does exactly this.) - * - * Surgery is performed on the unshared list value to produce the result. - * TclLsetFlat maintains a linked list of Tcl_Obj's whose string + * The resulting list + * + * The 'refCount' of 'valuePtr' is incremented. If 'listPtr' was not + * duplicated, its 'refCount' is incremented. The reference count of + * an unduplicated object is therefore 2 (one for the returned pointer + * and one for the variable that holds it). The reference count of a + * duplicate object is 1, reflecting that result is the only active + * reference. The caller is expected to store the result in the + * variable and decrement its reference count. (INST_STORE_* does + * exactly this.) + * + * NULL + * + * An error occurred. If 'listPtr' was duplicated, the reference + * count on the duplicate is decremented so that it is 0, causing any + * memory allocated by this function to be freed. + * + * + * Effect + * + * On entry, the reference count of 'listPtr' does not reflect any + * references held on the stack. The first action of this function is to + * determine whether 'listPtr' is shared and to create a duplicate + * unshared copy if it is. The reference count of the duplicate is + * incremented. At this point, the reference count is 1 in either case so + * that the object is considered unshared. + * + * The unshared list is altered directly to produce the result. + * 'TclLsetFlat' maintains a linked list of 'Tcl_Obj' values whose string * representations must be spoilt by threading via 'ptr2' of the - * two-pointer internal representation. On entry to TclLsetFlat, the + * two-pointer internal representation. On entry to 'TclLsetFlat', the * values of 'ptr2' are immaterial; on exit, the 'ptr2' field of any * Tcl_Obj that has been modified is set to NULL. * @@ -1529,7 +1502,8 @@ TclLsetFlat( /* Index args. */ Tcl_Obj *valuePtr) /* Value arg to 'lset' or NULL to 'lpop'. */ { - int index, result, len; + size_t index; + int result, len; Tcl_Obj *subListPtr, *retValuePtr, *chainPtr; Tcl_ObjIntRep *irPtr; @@ -1602,8 +1576,8 @@ TclLsetFlat( } indexArray++; - if (index < 0 || index > elemCount - || (valuePtr == NULL && index >= elemCount)) { + if (index > (size_t)elemCount + || (valuePtr == NULL && index >= (size_t)elemCount)) { /* ...the index points outside the sublist. */ if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( @@ -1624,7 +1598,7 @@ TclLsetFlat( if (--indexCount) { parentList = subListPtr; - if (index == elemCount) { + if (index == (size_t)elemCount) { TclNewObj(subListPtr); } else { subListPtr = elemPtrs[index]; @@ -1642,7 +1616,7 @@ TclLsetFlat( * and store another copy. */ - if (index == elemCount) { + if (index == (size_t)elemCount) { Tcl_ListObjAppendElement(NULL, parentList, subListPtr); } else { TclListObjSetElement(NULL, parentList, index, subListPtr); @@ -1731,7 +1705,7 @@ TclLsetFlat( TclListObjLength(NULL, subListPtr, &len); if (valuePtr == NULL) { Tcl_ListObjReplace(NULL, subListPtr, index, 1, 0, NULL); - } else if (index == len) { + } else if (index == (size_t)len) { Tcl_ListObjAppendElement(NULL, subListPtr, valuePtr); } else { TclListObjSetElement(NULL, subListPtr, index, valuePtr); @@ -1746,26 +1720,38 @@ TclLsetFlat( * * TclListObjSetElement -- * - * Set a single element of a list to a specified value + * Set a single element of a list to a specified value. * - * Results: - * The return value is normally TCL_OK. If listPtr does not refer to a - * list object and cannot be converted to one, TCL_ERROR is returned and - * an error message will be left in the interpreter result if interp is - * not NULL. Similarly, if index designates an element outside the range - * [0..listLength-1], where listLength is the count of elements in the - * list object designated by listPtr, TCL_ERROR is returned and an error - * message is left in the interpreter result. + * It is the caller's responsibility to invalidate the string + * representation of the 'listPtr'. * - * Side effects: - * Tcl_Panic if listPtr designates a shared object. Otherwise, attempts - * to convert it to a list with a non-shared internal rep. Decrements the - * ref count of the object at the specified index within the list, - * replaces with the object designated by valuePtr, and increments the - * ref count of the replacement object. + * Value + * + * TCL_OK + * + * Success. + * + * TCL_ERROR + * + * 'listPtr' does not refer to a list object and cannot be converted + * to one. An error message will be left in the interpreter result if + * interp is not NULL. + * + * TCL_ERROR + * + * An index designates an element outside the range [0..listLength-1], + * where 'listLength' is the count of elements in the list object + * designated by 'listPtr'. An error message is left in the + * interpreter result. + * + * Effect + * + * If 'listPtr' designates a shared object, 'Tcl_Panic' is called. If + * 'listPtr' is not already of type 'tclListType', it is converted and the + * internal representation is unshared. The 'refCount' of the element at + * 'index' is decremented and replaced in the list with the 'valuePtr', + * whose 'refCount' in turn is incremented. * - * It is the caller's responsibility to invalidate the string - * representation of the object. * *---------------------------------------------------------------------- */ @@ -1795,9 +1781,10 @@ TclListObjSetElement( ListGetIntRep(listPtr, listRepPtr); if (listRepPtr == NULL) { - int result, length; + int result; + size_t length; - (void) Tcl_GetStringFromObj(listPtr, &length); + (void) TclGetStringFromObj(listPtr, &length); if (length == 0) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( @@ -1899,13 +1886,11 @@ TclListObjSetElement( * * FreeListInternalRep -- * - * Deallocate the storage associated with a list object's internal - * representation. + * Deallocate the storage associated with the internal representation of a + * a list object. * - * Results: - * None. + * Effect * - * Side effects: * Frees listPtr's List* internal representation, if no longer shared. * May decrement the ref counts of element objects, which may free them. * @@ -1928,7 +1913,7 @@ FreeListInternalRep( for (i = 0; i < numElems; i++) { Tcl_DecrRefCount(elemPtrs[i]); } - ckfree(listRepPtr); + Tcl_Free(listRepPtr); } } @@ -1937,14 +1922,12 @@ FreeListInternalRep( * * DupListInternalRep -- * - * Initialize the internal representation of a list Tcl_Obj to share the + * Initialize the internal representation of a list 'Tcl_Obj' to share the * internal representation of an existing list object. * - * Results: - * None. + * Effect * - * Side effects: - * The reference count of the List internal rep is incremented. + * The 'refCount' of the List internal rep is incremented. * *---------------------------------------------------------------------- */ @@ -1966,16 +1949,20 @@ DupListInternalRep( * * SetListFromAny -- * - * Attempt to generate a list internal form for the Tcl object "objPtr". + * Convert any object to a list. * - * Results: - * The return value is TCL_OK or TCL_ERROR. If an error occurs during - * conversion, an error message is left in the interpreter's result - * unless "interp" is NULL. + * Value + * + * TCL_OK + * + * Success. The internal representation of 'objPtr' is set, and the type + * of 'objPtr' is 'tclListType'. + * + * TCL_ERROR + * + * An error occured during conversion. An error message is left in the + * interpreter's result if 'interp' is not NULL. * - * Side effects: - * If no error occurs, a list is stored as "objPtr"s internal - * representation. * *---------------------------------------------------------------------- */ @@ -2031,7 +2018,8 @@ SetListFromAny( Tcl_DictObjNext(&search, &keyPtr, &valuePtr, &done); } } else { - int estCount, length; + int estCount; + size_t length; const char *limit, *nextElem = TclGetStringFromObj(objPtr, &length); /* @@ -2055,7 +2043,8 @@ SetListFromAny( while (nextElem < limit) { const char *elemStart; char *check; - int elemSize, literal; + size_t elemSize; + int literal; if (TCL_OK != TclFindElement(interp, nextElem, limit - nextElem, &elemStart, &nextElem, &elemSize, &literal)) { @@ -2063,7 +2052,7 @@ SetListFromAny( while (--elemPtrs >= &listRepPtr->elements) { Tcl_DecrRefCount(*elemPtrs); } - ckfree(listRepPtr); + Tcl_Free(listRepPtr); return TCL_ERROR; } if (elemStart == limit) { @@ -2108,18 +2097,16 @@ SetListFromAny( * * UpdateStringOfList -- * - * Update the string representation for a list object. Note: This - * function does not invalidate an existing old string rep so storage - * will be lost if this has not already been done. + * Update the string representation for a list object. * - * Results: - * None. + * Any previously-exising string representation is not invalidated, so + * storage is lost if this has not been taken care of. * - * Side effects: - * The object's string is set to a valid string that results from the - * list-to-string conversion. This string will be empty if the list has - * no elements. The list internal representation should not be NULL and - * we assume it is not NULL. + * Effect + * + * The string representation of 'listPtr' is set to the resulting string. + * This string will be empty if the list has no elements. It is assumed + * that the list internal representation is not NULL. * *---------------------------------------------------------------------- */ @@ -2130,7 +2117,8 @@ UpdateStringOfList( { # define LOCAL_SIZE 64 char localFlags[LOCAL_SIZE], *flagPtr = NULL; - int numElems, i, length, bytesNeeded = 0; + int numElems, i; + size_t length, bytesNeeded = 0; const char *elem, *start; char *dst; Tcl_Obj **elemPtrs; @@ -2170,19 +2158,13 @@ UpdateStringOfList( * We know numElems <= LIST_MAX, so this is safe. */ - flagPtr = (char *)ckalloc(numElems); + flagPtr = (char *)Tcl_Alloc(numElems); } elemPtrs = &listRepPtr->elements; for (i = 0; i < numElems; i++) { flagPtr[i] = (i ? TCL_DONT_QUOTE_HASH : 0); elem = TclGetStringFromObj(elemPtrs[i], &length); bytesNeeded += TclScanElement(elem, length, flagPtr+i); - if (bytesNeeded < 0) { - Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); - } - } - if (bytesNeeded > INT_MAX - numElems + 1) { - Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); } bytesNeeded += numElems - 1; @@ -2203,7 +2185,7 @@ UpdateStringOfList( (void) Tcl_InitStringRep(listPtr, NULL, dst - 1 - start); if (flagPtr != localFlags) { - ckfree(flagPtr); + Tcl_Free(flagPtr); } } diff --git a/generic/tclLiteral.c b/generic/tclLiteral.c index 22eff3c..e58125a 100644 --- a/generic/tclLiteral.c +++ b/generic/tclLiteral.c @@ -31,7 +31,7 @@ static int 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,7 +210,7 @@ TclCreateLiteral( * https://stackoverflow.com/q/54337750/301832 */ - int objLength; + size_t objLength; const char *objBytes = TclGetStringFromObj(objPtr, &objLength); if ((objLength == length) && ((length == 0) @@ -227,9 +227,9 @@ TclCreateLiteral( *globalPtrPtr = globalPtr; } if (flags & LITERAL_ON_HEAP) { - ckfree(bytes); + Tcl_Free((void *)bytes); } - if (globalPtr->refCount != (unsigned) -1) { + if (globalPtr->refCount != TCL_INDEX_NONE) { globalPtr->refCount++; } return objPtr; @@ -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 >= (size_t) envPtr->literalArrayNext) { return NULL; } return envPtr->literalArrayPtr[index].objPtr; @@ -394,7 +394,7 @@ TclRegisterLiteral( 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,7 +508,7 @@ LookupLiteralEntry( LiteralTable *globalTablePtr = &iPtr->literalTable; LiteralEntry *entryPtr; const char *bytes; - int length, globalHash; + size_t globalHash, length; bytes = TclGetStringFromObj(objPtr, &length); globalHash = (HashString(bytes, length) & globalTablePtr->mask); @@ -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; @@ -630,7 +628,7 @@ TclAddLiteralObj( lPtr = &envPtr->literalArrayPtr[objIndex]; lPtr->objPtr = objPtr; Tcl_IncrRefCount(objPtr); - lPtr->refCount = (unsigned) -1; /* i.e., unused */ + lPtr->refCount = TCL_INDEX_NONE; /* i.e., unused */ lPtr->nextPtr = NULL; if (litPtrPtr) { @@ -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++) { @@ -708,7 +706,7 @@ AddLocalLiteralEntry( if (!found) { bytes = TclGetStringFromObj(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,8 +826,7 @@ TclReleaseLiteral( LiteralTable *globalTablePtr; LiteralEntry *entryPtr, *prevPtr; const char *bytes; - int length; - unsigned int index; + size_t length, index; if (iPtr == NULL) { goto done; @@ -837,7 +834,7 @@ TclReleaseLiteral( globalTablePtr = &iPtr->literalTable; bytes = TclGetStringFromObj(objPtr, &length); - index = (HashString(bytes, length) & globalTablePtr->mask); + index = HashString(bytes, length) & globalTablePtr->mask; /* * Check to see if the object is in the global literal table and remove @@ -854,13 +851,13 @@ TclReleaseLiteral( * literal table entry (decrement the ref count of the object). */ - if ((entryPtr->refCount != (unsigned)-1) && (entryPtr->refCount-- <= 1)) { + if ((entryPtr->refCount != TCL_INDEX_NONE) && (entryPtr->refCount-- <= 1)) { if (prevPtr == NULL) { globalTablePtr->buckets[index] = entryPtr->nextPtr; } 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++) { @@ -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 != (unsigned)-1) { + if (localPtr->refCount != TCL_INDEX_NONE) { bytes = TclGetStringFromObj(localPtr->objPtr, &length); - Tcl_Panic("%s: local literal \"%.*s\" had bad refCount %u", + 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", + 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 0d331c6..5090493 100644 --- a/generic/tclLoad.c +++ b/generic/tclLoad.c @@ -131,7 +131,7 @@ Tcl_LoadObjCmd( const char *p, *fullFileName, *packageName; Tcl_LoadHandle loadHandle; Tcl_UniChar ch = 0; - unsigned len; + size_t len; int index, flags = 0; Tcl_Obj *const *savedobjv = objv; static const char *const options[] = { @@ -165,7 +165,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(&pkgName); Tcl_DStringInit(&initName); @@ -176,7 +176,7 @@ Tcl_LoadObjCmd( packageName = NULL; if (objc >= 3) { - packageName = Tcl_GetString(objv[2]); + packageName = TclGetString(objv[2]); if (packageName[0] == '\0') { packageName = NULL; } @@ -196,7 +196,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) { @@ -320,7 +320,7 @@ Tcl_LoadObjCmd( 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; @@ -396,12 +396,12 @@ Tcl_LoadObjCmd( * Create a new record to describe this package. */ - pkgPtr = (LoadedPackage *)ckalloc(sizeof(LoadedPackage)); + pkgPtr = (LoadedPackage *)Tcl_Alloc(sizeof(LoadedPackage)); len = strlen(fullFileName) + 1; - pkgPtr->fileName = (char *)ckalloc(len); + pkgPtr->fileName = (char *)Tcl_Alloc(len); memcpy(pkgPtr->fileName, fullFileName, len); len = Tcl_DStringLength(&pkgName) + 1; - pkgPtr->packageName = (char *)ckalloc(len); + pkgPtr->packageName = (char *)Tcl_Alloc(len); memcpy(pkgPtr->packageName, Tcl_DStringValue(&pkgName), len); pkgPtr->loadHandle = loadHandle; pkgPtr->initProc = initProc; @@ -465,19 +465,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; } @@ -503,7 +501,7 @@ Tcl_LoadObjCmd( */ ipFirstPtr = (InterpPackage *)Tcl_GetAssocData(target, "tclLoad", NULL); - ipPtr = (InterpPackage *)ckalloc(sizeof(InterpPackage)); + ipPtr = (InterpPackage *)Tcl_Alloc(sizeof(InterpPackage)); ipPtr->pkgPtr = pkgPtr; ipPtr->nextPtr = ipFirstPtr; Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc, ipPtr); @@ -561,7 +559,7 @@ Tcl_UnloadObjCmd( 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 @@ -601,13 +599,13 @@ Tcl_UnloadObjCmd( return TCL_ERROR; } - fullFileName = Tcl_GetString(objv[i]); + fullFileName = TclGetString(objv[i]); Tcl_DStringInit(&pkgName); Tcl_DStringInit(&tmp); packageName = NULL; if (objc - i >= 2) { - packageName = Tcl_GetString(objv[i+1]); + packageName = TclGetString(objv[i+1]); if (packageName[0] == '\0') { packageName = NULL; } @@ -627,7 +625,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) { @@ -887,10 +885,10 @@ Tcl_UnloadObjCmd( } Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc, ipFirstPtr); - ckfree(defaultPtr->fileName); - ckfree(defaultPtr->packageName); - ckfree(defaultPtr); - ckfree(ipPtr); + Tcl_Free(defaultPtr->fileName); + Tcl_Free(defaultPtr->packageName); + Tcl_Free(defaultPtr); + Tcl_Free(ipPtr); Tcl_MutexUnlock(&packageMutex); } else { code = TCL_ERROR; @@ -977,10 +975,10 @@ Tcl_StaticPackage( */ if (pkgPtr == NULL) { - pkgPtr = (LoadedPackage *)ckalloc(sizeof(LoadedPackage)); - pkgPtr->fileName = (char *)ckalloc(1); + pkgPtr = (LoadedPackage *)Tcl_Alloc(sizeof(LoadedPackage)); + pkgPtr->fileName = (char *)Tcl_Alloc(1); pkgPtr->fileName[0] = 0; - pkgPtr->packageName = (char *)ckalloc(strlen(pkgName) + 1); + pkgPtr->packageName = (char *)Tcl_Alloc(strlen(pkgName) + 1); strcpy(pkgPtr->packageName, pkgName); pkgPtr->loadHandle = NULL; pkgPtr->initProc = initProc; @@ -1010,7 +1008,7 @@ Tcl_StaticPackage( * loaded. */ - ipPtr = (InterpPackage *)ckalloc(sizeof(InterpPackage)); + ipPtr = (InterpPackage *)Tcl_Alloc(sizeof(InterpPackage)); ipPtr->pkgPtr = pkgPtr; ipPtr->nextPtr = ipFirstPtr; Tcl_SetAssocData(interp, "tclLoad", LoadCleanupProc, ipPtr); @@ -1142,7 +1140,7 @@ LoadCleanupProc( ipPtr = (InterpPackage *)clientData; while (ipPtr != NULL) { nextPtr = ipPtr->nextPtr; - ckfree(ipPtr); + Tcl_Free(ipPtr); ipPtr = nextPtr; } } @@ -1193,9 +1191,9 @@ TclFinalizeLoad(void) } #endif - ckfree(pkgPtr->fileName); - ckfree(pkgPtr->packageName); - ckfree(pkgPtr); + Tcl_Free(pkgPtr->fileName); + Tcl_Free(pkgPtr->packageName); + Tcl_Free(pkgPtr); } } diff --git a/generic/tclMain.c b/generic/tclMain.c index cc9a829..89bb8ec 100644 --- a/generic/tclMain.c +++ b/generic/tclMain.c @@ -199,7 +199,7 @@ Tcl_GetStartupScript( if (tsdPtr->encoding == NULL) { *encodingPtr = NULL; } else { - *encodingPtr = Tcl_GetString(tsdPtr->encoding); + *encodingPtr = TclGetString(tsdPtr->encoding); } } return tsdPtr->path; @@ -250,7 +250,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) { @@ -283,7 +283,7 @@ Tcl_SourceRCFile( *---------------------------------------------------------------------- */ -void +TCL_NORETURN void Tcl_MainEx( int argc, /* Number of arguments. */ TCHAR **argv, /* Array of argument strings. */ @@ -327,7 +327,7 @@ Tcl_MainEx( && ('-' != argv[3][0])) { Tcl_Obj *value = NewNativeObj(argv[2]); Tcl_SetStartupScript(NewNativeObj(argv[3]), - Tcl_GetString(value)); + TclGetString(value)); Tcl_DecrRefCount(value); argc -= 3; argv += 3; @@ -451,7 +451,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); @@ -472,7 +472,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 @@ -516,7 +516,7 @@ Tcl_MainEx( * error messages troubles deeper in, so lop it back off. */ - TclGetStringFromObj(is.commandPtr, &length); + (void)TclGetStringFromObj(is.commandPtr, &length); Tcl_SetObjLength(is.commandPtr, --length); code = Tcl_RecordAndEvalObj(interp, is.commandPtr, TCL_EVAL_GLOBAL); @@ -533,7 +533,7 @@ Tcl_MainEx( } else if (is.tty) { resultPtr = Tcl_GetObjResult(interp); Tcl_IncrRefCount(resultPtr); - TclGetStringFromObj(resultPtr, &length); + (void)TclGetStringFromObj(resultPtr, &length); chan = Tcl_GetStdChannel(TCL_STDOUT); if ((length > 0) && chan) { Tcl_WriteObj(chan, resultPtr); @@ -736,7 +736,8 @@ StdinProc( ClientData clientData, /* The state of interactive cmd line */ TCL_UNUSED(int) /*mask*/) { - int code, length; + int code; + size_t length; InteractiveState *isPtr = (InteractiveState *)clientData; Tcl_Channel chan = isPtr->input; Tcl_Obj *commandPtr = isPtr->commandPtr; @@ -748,7 +749,7 @@ StdinProc( Tcl_IncrRefCount(commandPtr); } length = Tcl_GetsObj(chan, commandPtr); - if (length < 0) { + if (length == TCL_INDEX_NONE) { if (Tcl_InputBlocked(chan)) { return; } @@ -776,7 +777,7 @@ StdinProc( goto prompt; } isPtr->prompt = PROMPT_START; - TclGetStringFromObj(commandPtr, &length); + (void)TclGetStringFromObj(commandPtr, &length); Tcl_SetObjLength(commandPtr, --length); /* @@ -808,7 +809,7 @@ StdinProc( chan = Tcl_GetStdChannel(TCL_STDOUT); Tcl_IncrRefCount(resultPtr); - TclGetStringFromObj(resultPtr, &length); + (void)TclGetStringFromObj(resultPtr, &length); if ((length > 0) && (chan != NULL)) { Tcl_WriteObj(chan, resultPtr); Tcl_WriteChars(chan, "\n", 1); diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index e493db1..8e71271 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 @@ -391,7 +391,7 @@ Tcl_PopCallFrame( if (framePtr->varTablePtr != NULL) { TclDeleteVars(iPtr, framePtr->varTablePtr); - ckfree(framePtr->varTablePtr); + Tcl_Free(framePtr->varTablePtr); framePtr->varTablePtr = NULL; } if (framePtr->numCompiledLocals > 0) { @@ -409,9 +409,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; @@ -665,7 +664,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 +764,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 +854,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); @@ -1002,7 +1002,7 @@ Tcl_DeleteNamespace( * 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( @@ -1041,7 +1041,7 @@ Tcl_DeleteNamespace( #else if (nsPtr->childTablePtr != NULL) { Tcl_DeleteHashTable(nsPtr->childTablePtr); - ckfree(nsPtr->childTablePtr); + Tcl_Free(nsPtr->childTablePtr); } #endif Tcl_DeleteHashTable(&nsPtr->cmdTable); @@ -1103,7 +1103,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 @@ -1124,7 +1124,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); @@ -1196,7 +1196,7 @@ TclTeardownNamespace( #ifndef BREAK_NAMESPACE_COMPAT while (nsPtr->childTable.numEntries > 0) { - int length = nsPtr->childTable.numEntries; + size_t length = nsPtr->childTable.numEntries; Namespace **children = (Namespace **)TclStackAlloc((Tcl_Interp *) iPtr, sizeof(Namespace *) * length); @@ -1217,7 +1217,7 @@ TclTeardownNamespace( #else if (nsPtr->childTablePtr != NULL) { while (nsPtr->childTablePtr->numEntries > 0) { - int length = nsPtr->childTablePtr->numEntries; + size_t length = nsPtr->childTablePtr->numEntries; Namespace **children = (Namespace **)TclStackAlloc((Tcl_Interp *) iPtr, sizeof(Namespace *) * length); @@ -1244,9 +1244,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; @@ -1298,9 +1298,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); } /* @@ -1369,7 +1369,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. @@ -1389,9 +1389,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; @@ -1438,7 +1438,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); } @@ -1447,7 +1447,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; @@ -1496,7 +1496,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. @@ -1698,7 +1699,7 @@ DoImport( Namespace *importNsPtr, int allowOverwrite) { - int i = 0, exported = 0; + size_t i = 0, exported = 0; Tcl_HashEntry *found; /* @@ -1765,7 +1766,7 @@ DoImport( } } - dataPtr = (ImportedCmdData *)ckalloc(sizeof(ImportedCmdData)); + dataPtr = (ImportedCmdData *)Tcl_Alloc(sizeof(ImportedCmdData)); importedCmd = Tcl_NRCreateCommand(interp, Tcl_DStringValue(&ds), TclInvokeImportedCmd, InvokeImportedNRCmd, dataPtr, DeleteImportedCmd); @@ -1781,7 +1782,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; @@ -2078,9 +2079,9 @@ DeleteImportedCmd( } else { prevPtr->nextPtr = refPtr->nextPtr; } - ckfree(refPtr); + Tcl_Free(refPtr); TclCleanupCommandMacro(realCmdPtr); - ckfree(dataPtr); + Tcl_Free(dataPtr); return; } prevPtr = refPtr; @@ -2610,7 +2611,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, @@ -3037,7 +3038,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; @@ -3117,7 +3118,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"); @@ -3430,15 +3431,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))); } @@ -3559,7 +3560,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++; @@ -3570,7 +3571,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; } @@ -4011,7 +4012,8 @@ NamespacePathCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { Namespace *nsPtr = (Namespace *) TclGetCurrentNamespace(interp); - int i, nsObjc, result = TCL_ERROR; + size_t i; + int nsObjc, result = TCL_ERROR; Tcl_Obj **nsObjv; Tcl_Namespace **namespaceList = NULL; @@ -4049,7 +4051,7 @@ NamespacePathCmd( namespaceList = (Tcl_Namespace **)TclStackAlloc(interp, sizeof(Tcl_Namespace *) * nsObjc); - for (i=0 ; i<nsObjc ; i++) { + for (i=0 ; i<(size_t)nsObjc ; i++) { if (TclGetNamespaceFromObj(interp, nsObjv[i], &namespaceList[i]) != TCL_OK) { goto badNamespace; @@ -4094,13 +4096,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]; @@ -4151,7 +4153,7 @@ static void UnlinkNsPath( Namespace *nsPtr) { - int i; + size_t i; for (i=0 ; i<nsPtr->commandPathLength ; i++) { NamespacePathEntry *nsPathPtr = &nsPtr->commandPathArray[i]; @@ -4167,7 +4169,7 @@ UnlinkNsPath( } } } - ckfree(nsPtr->commandPathArray); + Tcl_Free(nsPtr->commandPathArray); } /* @@ -4237,7 +4239,7 @@ NamespaceQualifiersCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { const char *name, *p; - int length; + size_t length; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "string"); @@ -4715,7 +4717,7 @@ FreeNsNameInternalRep( */ TclNsDecrRefCount(resNamePtr->nsPtr); - ckfree(resNamePtr); + Tcl_Free(resNamePtr); } } @@ -4802,7 +4804,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; @@ -4862,7 +4864,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; @@ -4898,8 +4900,8 @@ TclLogCommandInfo( * 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 - * all bytes up to first null byte). */ + size_t length, /* Number of bytes in command (-1 means + * use all bytes up to first null byte). */ const unsigned char *pc, /* Current pc of bytecode execution context */ Tcl_Obj **tosPtr) /* Current stack of bytecode execution * context */ @@ -4930,14 +4932,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, @@ -5055,7 +5057,7 @@ void TclErrorStackResetIf( Tcl_Interp *interp, const char *msg, - int length) + size_t length) { Interp *iPtr = (Interp *) interp; @@ -5110,7 +5112,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 65b4197..2f13710 100644 --- a/generic/tclNotify.c +++ b/generic/tclNotify.c @@ -181,7 +181,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; @@ -276,7 +276,7 @@ Tcl_CreateEventSource( * 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; @@ -330,7 +330,7 @@ Tcl_DeleteEventSource( } else { prevPtr->nextPtr = sourcePtr->nextPtr; } - ckfree(sourcePtr); + Tcl_Free(sourcePtr); return; } } @@ -355,7 +355,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. */ Tcl_QueuePosition position) /* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD, @@ -387,7 +387,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. */ Tcl_QueuePosition position) /* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD, @@ -412,7 +412,7 @@ Tcl_ThreadQueueEvent( if (tsdPtr) { QueueEvent(tsdPtr, evPtr, position); } else { - ckfree(evPtr); + Tcl_Free(evPtr); } Tcl_MutexUnlock(&listLock); } @@ -444,7 +444,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. */ Tcl_QueuePosition position) /* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD, @@ -563,7 +563,7 @@ Tcl_DeleteEvents( hold = evPtr; evPtr = evPtr->nextPtr; - ckfree(hold); + Tcl_Free(hold); } else { /* * Event is to be retained. @@ -702,7 +702,7 @@ Tcl_ServiceEvent( } } if (evPtr) { - ckfree(evPtr); + Tcl_Free(evPtr); } Tcl_MutexUnlock(&(tsdPtr->queueMutex)); return 1; diff --git a/generic/tclOO.c b/generic/tclOO.c index b60ab1f..0f0cc96 100644 --- a/generic/tclOO.c +++ b/generic/tclOO.c @@ -297,7 +297,7 @@ 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; @@ -320,7 +320,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>"); @@ -462,7 +462,7 @@ InitClassSystemRoots( */ fPtr->objectCls->superclasses.num = 0; - ckfree(fPtr->objectCls->superclasses.list); + Tcl_Free(fPtr->objectCls->superclasses.list); fPtr->objectCls->superclasses.list = NULL; /* @@ -580,7 +580,7 @@ KillFoundation( TclOODecrRefCount(fPtr->objectCls->thisPtr); TclOODecrRefCount(fPtr->classCls->thisPtr); - ckfree(fPtr); + Tcl_Free(fPtr); } /* @@ -618,9 +618,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)); /* @@ -647,7 +647,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; @@ -731,7 +731,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; @@ -885,7 +885,7 @@ TclOODeleteDescendants( } } if (clsPtr->mixinSubs.size > 0) { - ckfree(clsPtr->mixinSubs.list); + Tcl_Free(clsPtr->mixinSubs.list); clsPtr->mixinSubs.size = 0; } @@ -905,7 +905,7 @@ TclOODeleteDescendants( } } if (clsPtr->subclasses.size > 0) { - ckfree(clsPtr->subclasses.list); + Tcl_Free(clsPtr->subclasses.list); clsPtr->subclasses.list = NULL; clsPtr->subclasses.size = 0; } @@ -930,7 +930,7 @@ TclOODeleteDescendants( } } if (clsPtr->instances.size > 0) { - ckfree(clsPtr->instances.list); + Tcl_Free(clsPtr->instances.list); clsPtr->instances.list = NULL; clsPtr->instances.size = 0; } @@ -1006,7 +1006,7 @@ TclOOReleaseClassContents( TclOODeleteChain(callPtr); } Tcl_DeleteHashTable(clsPtr->classChainCache); - ckfree(clsPtr->classChainCache); + Tcl_Free(clsPtr->classChainCache); clsPtr->classChainCache = NULL; } @@ -1020,7 +1020,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; } @@ -1037,7 +1037,7 @@ TclOOReleaseClassContents( metadataTypePtr->deleteProc(value); } Tcl_DeleteHashTable(clsPtr->metadataPtr); - ckfree(clsPtr->metadataPtr); + Tcl_Free(clsPtr->metadataPtr); clsPtr->metadataPtr = NULL; } @@ -1046,7 +1046,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; } @@ -1056,7 +1056,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; } @@ -1072,7 +1072,7 @@ TclOOReleaseClassContents( TclDecrRefCount(variableObj); } if (i) { - ckfree(clsPtr->variables.list); + Tcl_Free(clsPtr->variables.list); } FOREACH_STRUCT(privateVariable, clsPtr->privateVariables) { @@ -1080,7 +1080,7 @@ TclOOReleaseClassContents( TclDecrRefCount(privateVariable->fullNameObj); } if (i) { - ckfree(clsPtr->privateVariables.list); + Tcl_Free(clsPtr->privateVariables.list); } if (IsRootClass(oPtr) && !Destructing(fPtr->objectCls->thisPtr)) { @@ -1212,7 +1212,7 @@ ObjectNamespaceDeleted( TclOODecrRefCount(mixinPtr->thisPtr); } if (oPtr->mixins.list != NULL) { - ckfree(oPtr->mixins.list); + Tcl_Free(oPtr->mixins.list); } } @@ -1220,7 +1220,7 @@ ObjectNamespaceDeleted( TclDecrRefCount(filterObj); } if (i) { - ckfree(oPtr->filters.list); + Tcl_Free(oPtr->filters.list); } if (oPtr->methodsPtr) { @@ -1228,14 +1228,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) { @@ -1243,7 +1243,7 @@ ObjectNamespaceDeleted( TclDecrRefCount(privateVariable->fullNameObj); } if (i) { - ckfree(oPtr->privateVariables.list); + Tcl_Free(oPtr->privateVariables.list); } if (oPtr->chainCache) { @@ -1260,7 +1260,7 @@ ObjectNamespaceDeleted( metadataTypePtr->deleteProc(value); } Tcl_DeleteHashTable(oPtr->metadataPtr); - ckfree(oPtr->metadataPtr); + Tcl_Free(oPtr->metadataPtr); oPtr->metadataPtr = NULL; } @@ -1316,9 +1316,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; @@ -1390,9 +1390,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); } } @@ -1429,7 +1429,7 @@ TclOORemoveFromMixins( } } if (oPtr->mixins.num == 0) { - ckfree(oPtr->mixins.list); + Tcl_Free(oPtr->mixins.list); oPtr->mixins.list = NULL; } return res; @@ -1489,9 +1489,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); } } @@ -1554,9 +1554,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); } } @@ -1602,7 +1602,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; @@ -1619,7 +1619,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); @@ -1969,7 +1969,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) { @@ -2070,11 +2070,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); @@ -2125,7 +2125,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) { @@ -2368,7 +2368,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); } @@ -2448,7 +2448,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); } diff --git a/generic/tclOO.decls b/generic/tclOO.decls index f1bb320..ed7b800 100644 --- a/generic/tclOO.decls +++ b/generic/tclOO.decls @@ -51,7 +51,7 @@ declare 8 { } declare 9 { int Tcl_MethodIsType(Tcl_Method method, const Tcl_MethodType *typePtr, - ClientData *clientDataPtr) + void **clientDataPtr) } declare 10 { Tcl_Obj *Tcl_MethodName(Tcl_Method method) @@ -59,12 +59,12 @@ declare 10 { declare 11 { Tcl_Method Tcl_NewInstanceMethod(Tcl_Interp *interp, Tcl_Object object, Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr, - ClientData clientData) + void *clientData) } declare 12 { Tcl_Method Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls, Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr, - ClientData clientData) + void *clientData) } declare 13 { Tcl_Object Tcl_NewObjectInstance(Tcl_Interp *interp, Tcl_Class cls, @@ -87,20 +87,20 @@ declare 18 { int Tcl_ObjectContextSkippedArgs(Tcl_ObjectContext context) } declare 19 { - ClientData Tcl_ClassGetMetadata(Tcl_Class clazz, + void *Tcl_ClassGetMetadata(Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr) } declare 20 { void Tcl_ClassSetMetadata(Tcl_Class clazz, - const Tcl_ObjectMetadataType *typePtr, ClientData metadata) + const Tcl_ObjectMetadataType *typePtr, void *metadata) } declare 21 { - ClientData Tcl_ObjectGetMetadata(Tcl_Object object, + void *Tcl_ObjectGetMetadata(Tcl_Object object, const Tcl_ObjectMetadataType *typePtr) } declare 22 { void Tcl_ObjectSetMetadata(Tcl_Object object, - const Tcl_ObjectMetadataType *typePtr, ClientData metadata) + const Tcl_ObjectMetadataType *typePtr, void *metadata) } declare 23 { int Tcl_ObjectContextInvokeNext(Tcl_Interp *interp, @@ -144,14 +144,14 @@ declare 0 { declare 1 { Tcl_Method TclOOMakeProcInstanceMethod(Tcl_Interp *interp, Object *oPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, - const Tcl_MethodType *typePtr, ClientData clientData, + const Tcl_MethodType *typePtr, void *clientData, Proc **procPtrPtr) } declare 2 { Tcl_Method TclOOMakeProcMethod(Tcl_Interp *interp, Class *clsPtr, int flags, Tcl_Obj *nameObj, const char *namePtr, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr, - ClientData clientData, Proc **procPtrPtr) + void *clientData, Proc **procPtrPtr) } declare 3 { Method *TclOONewProcInstanceMethod(Tcl_Interp *interp, Object *oPtr, @@ -182,13 +182,13 @@ declare 9 { Tcl_Method TclOONewProcInstanceMethodEx(Tcl_Interp *interp, Tcl_Object oPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, ProcErrorProc *errProc, - ClientData clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, + void *clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr) } declare 10 { Tcl_Method TclOONewProcMethodEx(Tcl_Interp *interp, Tcl_Class clsPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, - ProcErrorProc *errProc, ClientData clientData, Tcl_Obj *nameObj, + ProcErrorProc *errProc, void *clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr) } diff --git a/generic/tclOO.h b/generic/tclOO.h index 9c1dd1e..4a3398f 100644 --- a/generic/tclOO.h +++ b/generic/tclOO.h @@ -60,12 +60,12 @@ typedef struct Tcl_ObjectContext_ *Tcl_ObjectContext; * and to allow the attachment of arbitrary data to objects and classes. */ -typedef int (Tcl_MethodCallProc)(ClientData clientData, Tcl_Interp *interp, +typedef int (Tcl_MethodCallProc)(void *clientData, Tcl_Interp *interp, Tcl_ObjectContext objectContext, int objc, Tcl_Obj *const *objv); -typedef void (Tcl_MethodDeleteProc)(ClientData clientData); -typedef int (Tcl_CloneProc)(Tcl_Interp *interp, ClientData oldClientData, - ClientData *newClientData); -typedef void (Tcl_ObjectMetadataDeleteProc)(ClientData clientData); +typedef void (Tcl_MethodDeleteProc)(void *clientData); +typedef int (Tcl_CloneProc)(Tcl_Interp *interp, void *oldClientData, + void **newClientData); +typedef void (Tcl_ObjectMetadataDeleteProc)(void *clientData); typedef int (Tcl_ObjectMapMethodNameProc)(Tcl_Interp *interp, Tcl_Object object, Tcl_Class *startClsPtr, Tcl_Obj *methodNameObj); @@ -95,7 +95,7 @@ typedef struct { /* * The correct value for the version field of the Tcl_MethodType structure. * This allows new versions of the structure to be introduced without breaking - * binary compatability. + * binary compatibility. */ #define TCL_OO_METHOD_VERSION_CURRENT 1 @@ -131,7 +131,7 @@ typedef struct { /* * The correct value for the version field of the Tcl_ObjectMetadataType * structure. This allows new versions of the structure to be introduced - * without breaking binary compatability. + * without breaking binary compatibility. */ #define TCL_OO_METADATA_VERSION_CURRENT 1 diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c index 19f68fc..6f277f7 100644 --- a/generic/tclOOBasic.c +++ b/generic/tclOOBasic.c @@ -108,7 +108,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 +154,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; @@ -183,7 +183,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 @@ -208,7 +208,7 @@ TclOO_Class_Create( "objectName ?arg ...?"); return TCL_ERROR; } - objName = Tcl_GetStringFromObj( + objName = TclGetStringFromObj( objv[Tcl_ObjectContextSkippedArgs(context)], &len); if (len == 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj( @@ -248,7 +248,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 @@ -273,7 +273,7 @@ TclOO_Class_CreateNs( "objectName namespaceName ?arg ...?"); return TCL_ERROR; } - objName = Tcl_GetStringFromObj( + objName = TclGetStringFromObj( objv[Tcl_ObjectContextSkippedArgs(context)], &len); if (len == 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj( @@ -281,7 +281,7 @@ TclOO_Class_CreateNs( Tcl_SetErrorCode(interp, "TCL", "OO", "EMPTY_NAME", NULL); return TCL_ERROR; } - nsName = Tcl_GetStringFromObj( + nsName = TclGetStringFromObj( objv[Tcl_ObjectContextSkippedArgs(context)+1], &len); if (len == 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj( @@ -605,7 +605,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); @@ -744,7 +744,7 @@ TclOO_Object_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. @@ -781,8 +781,8 @@ TclOO_Object_VarName( 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 +803,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; } diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c index 9191989..276eda8 100644 --- a/generic/tclOOCall.c +++ b/generic/tclOOCall.c @@ -205,7 +205,7 @@ TclOODeleteChainCache( } } Tcl_DeleteHashTable(tablePtr); - ckfree(tablePtr); + Tcl_Free(tablePtr); } /* @@ -226,9 +226,9 @@ TclOODeleteChain( return; } if (callPtr->chain != callPtr->staticChain) { - ckfree(callPtr->chain); + Tcl_Free(callPtr->chain); } - ckfree(callPtr); + Tcl_Free(callPtr); } /* @@ -589,13 +589,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 @@ -613,7 +613,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) { @@ -635,7 +635,7 @@ SortMethodNames( } *stringsPtr = strings; } else { - ckfree(strings); + Tcl_Free((void *)strings); *stringsPtr = NULL; } return i; @@ -913,7 +913,7 @@ AddSimpleChainToCallContext( flags | TRAVERSED_MIXIN, filterDecl); } if (oPtr->methodsPtr && !blockedUnexported) { - hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char*) methodNameObj); + hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *)methodNameObj); if (hPtr != NULL) { mPtr = (Method *)Tcl_GetHashValue(hPtr); if (!IS_PRIVATE(mPtr)) { @@ -1037,11 +1037,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; @@ -1230,7 +1230,7 @@ TclOOGetCallContext( doFilters = 1; } - callPtr = (CallChain *)ckalloc(sizeof(CallChain)); + callPtr = (CallChain *)Tcl_Alloc(sizeof(CallChain)); InitCallChain(callPtr, oPtr, flags); cb.callChainPtr = callPtr; @@ -1248,7 +1248,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; @@ -1325,7 +1325,7 @@ 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; @@ -1335,7 +1335,7 @@ TclOOGetCallContext( 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); } @@ -1343,7 +1343,7 @@ TclOOGetCallContext( (char *) methodNameObj, &i); } 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); } @@ -1450,7 +1450,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; @@ -1497,7 +1497,7 @@ 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; @@ -1505,7 +1505,7 @@ TclOOGetStereotypeCallChain( } else { if (hPtr == NULL) { 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, @@ -1924,7 +1924,7 @@ TclOOGetDefineContextNamespace( Tcl_ResetResult(interp); } if (define.list != staticSpace) { - ckfree(define.list); + Tcl_Free(define.list); } return nsPtr; } @@ -2089,11 +2089,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 928d07e..9e47852 100644 --- a/generic/tclOODecls.h +++ b/generic/tclOODecls.h @@ -53,19 +53,19 @@ TCLAPI int Tcl_MethodIsPublic(Tcl_Method method); /* 9 */ TCLAPI int Tcl_MethodIsType(Tcl_Method method, const Tcl_MethodType *typePtr, - ClientData *clientDataPtr); + void **clientDataPtr); /* 10 */ TCLAPI Tcl_Obj * Tcl_MethodName(Tcl_Method method); /* 11 */ TCLAPI Tcl_Method Tcl_NewInstanceMethod(Tcl_Interp *interp, Tcl_Object object, Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr, - ClientData clientData); + void *clientData); /* 12 */ TCLAPI Tcl_Method Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls, Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr, - ClientData clientData); + void *clientData); /* 13 */ TCLAPI Tcl_Object Tcl_NewObjectInstance(Tcl_Interp *interp, Tcl_Class cls, const char *nameStr, @@ -84,19 +84,19 @@ TCLAPI Tcl_Object Tcl_ObjectContextObject(Tcl_ObjectContext context); TCLAPI int Tcl_ObjectContextSkippedArgs( Tcl_ObjectContext context); /* 19 */ -TCLAPI ClientData Tcl_ClassGetMetadata(Tcl_Class clazz, +TCLAPI void * Tcl_ClassGetMetadata(Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr); /* 20 */ TCLAPI void Tcl_ClassSetMetadata(Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr, - ClientData metadata); + void *metadata); /* 21 */ -TCLAPI ClientData Tcl_ObjectGetMetadata(Tcl_Object object, +TCLAPI void * Tcl_ObjectGetMetadata(Tcl_Object object, const Tcl_ObjectMetadataType *typePtr); /* 22 */ TCLAPI void Tcl_ObjectSetMetadata(Tcl_Object object, const Tcl_ObjectMetadataType *typePtr, - ClientData metadata); + void *metadata); /* 23 */ TCLAPI int Tcl_ObjectContextInvokeNext(Tcl_Interp *interp, Tcl_ObjectContext context, int objc, @@ -136,20 +136,20 @@ typedef struct TclOOStubs { Tcl_Class (*tcl_MethodDeclarerClass) (Tcl_Method method); /* 6 */ Tcl_Object (*tcl_MethodDeclarerObject) (Tcl_Method method); /* 7 */ int (*tcl_MethodIsPublic) (Tcl_Method method); /* 8 */ - int (*tcl_MethodIsType) (Tcl_Method method, const Tcl_MethodType *typePtr, ClientData *clientDataPtr); /* 9 */ + int (*tcl_MethodIsType) (Tcl_Method method, const Tcl_MethodType *typePtr, void **clientDataPtr); /* 9 */ 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, ClientData clientData); /* 11 */ - Tcl_Method (*tcl_NewMethod) (Tcl_Interp *interp, Tcl_Class cls, Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr, ClientData clientData); /* 12 */ + Tcl_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 */ 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 */ - ClientData (*tcl_ClassGetMetadata) (Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr); /* 19 */ - void (*tcl_ClassSetMetadata) (Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr, ClientData metadata); /* 20 */ - ClientData (*tcl_ObjectGetMetadata) (Tcl_Object object, const Tcl_ObjectMetadataType *typePtr); /* 21 */ - void (*tcl_ObjectSetMetadata) (Tcl_Object object, const Tcl_ObjectMetadataType *typePtr, ClientData metadata); /* 22 */ + 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 */ Tcl_ObjectMapMethodNameProc * (*tcl_ObjectGetMethodNameMapper) (Tcl_Object object); /* 24 */ void (*tcl_ObjectSetMethodNameMapper) (Tcl_Object object, Tcl_ObjectMapMethodNameProc *mapMethodNameProc); /* 25 */ diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c index e1d88ec..b7c3cda 100644 --- a/generic/tclOODefineCmds.c +++ b/generic/tclOODefineCmds.c @@ -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]; @@ -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]; @@ -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; @@ -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); @@ -500,11 +500,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 +525,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); } @@ -551,12 +551,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 +570,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 +583,7 @@ InstallPrivateVariableMapping( */ if (n != varc) { - pvlPtr->list = (PrivateVariableMapping *)ckrealloc(pvlPtr->list, + pvlPtr->list = (PrivateVariableMapping *)Tcl_Realloc(pvlPtr->list, sizeof(PrivateVariableMapping) * n); } Tcl_DeleteHashTable(&uniqueTable); @@ -703,7 +703,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) { @@ -777,7 +777,7 @@ FindCommand( Tcl_Obj *stringObj, Tcl_Namespace *const namespacePtr) { - int length; + size_t length; const char *nameStr, *string = TclGetStringFromObj(stringObj, &length); Namespace *const nsPtr = (Namespace *) namespacePtr; FOREACH_HASH_DECLS; @@ -996,16 +996,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; + 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))); } @@ -1496,8 +1496,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); } @@ -1532,7 +1532,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 +1550,7 @@ TclOODefineConstructorObjCmd( } clsPtr = oPtr->classPtr; - TclGetStringFromObj(objv[2], &bodyLength); + (void)TclGetStringFromObj(objv[2], &bodyLength); if (bodyLength > 0) { /* * Create the method structure. @@ -1638,7 +1638,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]); @@ -1743,7 +1743,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 +1756,7 @@ TclOODefineDestructorObjCmd( } clsPtr = oPtr->classPtr; - TclGetStringFromObj(objv[1], &bodyLength); + (void)TclGetStringFromObj(objv[1], &bodyLength); if (bodyLength > 0) { /* * Create the method structure. @@ -1841,19 +1841,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, (char *)objv[i], &isNew); } else { - hPtr = Tcl_CreateHashEntry(&clsPtr->classMethods, (char*) objv[i], + hPtr = Tcl_CreateHashEntry(&clsPtr->classMethods, (char *)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 +2154,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, (char *)objv[i], &isNew); } else { - hPtr = Tcl_CreateHashEntry(&clsPtr->classMethods, (char*) objv[i], + hPtr = Tcl_CreateHashEntry(&clsPtr->classMethods, (char *)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]; @@ -2575,7 +2575,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 +2585,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 +2617,7 @@ ClassSuperSet( for (; i-- > 0 ;) { TclOODecrRefCount(superclasses[i]->thisPtr); } - ckfree(superclasses); + Tcl_Free(superclasses); return TCL_ERROR; } @@ -2642,7 +2642,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; diff --git a/generic/tclOOInfo.c b/generic/tclOOInfo.c index c9e136c..c80b92f 100644 --- a/generic/tclOOInfo.c +++ b/generic/tclOOInfo.c @@ -612,7 +612,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) { @@ -816,7 +816,7 @@ InfoObjectVariablesCmd( 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; @@ -1366,7 +1366,7 @@ InfoClassMethodsCmd( Tcl_NewStringObj(names[i], -1)); } if (numNames > 0) { - ckfree(names); + Tcl_Free((void *)names); } } else { FOREACH_HASH_DECLS; @@ -1595,7 +1595,7 @@ InfoClassVariablesCmd( 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 007cbfd..848c912 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; @@ -65,12 +65,12 @@ typedef struct Method { * tuned in their behaviour. */ -typedef int (TclOO_PreCallProc)(ClientData clientData, Tcl_Interp *interp, +typedef int (TclOO_PreCallProc)(void *clientData, Tcl_Interp *interp, Tcl_ObjectContext context, Tcl_CallFrame *framePtr, int *isFinished); -typedef int (TclOO_PostCallProc)(ClientData clientData, Tcl_Interp *interp, +typedef int (TclOO_PostCallProc)(void *clientData, Tcl_Interp *interp, Tcl_ObjectContext context, Tcl_Namespace *namespacePtr, int result); -typedef void (TclOO_PmCDDeleteProc)(ClientData clientData); -typedef ClientData (TclOO_PmCDCloneProc)(ClientData clientData); +typedef void (TclOO_PmCDDeleteProc)(void *clientData); +typedef void *(TclOO_PmCDCloneProc)(void *clientData); /* * Procedure-like methods have the following extra information. @@ -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; @@ -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,15 +387,15 @@ 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. */ + size_t refCount; /* Reference count. */ int numChain; /* Size of the call chain. */ struct MInvoke *chain; /* Array of call chain entries. May point to * staticChain if the number of entries is @@ -447,64 +447,88 @@ typedef struct { */ MODULE_SCOPE int TclOOInit(Tcl_Interp *interp); -MODULE_SCOPE int TclOODefineObjCmd(ClientData clientData, +MODULE_SCOPE int TclOODefineObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOOObjDefObjCmd(ClientData clientData, +MODULE_SCOPE int TclOOObjDefObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOODefineConstructorObjCmd(ClientData clientData, +MODULE_SCOPE int TclOODefineConstructorObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOODefineDefnNsObjCmd(ClientData clientData, +MODULE_SCOPE int TclOODefineDeleteMethodObjCmd(void *clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const *objv); +MODULE_SCOPE int TclOODefineDestructorObjCmd(void *clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const *objv); +MODULE_SCOPE int TclOODefineExportObjCmd(void *clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const *objv); +MODULE_SCOPE int TclOODefineForwardObjCmd(void *clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const *objv); +MODULE_SCOPE int TclOODefineMethodObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOODefineDeleteMethodObjCmd(ClientData clientData, +MODULE_SCOPE int TclOODefineRenameMethodObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOODefineDestructorObjCmd(ClientData clientData, +MODULE_SCOPE int TclOODefineUnexportObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOODefineExportObjCmd(ClientData clientData, +MODULE_SCOPE int TclOODefineClassObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOODefineForwardObjCmd(ClientData clientData, +MODULE_SCOPE int TclOODefineSelfObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOODefineMethodObjCmd(ClientData clientData, +MODULE_SCOPE int TclOODefineObjSelfObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOODefineRenameMethodObjCmd(ClientData clientData, +MODULE_SCOPE int TclOOUnknownDefinition(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOODefineUnexportObjCmd(ClientData clientData, +MODULE_SCOPE int TclOOCopyObjectCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOODefineClassObjCmd(ClientData clientData, +MODULE_SCOPE int TclOONextObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOODefineSelfObjCmd(ClientData clientData, +MODULE_SCOPE int TclOONextToObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOODefineObjSelfObjCmd(ClientData clientData, +MODULE_SCOPE int TclOODefineUnexportObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOODefinePrivateObjCmd(ClientData clientData, +MODULE_SCOPE int TclOODefineClassObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOOUnknownDefinition(ClientData clientData, +MODULE_SCOPE int TclOODefineSelfObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOOCopyObjectCmd(ClientData clientData, +MODULE_SCOPE int TclOODefineObjSelfObjCmd(void *clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const *objv); +MODULE_SCOPE int TclOODefinePrivateObjCmd(void *clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const *objv); +MODULE_SCOPE int TclOOUnknownDefinition(void *clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const *objv); +MODULE_SCOPE int TclOOCopyObjectCmd(void *clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const *objv); +MODULE_SCOPE int TclOODefineDefnNsObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOONextObjCmd(ClientData clientData, +MODULE_SCOPE int TclOONextObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOONextToObjCmd(ClientData clientData, +MODULE_SCOPE int TclOONextToObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOOSelfObjCmd(ClientData clientData, +MODULE_SCOPE int TclOOSelfObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); @@ -512,31 +536,31 @@ MODULE_SCOPE int TclOOSelfObjCmd(ClientData clientData, * Method implementations (in tclOOBasic.c). */ -MODULE_SCOPE int TclOO_Class_Constructor(ClientData clientData, +MODULE_SCOPE int TclOO_Class_Constructor(void *clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOO_Class_Create(ClientData clientData, +MODULE_SCOPE int TclOO_Class_Create(void *clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOO_Class_CreateNs(ClientData clientData, +MODULE_SCOPE int TclOO_Class_CreateNs(void *clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOO_Class_New(ClientData clientData, +MODULE_SCOPE int TclOO_Class_New(void *clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOO_Object_Destroy(ClientData clientData, +MODULE_SCOPE int TclOO_Object_Destroy(void *clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOO_Object_Eval(ClientData clientData, +MODULE_SCOPE int TclOO_Object_Eval(void *clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOO_Object_LinkVar(ClientData clientData, +MODULE_SCOPE int TclOO_Object_LinkVar(void *clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOO_Object_Unknown(ClientData clientData, +MODULE_SCOPE int TclOO_Object_Unknown(void *clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv); -MODULE_SCOPE int TclOO_Object_VarName(ClientData clientData, +MODULE_SCOPE int TclOO_Object_VarName(void *clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv); @@ -587,7 +611,7 @@ MODULE_SCOPE int TclOOGetSortedMethodList(Object *oPtr, const char ***stringsPtr); MODULE_SCOPE int TclOOInit(Tcl_Interp *interp); MODULE_SCOPE void TclOOInitInfo(Tcl_Interp *interp); -MODULE_SCOPE int TclOOInvokeContext(ClientData clientData, +MODULE_SCOPE int TclOOInvokeContext(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclNRObjectContextInvokeNext(Tcl_Interp *interp, @@ -671,7 +695,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 74a8d81..6a5cfd3 100644 --- a/generic/tclOOIntDecls.h +++ b/generic/tclOOIntDecls.h @@ -22,14 +22,14 @@ TCLAPI Tcl_Method TclOOMakeProcInstanceMethod(Tcl_Interp *interp, Object *oPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr, - ClientData clientData, Proc **procPtrPtr); + void *clientData, Proc **procPtrPtr); /* 2 */ TCLAPI Tcl_Method TclOOMakeProcMethod(Tcl_Interp *interp, Class *clsPtr, int flags, Tcl_Obj *nameObj, const char *namePtr, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr, - ClientData clientData, Proc **procPtrPtr); + void *clientData, Proc **procPtrPtr); /* 3 */ TCLAPI Method * TclOONewProcInstanceMethod(Tcl_Interp *interp, Object *oPtr, int flags, Tcl_Obj *nameObj, @@ -59,19 +59,19 @@ TCLAPI Tcl_Method TclOONewProcInstanceMethodEx(Tcl_Interp *interp, Tcl_Object oPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, - ProcErrorProc *errProc, - ClientData clientData, Tcl_Obj *nameObj, - Tcl_Obj *argsObj, Tcl_Obj *bodyObj, - int flags, void **internalTokenPtr); + ProcErrorProc *errProc, void *clientData, + Tcl_Obj *nameObj, Tcl_Obj *argsObj, + Tcl_Obj *bodyObj, int flags, + void **internalTokenPtr); /* 10 */ TCLAPI Tcl_Method TclOONewProcMethodEx(Tcl_Interp *interp, Tcl_Class clsPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, - ProcErrorProc *errProc, - ClientData clientData, Tcl_Obj *nameObj, - Tcl_Obj *argsObj, Tcl_Obj *bodyObj, - int flags, void **internalTokenPtr); + ProcErrorProc *errProc, void *clientData, + Tcl_Obj *nameObj, Tcl_Obj *argsObj, + Tcl_Obj *bodyObj, int flags, + void **internalTokenPtr); /* 11 */ TCLAPI int TclOOInvokeObject(Tcl_Interp *interp, Tcl_Object object, Tcl_Class startCls, @@ -97,16 +97,16 @@ typedef struct TclOOIntStubs { void *hooks; Tcl_Object (*tclOOGetDefineCmdContext) (Tcl_Interp *interp); /* 0 */ - Tcl_Method (*tclOOMakeProcInstanceMethod) (Tcl_Interp *interp, Object *oPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr, ClientData clientData, Proc **procPtrPtr); /* 1 */ - Tcl_Method (*tclOOMakeProcMethod) (Tcl_Interp *interp, Class *clsPtr, int flags, Tcl_Obj *nameObj, const char *namePtr, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr, ClientData clientData, Proc **procPtrPtr); /* 2 */ + Tcl_Method (*tclOOMakeProcInstanceMethod) (Tcl_Interp *interp, Object *oPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr, void *clientData, Proc **procPtrPtr); /* 1 */ + 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 (*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, ClientData 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, ClientData clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr); /* 10 */ + 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 */ diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c index f65462e..c4133bf 100644 --- a/generic/tclOOMethod.c +++ b/generic/tclOOMethod.c @@ -147,19 +147,19 @@ Tcl_NewInstanceMethod( 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); if (isNew) { - mPtr = (Method *)ckalloc(sizeof(Method)); + mPtr = (Method *)Tcl_Alloc(sizeof(Method)); mPtr->namePtr = nameObj; mPtr->refCount = 1; Tcl_IncrRefCount(nameObj); @@ -219,14 +219,14 @@ Tcl_NewMethod( 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); if (isNew) { - mPtr = (Method *)ckalloc(sizeof(Method)); + mPtr = (Method *)Tcl_Alloc(sizeof(Method)); mPtr->refCount = 1; mPtr->namePtr = nameObj; Tcl_IncrRefCount(nameObj); @@ -278,7 +278,7 @@ TclOODelMethodRef( Tcl_DecrRefCount(mPtr->namePtr); } - ckfree(mPtr); + Tcl_Free(mPtr); } } @@ -342,7 +342,7 @@ TclOONewProcInstanceMethod( if (Tcl_ListObjLength(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; @@ -351,7 +351,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; } @@ -403,7 +403,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; @@ -416,7 +416,7 @@ TclOONewProcMethod( Tcl_DecrRefCount(argsObj); } if (method == NULL) { - ckfree(pmPtr); + Tcl_Free(pmPtr); } else if (pmPtrPtr != NULL) { *pmPtrPtr = pmPtr; } @@ -497,12 +497,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; @@ -610,12 +610,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; @@ -987,7 +987,8 @@ ProcedureMethodCompiledVarConnect( Tcl_Obj *variableObj; PrivateVariableMapping *privateVar; Tcl_HashEntry *hPtr; - int i, isNew, cacheIt, varLen, len; + int i, isNew, cacheIt; + size_t varLen, len; const char *match, *varName; /* @@ -1094,7 +1095,7 @@ ProcedureMethodCompiledVarDelete( TclCleanupVar((Var *) infoPtr->cachedObjectVar, NULL); } Tcl_DecrRefCount(infoPtr->variableObj); - ckfree(infoPtr); + Tcl_Free(infoPtr); } static int @@ -1113,13 +1114,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; @@ -1174,7 +1175,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( @@ -1182,7 +1183,7 @@ 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 = @@ -1200,7 +1201,7 @@ MethodErrorHandler( kindName = "class"; } - objectName = Tcl_GetStringFromObj(TclOOObjectName(interp, declarerPtr), + objectName = TclGetStringFromObj(TclOOObjectName(interp, declarerPtr), &objectNameLen); Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (%s \"%.*s%s\" method \"%.*s%s\" line %d)", @@ -1218,7 +1219,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; @@ -1231,7 +1232,7 @@ ConstructorErrorHandler( kindName = "class"; } - objectName = Tcl_GetStringFromObj(TclOOObjectName(interp, declarerPtr), + objectName = TclGetStringFromObj(TclOOObjectName(interp, declarerPtr), &objectNameLen); Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (%s \"%.*s%s\" constructor line %d)", kindName, @@ -1248,7 +1249,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; @@ -1261,7 +1262,7 @@ DestructorErrorHandler( kindName = "class"; } - objectName = Tcl_GetStringFromObj(TclOOObjectName(interp, declarerPtr), + objectName = TclGetStringFromObj(TclOOObjectName(interp, declarerPtr), &objectNameLen); Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (%s \"%.*s%s\" destructor line %d)", kindName, @@ -1286,7 +1287,7 @@ DeleteProcedureMethodRecord( if (pmPtr->deleteClientdataProc) { pmPtr->deleteClientdataProc(pmPtr->clientData); } - ckfree(pmPtr); + Tcl_Free(pmPtr); } static void @@ -1337,7 +1338,7 @@ CloneProcedureMethod( */ bodyObj = Tcl_DuplicateObj(pmPtr->procPtr->bodyPtr); - Tcl_GetString(bodyObj); + TclGetString(bodyObj); Tcl_StoreIntRep(pmPtr->procPtr->bodyPtr, &tclByteCodeType, NULL); /* @@ -1345,7 +1346,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); @@ -1354,7 +1355,7 @@ CloneProcedureMethod( &pm2Ptr->procPtr) != TCL_OK) { Tcl_DecrRefCount(argsObj); Tcl_DecrRefCount(bodyObj); - ckfree(pm2Ptr); + Tcl_Free(pm2Ptr); return TCL_ERROR; } Tcl_DecrRefCount(argsObj); @@ -1399,7 +1400,7 @@ TclOONewForwardInstanceMethod( return NULL; } - fmPtr = (ForwardMethod *)ckalloc(sizeof(ForwardMethod)); + fmPtr = (ForwardMethod *)Tcl_Alloc(sizeof(ForwardMethod)); fmPtr->prefixObj = prefixObj; Tcl_IncrRefCount(prefixObj); return (Method *) Tcl_NewInstanceMethod(interp, (Tcl_Object) oPtr, @@ -1438,7 +1439,7 @@ TclOONewForwardMethod( return NULL; } - fmPtr = (ForwardMethod *)ckalloc(sizeof(ForwardMethod)); + fmPtr = (ForwardMethod *)Tcl_Alloc(sizeof(ForwardMethod)); fmPtr->prefixObj = prefixObj; Tcl_IncrRefCount(prefixObj); return (Method *) Tcl_NewMethod(interp, (Tcl_Class) clsPtr, nameObj, @@ -1519,7 +1520,7 @@ DeleteForwardMethod( ForwardMethod *fmPtr = (ForwardMethod *)clientData; Tcl_DecrRefCount(fmPtr->prefixObj); - ckfree(fmPtr); + Tcl_Free(fmPtr); } static int @@ -1529,7 +1530,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 6e17141..eeaf936 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,17 +225,8 @@ 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 */ @@ -252,25 +240,12 @@ const Tcl_ObjType tclDoubleType = { SetDoubleFromAny /* setFromAnyProc */ }; const Tcl_ObjType tclIntType = { -#if defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8 || defined(TCL_WIDE_INT_IS_LONG) "int", /* name */ -#else - "wideInt", /* name, keeping maximum compatibility with Tcl 8.6 on 32-bit platforms*/ -#endif NULL, /* freeIntRepProc */ NULL, /* dupIntRepProc */ UpdateStringOfInt, /* updateStringProc */ SetIntFromAny /* setFromAnyProc */ }; -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 && !defined(TCL_WIDE_INT_IS_LONG) -static const Tcl_ObjType oldIntType = { - "int", /* name */ - NULL, /* freeIntRepProc */ - NULL, /* dupIntRepProc */ - UpdateStringOfOldInt, /* updateStringProc */ - SetIntFromAny /* setFromAnyProc */ -}; -#endif const Tcl_ObjType tclBignumType = { "bignum", /* name */ FreeBignum, /* freeIntRepProc */ @@ -336,17 +311,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). */ - unsigned 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. */ - unsigned 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, @@ -395,15 +370,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; @@ -451,12 +417,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 @@ -532,7 +498,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); } @@ -567,7 +533,7 @@ TclContinuationsEnter( ThreadSpecificData *tsdPtr = TclGetContLineTable(); Tcl_HashEntry *hPtr = Tcl_CreateHashEntry(tsdPtr->lineCLPtr, objPtr, &newEntry); - ContLineLoc *clLocPtr = (ContLineLoc *)ckalloc(offsetof(ContLineLoc, loc) + (num + 1) *sizeof(int)); + ContLineLoc *clLocPtr = (ContLineLoc *)Tcl_Alloc(offsetof(ContLineLoc, loc) + (num + 1) *sizeof(int)); if (!newEntry) { /* @@ -591,7 +557,7 @@ TclContinuationsEnter( * doing. */ - ckfree(Tcl_GetHashValue(hPtr)); + Tcl_Free(Tcl_GetHashValue(hPtr)); } clLocPtr->num = num; @@ -627,7 +593,8 @@ TclContinuationsEnterDerived( int start, int *clNext) { - int length, end, num; + size_t length; + int end, num; int *wordCLLast = clNext; /* @@ -654,7 +621,7 @@ TclContinuationsEnterDerived( * better way which doesn't shimmer?) */ - TclGetStringFromObj(objPtr, &length); + (void)TclGetStringFromObj(objPtr, &length); end = start + length; /* First char after the word */ /* @@ -795,11 +762,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; } @@ -1005,7 +972,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); @@ -1075,7 +1042,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; @@ -1088,7 +1055,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; @@ -1211,7 +1178,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. * @@ -1240,12 +1207,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; @@ -1320,7 +1287,7 @@ TclFreeObj( ObjData *objData = (ObjData *)Tcl_GetHashValue(hPtr); if (objData != NULL) { - ckfree(objData); + Tcl_Free(objData); } Tcl_DeleteHashEntry(hPtr); @@ -1334,7 +1301,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); } /* @@ -1342,16 +1309,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); @@ -1364,7 +1331,7 @@ TclFreeObj( } Tcl_MutexLock(&tclObjMutex); - ckfree(objPtr); + Tcl_Free(objPtr); Tcl_MutexUnlock(&tclObjMutex); TclIncrObjsFreed(); ObjDeletionLock(context); @@ -1376,7 +1343,7 @@ TclFreeObj( TclFreeIntRep(objToFree); Tcl_MutexLock(&tclObjMutex); - ckfree(objToFree); + Tcl_Free(objToFree); Tcl_MutexUnlock(&tclObjMutex); TclIncrObjsFreed(); } @@ -1400,7 +1367,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); } } @@ -1419,7 +1386,7 @@ TclFreeObj( */ TclInvalidateStringRep(objPtr); - objPtr->length = -1; + objPtr->length = TCL_INDEX_NONE; if (!objPtr->typePtr || !objPtr->typePtr->freeIntRepProc) { /* @@ -1491,7 +1458,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); } } @@ -1521,7 +1488,7 @@ int TclObjBeingDeleted( Tcl_Obj *objPtr) { - return (objPtr->length == -1); + return (objPtr->length == TCL_INDEX_NONE); } /* @@ -1640,7 +1607,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", @@ -1699,7 +1666,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", @@ -1707,7 +1674,7 @@ Tcl_GetStringFromObj( } } if (lengthPtr != NULL) { - *lengthPtr = objPtr->length; + *lengthPtr = (objPtr->length < INT_MAX)? objPtr->length: INT_MAX; } return objPtr->bytes; } @@ -1721,15 +1688,15 @@ Tcl_GetStringFromObj( * 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 @@ -1738,7 +1705,7 @@ Tcl_GetStringFromObj( * 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 @@ -1760,35 +1727,31 @@ 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); - } - /* Allocate */ if (objPtr->bytes == NULL) { /* Allocate only as empty - extend later if bytes copied */ objPtr->length = 0; if (numBytes) { - objPtr->bytes = (char *)attemptckalloc(numBytes + 1); + objPtr->bytes = (char *)Tcl_AttemptAlloc(numBytes + 1); if (objPtr->bytes == NULL) { return NULL; } if (bytes) { /* Copy */ memcpy(objPtr->bytes, bytes, numBytes); - objPtr->length = (int) numBytes; + objPtr->length = numBytes; } } else { TclInitStringRep(objPtr, NULL, 0); } } else { /* objPtr->bytes != NULL bytes == NULL - Truncate */ - objPtr->bytes = (char *)ckrealloc(objPtr->bytes, numBytes + 1); - objPtr->length = (int)numBytes; + objPtr->bytes = (char *)Tcl_Realloc(objPtr->bytes, numBytes + 1); + objPtr->length = numBytes; } /* Terminate */ @@ -1937,145 +1900,6 @@ Tcl_FreeIntRep( /* *---------------------------------------------------------------------- * - * Tcl_NewBooleanObj -- - * - * This function is normally called when not debugging: i.e., when - * TCL_MEM_DEBUG is not defined. It creates a new Tcl_Obj and - * initializes it from the argument boolean value. A nonzero "boolValue" - * is coerced to 1. - * - * When TCL_MEM_DEBUG is defined, this function just returns the result - * of calling the debugging version Tcl_DbNewLongObj. - * - * Results: - * The newly created object is returned. This object will have an invalid - * string representation. The returned object has ref count 0. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -#undef Tcl_NewBooleanObj -#ifdef TCL_MEM_DEBUG - -Tcl_Obj * -Tcl_NewBooleanObj( - int boolValue) /* Boolean used to initialize new object. */ -{ - return Tcl_DbNewWideIntObj(boolValue!=0, "unknown", 0); -} - -#else /* if not TCL_MEM_DEBUG */ - -Tcl_Obj * -Tcl_NewBooleanObj( - int boolValue) /* Boolean used to initialize new object. */ -{ - Tcl_Obj *objPtr; - - TclNewIntObj(objPtr, boolValue!=0); - return objPtr; -} -#endif /* TCL_MEM_DEBUG */ - -/* - *---------------------------------------------------------------------- - * - * Tcl_DbNewBooleanObj -- - * - * This function is normally called when debugging: i.e., when - * TCL_MEM_DEBUG is defined. It creates new boolean objects. It is the - * same as the Tcl_NewBooleanObj function above except that it calls - * Tcl_DbCkalloc directly with the file name and line number from its - * caller. This simplifies debugging since then the [memory active] - * command will report the correct file name and line number when - * reporting objects that haven't been freed. - * - * When TCL_MEM_DEBUG is not defined, this function just returns the - * result of calling Tcl_NewBooleanObj. - * - * Results: - * The newly created object is returned. This object will have an invalid - * string representation. The returned object has ref count 0. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -#ifndef TCL_NO_DEPRECATED -#undef Tcl_DbNewBooleanObj -#ifdef TCL_MEM_DEBUG - -Tcl_Obj * -Tcl_DbNewBooleanObj( - int boolValue, /* Boolean used to initialize new object. */ - const char *file, /* The name of the source file calling this - * function; used for debugging. */ - int line) /* Line number in the source file; used for - * debugging. */ -{ - Tcl_Obj *objPtr; - - TclDbNewObj(objPtr, file, line); - /* Optimized TclInvalidateStringRep() */ - objPtr->bytes = NULL; - - objPtr->internalRep.wideValue = (boolValue != 0); - objPtr->typePtr = &tclIntType; - return objPtr; -} - -#else /* if not TCL_MEM_DEBUG */ - -Tcl_Obj * -Tcl_DbNewBooleanObj( - int boolValue, /* Boolean used to initialize new object. */ - TCL_UNUSED(const char *) /*file*/, - TCL_UNUSED(int) /*line*/) -{ - return Tcl_NewBooleanObj(boolValue); -} -#endif /* TCL_MEM_DEBUG */ - -/* - *---------------------------------------------------------------------- - * - * Tcl_SetBooleanObj -- - * - * Modify an object to be a boolean object and to have the specified - * boolean value. A nonzero "boolValue" is coerced to 1. - * - * Results: - * None. - * - * Side effects: - * The object's old string rep, if any, is freed. Also, any old internal - * rep is freed. - * - *---------------------------------------------------------------------- - */ - -#undef Tcl_SetBooleanObj -void -Tcl_SetBooleanObj( - Tcl_Obj *objPtr, /* Object whose internal rep to init. */ - int boolValue) /* Boolean used to set object's value. */ -{ - if (Tcl_IsShared(objPtr)) { - Tcl_Panic("%s called with shared object", "Tcl_SetBooleanObj"); - } - - TclSetIntObj(objPtr, boolValue!=0); -} -#endif /* TCL_NO_DEPRECATED */ - -/* - *---------------------------------------------------------------------- - * * Tcl_GetBooleanFromObj -- * * Attempt to return a boolean from the Tcl object "objPtr". This @@ -2099,14 +1923,10 @@ Tcl_GetBooleanFromObj( int *boolPtr) /* Place to store resulting boolean. */ { do { - if (objPtr->typePtr == &tclIntType) { + if (objPtr->typePtr == &tclIntType || objPtr->typePtr == &tclBooleanType) { *boolPtr = (objPtr->internalRep.wideValue != 0); return TCL_OK; } - if (objPtr->typePtr == &tclBooleanType) { - *boolPtr = objPtr->internalRep.longValue != 0; - return TCL_OK; - } if (objPtr->typePtr == &tclDoubleType) { /* * Caution: Don't be tempted to check directly for the "double" @@ -2148,12 +1968,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. * *---------------------------------------------------------------------- */ @@ -2192,7 +2007,7 @@ TclSetBooleanFromAny( badBoolean: if (interp != NULL) { - int length; + size_t length; const char *str = TclGetStringFromObj(objPtr, &length); Tcl_Obj *msg; @@ -2211,8 +2026,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 = TclGetStringFromObj(objPtr, &length); if ((length == 0) || (length > 5)) { /* @@ -2311,7 +2126,7 @@ ParseBoolean( goodBoolean: TclFreeIntRep(objPtr); - objPtr->internalRep.longValue = newBool; + objPtr->internalRep.wideValue = newBool; objPtr->typePtr = &tclBooleanType; return TCL_OK; @@ -2546,8 +2361,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. * @@ -2567,7 +2381,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)); @@ -2576,112 +2390,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((long)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_SetIntObj -- + * Tcl_GetIntFromObj -- * - * Modify an object to be an integer and to have the specified integer - * value. + * Retrieve the integer value of 'objPtr'. * - * Results: - * None. + * Value * - * 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. * *---------------------------------------------------------------------- */ @@ -2764,184 +2494,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 */ /* *---------------------------------------------------------------------- @@ -3381,7 +2937,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; } @@ -3907,7 +3463,7 @@ int Tcl_IsShared( Tcl_Obj *objPtr) /* The object to test for being shared. */ { - return ((objPtr)->refCount > 1); + return ((objPtr)->refCount + 1 > 2); } /* @@ -4191,7 +3747,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); @@ -4223,7 +3779,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; @@ -4285,7 +3841,7 @@ TclFreeObjEntry( Tcl_Obj *objPtr = (Tcl_Obj *) hPtr->key.oneWordValue; Tcl_DecrRefCount(objPtr); - ckfree(hPtr); + Tcl_Free(hPtr); } /* @@ -4312,8 +3868,8 @@ TclHashObjKey( void *keyPtr) /* Key from which to compute hash value. */ { Tcl_Obj *objPtr = (Tcl_Obj *)keyPtr; - int length; - const char *string = TclGetStringFromObj(objPtr, &length); + const char *string = TclGetString(objPtr); + size_t length = objPtr->length; TCL_HASH_TYPE result = 0; /* @@ -4350,7 +3906,7 @@ TclHashObjKey( * See [tcl-Feature Request #2958832] */ - if (length > 0) { + if (length) { result = UCHAR(*string); while (--length) { result += (result << 3) + UCHAR(*++string); @@ -4475,7 +4031,7 @@ SetCmdNameObj( if (resPtr) { fillPtr = resPtr; } else { - fillPtr = (ResolvedCmdName *)ckalloc(sizeof(ResolvedCmdName)); + fillPtr = (ResolvedCmdName *)Tcl_Alloc(sizeof(ResolvedCmdName)); fillPtr->refCount = 1; } @@ -4578,7 +4134,7 @@ FreeCmdNameInternalRep( Command *cmdPtr = resPtr->cmdPtr; TclCleanupCommandMacro(cmdPtr); - ckfree(resPtr); + Tcl_Free(resPtr); } objPtr->typePtr = NULL; } @@ -4727,7 +4283,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 4383c62..7c5b2fd 100644 --- a/generic/tclOptimize.c +++ b/generic/tclOptimize.c @@ -231,7 +231,7 @@ ConvertZeroEffectToNOP( && TclGetUInt1AtPtr(currentInstPtr + size + 1) == 2) { Tcl_Obj *litPtr = TclFetchLiteral(envPtr, TclGetUInt1AtPtr(currentInstPtr + 1)); - int numBytes; + size_t numBytes; (void) TclGetStringFromObj(litPtr, &numBytes); if (numBytes == 0) { @@ -246,7 +246,7 @@ ConvertZeroEffectToNOP( && TclGetUInt1AtPtr(currentInstPtr + size + 1) == 2) { Tcl_Obj *litPtr = TclFetchLiteral(envPtr, TclGetUInt4AtPtr(currentInstPtr + 1)); - int numBytes; + size_t numBytes; (void) TclGetStringFromObj(litPtr, &numBytes); if (numBytes == 0) { @@ -287,8 +287,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 da5c134..b7b6b96 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 /* *---------------------------------------------------------------------- @@ -49,14 +45,6 @@ void 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; Tcl_InitSubsystems(); } @@ -64,7 +52,7 @@ Tcl_SetPanicProc( /* *---------------------------------------------------------------------- * - * Tcl_PanicVA -- + * Tcl_Panic -- * * Print an error message and kill the process. * @@ -77,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 *); @@ -95,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 @@ -127,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 daad31d..7bb92d5 100644 --- a/generic/tclParse.c +++ b/generic/tclParse.c @@ -119,16 +119,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 +151,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 +197,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 +209,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 +218,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); @@ -346,7 +346,7 @@ Tcl_ParseCommand( /* Haven't seen prefix already */ && (1 == parsePtr->numTokens - expIdx) /* Only one token */ - && (((1 == (size_t) expPtr->size) + && (((1 == expPtr->size) /* Same length as prefix */ && (expPtr->start[0] == '*'))) /* Is the prefix */ @@ -381,7 +381,8 @@ Tcl_ParseCommand( tokenPtr->size = src - tokenPtr->start; tokenPtr->numComponents = 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 +428,7 @@ Tcl_ParseCommand( */ while (nextElem < listEnd) { - int size; + size_t size; code = TclFindElement(NULL, nextElem, listEnd - nextElem, &elemStart, &nextElem, &size, &literal); @@ -619,10 +620,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 +674,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 +692,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 +726,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 +782,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 +792,7 @@ TclParseBackslash( const char *p = src+1; Tcl_UniChar unichar = 0; int result; - int count; + size_t count; char buf[4] = ""; if (numBytes == 0) { @@ -978,10 +979,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 +991,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 +1055,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 @@ -1294,7 +1295,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 +1333,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 +1348,7 @@ Tcl_ParseVarName( int varIndex; unsigned array; - if (numBytes < 0 && start) { + if (numBytes == TCL_INDEX_NONE && start) { numBytes = strlen(start); } if (!append) { @@ -1609,7 +1610,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 +1627,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) { @@ -1810,7 +1812,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 +1827,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 +1893,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); @@ -2153,7 +2155,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 +2195,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)TclGetStringFromObj(result, &clPos); } if (numCL >= maxNumCL) { maxNumCL *= 2; - clPosition = (int *)ckrealloc(clPosition, + clPosition = (int *)Tcl_Realloc(clPosition, maxNumCL * sizeof(int)); } clPosition[numCL] = clPos; @@ -2361,7 +2363,7 @@ TclSubstTokens( */ if (maxNumCL) { - ckfree(clPosition); + Tcl_Free(clPosition); } } else { Tcl_ResetResult(interp); @@ -2399,7 +2401,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; @@ -2473,7 +2475,7 @@ TclObjCommandComplete( Tcl_Obj *objPtr) /* Points to object holding script to * check. */ { - int length; + size_t length; const char *script = TclGetStringFromObj(objPtr, &length); return CommandComplete(script, length); diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c index 8b1f199..647eb1c 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, @@ -50,7 +50,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 +66,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 +205,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)TclGetStringFromObj(retVal, &curLen); if (curLen == 0) { Tcl_AppendToObj(retVal, dirSep, 1); } @@ -225,7 +225,7 @@ TclFSNormalizeAbsolutePath( } if (dirSep[2] == '.' && IsSeparatorOrNull(dirSep[3])) { Tcl_Obj *linkObj; - int curLen; + size_t curLen; char *linkStr; /* @@ -238,7 +238,7 @@ TclFSNormalizeAbsolutePath( retVal = Tcl_NewStringObj(path, dirSep - path); Tcl_IncrRefCount(retVal); } - TclGetStringFromObj(retVal, &curLen); + (void)TclGetStringFromObj(retVal, &curLen); if (curLen == 0) { Tcl_AppendToObj(retVal, dirSep, 1); } @@ -271,7 +271,7 @@ TclFSNormalizeAbsolutePath( const char *path = TclGetStringFromObj(retVal, &curLen); - while (--curLen >= 0) { + while (curLen-- > 0) { if (IsSeparatorOrNull(path[curLen])) { break; } @@ -304,7 +304,7 @@ TclFSNormalizeAbsolutePath( */ if (tclPlatform == TCL_PLATFORM_WINDOWS) { - int i; + size_t i; for (i = 0; i < curLen; i++) { if (linkStr[i] == '\\') { @@ -322,7 +322,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,7 +384,7 @@ TclFSNormalizeAbsolutePath( */ if (tclPlatform == TCL_PLATFORM_WINDOWS) { - int len; + size_t len; const char *path = TclGetStringFromObj(retVal, &len); if (len == 2 && path[0] != 0 && path[1] == ':') { @@ -558,9 +558,8 @@ TclPathPart( * the standardPath code. */ - int numBytes; - const char *rest = - TclGetStringFromObj(fsPathPtr->normPathPtr, &numBytes); + size_t numBytes; + const char *rest = TclGetStringFromObj(fsPathPtr->normPathPtr, &numBytes); if (strchr(rest, '/') != NULL) { goto standardPath; @@ -596,9 +595,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 = TclGetStringFromObj(fsPathPtr->normPathPtr, &numBytes); if (strchr(rest, '/') != NULL) { goto standardPath; @@ -625,7 +623,7 @@ TclPathPart( return GetExtension(fsPathPtr->normPathPtr); case TCL_PATH_ROOT: { const char *fileName, *extension; - int length; + size_t length; fileName = TclGetStringFromObj(fsPathPtr->normPathPtr, &length); @@ -648,7 +646,7 @@ TclPathPart( Tcl_Obj *resultPtr = TclNewFSPathObj(fsPathPtr->cwdPtr, fileName, - (int)(length - strlen(extension))); + length - strlen(extension)); Tcl_IncrRefCount(resultPtr); return resultPtr; @@ -676,7 +674,7 @@ 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); @@ -686,7 +684,7 @@ TclPathPart( return pathPtr; } else { Tcl_Obj *root = Tcl_NewStringObj(fileName, - (int) (length - strlen(extension))); + length - strlen(extension)); Tcl_IncrRefCount(root); return root; @@ -868,7 +866,7 @@ TclJoinPath( TclGetPathType(tailObj, NULL, NULL, NULL); if (type == TCL_PATH_RELATIVE) { const char *str; - int len; + size_t len; str = TclGetStringFromObj(tailObj, &len); if (len == 0) { @@ -899,7 +897,7 @@ TclJoinPath( */ if ((tclPlatform != TCL_PLATFORM_WINDOWS) - || (strchr(Tcl_GetString(elt), '\\') == NULL)) { + || (strchr(TclGetString(elt), '\\') == NULL)) { if (PATHFLAGS(elt)) { return TclNewFSPathObj(elt, str, len); @@ -935,7 +933,8 @@ TclJoinPath( assert ( res == NULL ); for (i = 0; i < elements; i++) { - int driveNameLength, strEltLen, length; + int driveNameLength; + size_t strEltLen, length; Tcl_PathType type; char *strElt, *ptr; Tcl_Obj *driveName = NULL; @@ -1083,9 +1082,9 @@ TclJoinPath( if (length > 0 && ptr[length -1] != '/') { Tcl_AppendToObj(res, &separator, 1); - TclGetStringFromObj(res, &length); + (void)TclGetStringFromObj(res, &length); } - Tcl_SetObjLength(res, length + (int) strlen(strElt)); + Tcl_SetObjLength(res, length + strlen(strElt)); ptr = TclGetString(res) + length; for (; *strElt != '\0'; strElt++) { @@ -1187,7 +1186,7 @@ IsSeparatorOrNull( * of the end of the string. */ -static int +static size_t FindSplitPos( const char *path, int separator) @@ -1241,7 +1240,7 @@ Tcl_Obj * TclNewFSPathObj( Tcl_Obj *dirPtr, const char *addStrRep, - int len) + size_t len) { FsPath *fsPathPtr; Tcl_Obj *pathPtr; @@ -1273,7 +1272,7 @@ TclNewFSPathObj( } TclNewObj(pathPtr); - fsPathPtr = (FsPath *)ckalloc(sizeof(FsPath)); + fsPathPtr = (FsPath *)Tcl_Alloc(sizeof(FsPath)); /* * Set up the path. @@ -1298,12 +1297,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 '\\': @@ -1340,9 +1339,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 @@ -1352,8 +1351,8 @@ AppendPath( * intrep 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 = TclGetStringFromObj(tail, &length); + if (length == 0) { Tcl_AppendToObj(copy, "/", 1); } else { TclpNativeJoinPath(copy, bytes); @@ -1389,7 +1388,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_ObjIntRep *irPtr = TclFetchIntRep(pathPtr, &fsPathType); @@ -1465,7 +1464,7 @@ MakePathFromNormalized( return TCL_OK; } - fsPathPtr = (FsPath *)ckalloc(sizeof(FsPath)); + fsPathPtr = (FsPath *)Tcl_Alloc(sizeof(FsPath)); /* * It's a pure normalized absolute path. @@ -1500,7 +1499,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. @@ -1533,7 +1532,7 @@ Tcl_FSNewNativePath( */ Tcl_StoreIntRep(pathPtr, &fsPathType, NULL); - fsPathPtr = (FsPath *)ckalloc(sizeof(FsPath)); + fsPathPtr = (FsPath *)Tcl_Alloc(sizeof(FsPath)); fsPathPtr->translatedPathPtr = NULL; @@ -1657,9 +1656,9 @@ Tcl_FSGetTranslatedStringPath( Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(interp, pathPtr); if (transPtr != NULL) { - int len; + size_t len; const char *orig = TclGetStringFromObj(transPtr, &len); - char *result = (char *)ckalloc(len+1); + char *result = (char *)Tcl_Alloc(len+1); memcpy(result, orig, len+1); TclDecrRefCount(transPtr); @@ -1707,7 +1706,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); @@ -1717,7 +1717,7 @@ Tcl_FSGetNormalizedPath( /* TODO: Figure out why this is needed. */ TclGetString(pathPtr); - TclGetStringFromObj(fsPathPtr->normPathPtr, &tailLen); + (void)TclGetStringFromObj(fsPathPtr->normPathPtr, &tailLen); if (tailLen) { copy = AppendPath(dir, fsPathPtr->normPathPtr); } else { @@ -1808,13 +1808,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] == '/'); + cwdLen += (TclGetString(copy)[cwdLen] == '/'); /* * Normalize the combined string, but only starting after the end @@ -2141,7 +2141,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; @@ -2201,7 +2202,7 @@ SetFsPathFromAny( Tcl_Interp *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; @@ -2232,7 +2233,7 @@ SetFsPathFromAny( if (len && name[0] == '~') { Tcl_DString temp; - int split; + size_t split; char separator = '/'; /* @@ -2320,7 +2321,8 @@ SetFsPathFromAny( objc--; objv++; while (objc--) { - TclpNativeJoinPath(transPtr, Tcl_GetString(*objv++)); + TclpNativeJoinPath(transPtr, TclGetString(*objv)); + objv++; } TclDecrRefCount(parts); } else { @@ -2346,7 +2348,7 @@ SetFsPathFromAny( * 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); @@ -2397,7 +2399,7 @@ FreeFsPathInternalRep( } } - ckfree(fsPathPtr); + Tcl_Free(fsPathPtr); } static void @@ -2406,7 +2408,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); @@ -2466,7 +2468,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) { @@ -2538,7 +2540,7 @@ TclNativePathInFilesystem( * situation. */ - int len; + size_t len; (void) TclGetStringFromObj(pathPtr, &len); if (len == 0) { diff --git a/generic/tclPipe.c b/generic/tclPipe.c index e9ad4e6..94ed8e3 100644 --- a/generic/tclPipe.c +++ b/generic/tclPipe.c @@ -188,7 +188,7 @@ Tcl_DetachPids( 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); @@ -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); } /* @@ -824,7 +824,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 +978,7 @@ TclCreatePipeline( Tcl_DetachPids(1, &pidPtr[i]); } } - ckfree(pidPtr); + Tcl_Free(pidPtr); } numPids = -1; goto cleanup; @@ -1082,7 +1082,7 @@ Tcl_OpenCommandChannel( error: if (numPids > 0) { 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 89fb0c4..9022fe9 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); @@ -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(sizeof(PkgName) + strlen(name)); + pkgName = (PkgName *)Tcl_Alloc(sizeof(PkgName) + 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( @@ -1109,8 +1109,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)); } @@ -1151,14 +1152,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,7 +1175,7 @@ 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); @@ -1186,16 +1188,16 @@ TclNRPackageObjCmd( 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 +1210,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); @@ -1396,7 +1398,7 @@ TclNRPackageObjCmd( } break; case PKG_UNKNOWN: { - int length; + size_t length; if (objc == 2) { if (iPtr->packageUnknown != NULL) { @@ -1405,7 +1407,7 @@ TclNRPackageObjCmd( } } else if (objc == 3) { if (iPtr->packageUnknown != NULL) { - ckfree(iPtr->packageUnknown); + Tcl_Free(iPtr->packageUnknown); } argv2 = TclGetStringFromObj(objv[2], &length); if (argv2[0] == 0) { @@ -1466,7 +1468,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 +1484,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 +1520,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 +1577,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 +1629,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 +1675,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 +1743,7 @@ CheckVersionAndConvert( if (internal != NULL) { *internal = ibuf; } else { - ckfree(ibuf); + Tcl_Free(ibuf); } if (stable != NULL) { *stable = !hasunstable; @@ -1750,7 +1752,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 +2026,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 +2037,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,7 +2070,8 @@ 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); @@ -2204,7 +2207,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 +2231,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 +2254,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 +2285,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 +2297,11 @@ Tcl_PkgInitStubsCheck( if (count == 1) { if (0 != strncmp(version, actualVersion, strlen(version))) { /* Construct error message */ - Tcl_PkgPresent(interp, "Tcl", version, 1); + Tcl_PkgPresentEx(interp, "Tcl", version, 1, NULL); return NULL; } } else { - return Tcl_PkgPresent(interp, "Tcl", version, 1); + return Tcl_PkgPresentEx(interp, "Tcl", version, 1, NULL); } } return actualVersion; diff --git a/generic/tclPlatDecls.h b/generic/tclPlatDecls.h index 4b06148..fb46271 100644 --- a/generic/tclPlatDecls.h +++ b/generic/tclPlatDecls.h @@ -50,24 +50,13 @@ extern "C" { * Exported function declarations: */ -#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ -/* 0 */ -EXTERN TCHAR * Tcl_WinUtfToTChar(const char *str, int len, - Tcl_DString *dsPtr); -/* 1 */ -EXTERN char * Tcl_WinTCharToUtf(const TCHAR *str, int len, - Tcl_DString *dsPtr); -#endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ -/* 0 */ -EXTERN int Tcl_MacOSXOpenBundleResources(Tcl_Interp *interp, - const char *bundleName, int hasResourceFile, - int maxPathLen, char *libraryPath); +/* Slot 0 is reserved */ /* 1 */ EXTERN int Tcl_MacOSXOpenVersionedBundleResources( Tcl_Interp *interp, const char *bundleName, const char *bundleVersion, - int hasResourceFile, int maxPathLen, + int hasResourceFile, size_t maxPathLen, char *libraryPath); #endif /* MACOSX */ @@ -75,13 +64,9 @@ typedef struct TclPlatStubs { int magic; void *hooks; -#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ - TCHAR * (*tcl_WinUtfToTChar) (const char *str, int len, Tcl_DString *dsPtr); /* 0 */ - char * (*tcl_WinTCharToUtf) (const TCHAR *str, int len, Tcl_DString *dsPtr); /* 1 */ -#endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ - int (*tcl_MacOSXOpenBundleResources) (Tcl_Interp *interp, const char *bundleName, int hasResourceFile, int maxPathLen, char *libraryPath); /* 0 */ - int (*tcl_MacOSXOpenVersionedBundleResources) (Tcl_Interp *interp, const char *bundleName, const char *bundleVersion, int hasResourceFile, int maxPathLen, char *libraryPath); /* 1 */ + void (*reserved0)(void); + int (*tcl_MacOSXOpenVersionedBundleResources) (Tcl_Interp *interp, const char *bundleName, const char *bundleVersion, int hasResourceFile, size_t maxPathLen, char *libraryPath); /* 1 */ #endif /* MACOSX */ } TclPlatStubs; @@ -97,15 +82,8 @@ extern const TclPlatStubs *tclPlatStubsPtr; * Inline function declarations: */ -#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ -#define Tcl_WinUtfToTChar \ - (tclPlatStubsPtr->tcl_WinUtfToTChar) /* 0 */ -#define Tcl_WinTCharToUtf \ - (tclPlatStubsPtr->tcl_WinTCharToUtf) /* 1 */ -#endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ -#define Tcl_MacOSXOpenBundleResources \ - (tclPlatStubsPtr->tcl_MacOSXOpenBundleResources) /* 0 */ +/* Slot 0 is reserved */ #define Tcl_MacOSXOpenVersionedBundleResources \ (tclPlatStubsPtr->tcl_MacOSXOpenVersionedBundleResources) /* 1 */ #endif /* MACOSX */ @@ -122,16 +100,11 @@ extern const TclPlatStubs *tclPlatStubsPtr; #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLIMPORT -#if defined(USE_TCL_STUBS) && (defined(_WIN32) || defined(__CYGWIN__))\ - && (defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8) -#undef Tcl_WinUtfToTChar -#undef Tcl_WinTCharToUtf -#ifdef _WIN32 +#if defined(USE_TCL_STUBS) && defined(_WIN32) && !defined(TCL_NO_DEPRECATED) #define Tcl_WinUtfToTChar(string, len, dsPtr) (Tcl_DStringInit(dsPtr), \ (TCHAR *)Tcl_UtfToChar16DString((string), (len), (dsPtr))) #define Tcl_WinTCharToUtf(string, len, dsPtr) (Tcl_DStringInit(dsPtr), \ (char *)Tcl_Char16ToUtfDString((const unsigned short *)(string), ((((len) + 2) >> 1) - 1), (dsPtr))) #endif -#endif #endif /* _TCLPLATDECLS */ diff --git a/generic/tclPreserve.c b/generic/tclPreserve.c index d60ebec..59ee40f 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 20af5fe..4c9694b 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -261,11 +261,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; @@ -293,9 +293,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); } @@ -327,7 +327,7 @@ Tcl_ProcObjCmd( * of all procs whose argument list is just _args_ */ - if (TclHasIntRep(objv[3], &tclProcBodyType)) { + if (objv[3]->typePtr == &tclProcBodyType) { goto done; } @@ -338,7 +338,7 @@ Tcl_ProcObjCmd( } if ((procArgs[0] == 'a') && (strncmp(procArgs, "args", 4) == 0)) { - int numBytes; + size_t numBytes; procArgs +=4; while (*procArgs != '\0') { @@ -444,7 +444,7 @@ TclCreateProc( if (Tcl_IsShared(bodyPtr)) { const char *bytes; - int length; + size_t length; Tcl_Obj *sharedBodyPtr = bodyPtr; bytes = TclGetStringFromObj(bodyPtr, &length); @@ -467,7 +467,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; @@ -507,7 +507,8 @@ TclCreateProc( for (i = 0; i < numArgs; i++) { const char *argname, *argnamei, *argnamelast; - int fieldCount, nameLength; + int fieldCount; + size_t nameLength; Tcl_Obj **fieldValues; /* @@ -537,7 +538,7 @@ TclCreateProc( goto procError; } - argname = Tcl_GetStringFromObj(fieldValues[0], &nameLength); + argname = TclGetStringFromObj(fieldValues[0], &nameLength); /* * Check that the formal parameter name is a scalar. @@ -550,7 +551,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; @@ -599,10 +600,9 @@ TclCreateProc( */ if (localPtr->defValuePtr != NULL) { - const char *tmpPtr = TclGetString(localPtr->defValuePtr); - size_t tmpLength = localPtr->defValuePtr->length; - const char *value = TclGetString(fieldValues[1]); - size_t valueLength = fieldValues[1]->length; + size_t tmpLength, valueLength; + const char *tmpPtr = TclGetStringFromObj(localPtr->defValuePtr, &tmpLength); + const char *value = TclGetStringFromObj(fieldValues[1], &valueLength); if ((valueLength != tmpLength) || memcmp(value, tmpPtr, tmpLength) != 0 @@ -632,7 +632,7 @@ TclCreateProc( * local variables for the argument. */ - localPtr = (CompiledLocal *)ckalloc( + localPtr = (CompiledLocal *)Tcl_Alloc( offsetof(CompiledLocal, name) + fieldValues[0]->length + 1); if (procPtr->firstLocalPtr == NULL) { procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr; @@ -678,9 +678,9 @@ TclCreateProc( Tcl_DecrRefCount(localPtr->defValuePtr); } - ckfree(localPtr); + Tcl_Free(localPtr); } - ckfree(procPtr); + Tcl_Free(procPtr); } return TCL_ERROR; } @@ -1079,11 +1079,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]); @@ -1122,54 +1118,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. - * - *---------------------------------------------------------------------- - */ - -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; - ByteCodeGetIntRep(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); -} - -/* - *---------------------------------------------------------------------- - * * InitResolvedLocals -- * * This routine is invoked in order to initialize the compiled locals @@ -1223,7 +1171,7 @@ InitResolvedLocals( if (localPtr->resolveInfo->deleteProc) { localPtr->resolveInfo->deleteProc(localPtr->resolveInfo); } else { - ckfree(localPtr->resolveInfo); + Tcl_Free(localPtr->resolveInfo); } localPtr->resolveInfo = NULL; } @@ -1309,7 +1257,7 @@ TclFreeLocalCache( TclReleaseLiteral(interp, objPtr); } } - ckfree(localCachePtr); + Tcl_Free(localCachePtr); } static void @@ -1335,7 +1283,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)); @@ -1347,7 +1295,7 @@ InitLocalCache( *namePtr = NULL; } else { *namePtr = TclCreateLiteral(iPtr, localPtr->name, - localPtr->nameLength, /* hash */ (unsigned int) -1, + localPtr->nameLength, /* hash */ -1, &isNew, /* nsPtr */ NULL, 0, NULL); Tcl_IncrRefCount(*namePtr); } @@ -2020,10 +1968,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; } @@ -2084,13 +2032,14 @@ MakeProcError( Tcl_Obj *procNameObj) /* Name of the procedure. Used for error * messages and trace information. */ { - int overflow, limit = 60, nameLen; + unsigned int overflow, limit = 60; + size_t nameLen; const char *procName = TclGetStringFromObj(procNameObj, &nameLen); overflow = (nameLen > limit); Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (procedure \"%.*s%s\" line %d)", - (overflow ? limit : nameLen), procName, + (int)(overflow ? limit :nameLen), procName, (overflow ? "..." : ""), Tcl_GetErrorLine(interp))); } @@ -2165,7 +2114,7 @@ TclProcCleanupProc( if (resVarInfo->deleteProc) { resVarInfo->deleteProc(resVarInfo); } else { - ckfree(resVarInfo); + Tcl_Free(resVarInfo); } } @@ -2173,10 +2122,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 @@ -2200,9 +2149,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); } @@ -2450,7 +2399,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; } @@ -2536,12 +2485,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; @@ -2754,13 +2703,14 @@ MakeLambdaError( Tcl_Obj *procNameObj) /* Name of the procedure. Used for error * messages and trace information. */ { - int overflow, limit = 60, nameLen; + unsigned int overflow, limit = 60; + size_t nameLen; const char *procName = TclGetStringFromObj(procNameObj, &nameLen); overflow = (nameLen > limit); Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (lambda term \"%.*s%s\" line %d)", - (overflow ? limit : nameLen), procName, + (int)(overflow ? limit : nameLen), procName, (overflow ? "..." : ""), Tcl_GetErrorLine(interp))); } diff --git a/generic/tclProcess.c b/generic/tclProcess.c index 7bd5e1a..838d8d6 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); @@ -130,7 +130,7 @@ FreeProcessInfo( * Free allocated structure. */ - ckfree(info); + Tcl_Free(info); } /* @@ -193,7 +193,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. @@ -800,7 +800,7 @@ void TclProcessCreated( Tcl_Pid pid) /* Process id. */ { - int resolvedPid; + size_t resolvedPid; Tcl_HashEntry *entry, *entry2; int isNew; ProcessInfo *info; @@ -834,7 +834,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 99135d3..f67fcee 100644 --- a/generic/tclRegexp.c +++ b/generic/tclRegexp.c @@ -70,7 +70,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 +85,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 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); /* @@ -190,7 +190,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 +251,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 +262,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; @@ -302,9 +303,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 +312,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 +361,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 +375,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 +441,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 +481,7 @@ Tcl_RegExpExecObj( regexpPtr->string = NULL; regexpPtr->objPtr = textObj; - udata = Tcl_GetUnicodeFromObj(textObj, &length); + udata = TclGetUnicodeFromObj(textObj, &length); if (offset > length) { offset = length; @@ -594,7 +593,7 @@ Tcl_GetRegExpFromObj( * expression. */ int flags) /* Regular expression compilation flags. */ { - int length; + size_t length; TclRegexp *regexpPtr; const char *pattern; @@ -677,7 +676,7 @@ TclRegAbout( */ TclNewObj(resultObj); - TclNewIntObj(infoObj, regexpPtr->re.re_nsub); + TclNewIndexObj(infoObj, regexpPtr->re.re_nsub); Tcl_ListObjAppendElement(NULL, resultObj, infoObj); /* @@ -858,7 +857,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,7 +915,7 @@ 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; @@ -943,7 +942,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 +970,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 +989,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 +1029,9 @@ FreeRegexp( TclDecrRefCount(regexpPtr->globObjPtr); } if (regexpPtr->matches) { - ckfree(regexpPtr->matches); + Tcl_Free(regexpPtr->matches); } - ckfree(regexpPtr); + Tcl_Free(regexpPtr); } /* @@ -1064,7 +1063,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 ca53014..c70cbd3 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 1fb2ad0..5584de4 100644 --- a/generic/tclResult.c +++ b/generic/tclResult.c @@ -27,9 +27,6 @@ enum returnKeys { static Tcl_Obj ** GetKeys(void); static void ReleaseKeys(ClientData clientData); static void ResetObjResult(Interp *iPtr); -#ifndef TCL_NO_DEPRECATED -static void SetupAppendBuffer(Interp *iPtr, int newSpace); -#endif /* !TCL_NO_DEPRECATED */ /* * This structure is used to take a snapshot of the interpreter state in @@ -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,12 @@ Tcl_DiscardInterpState( Tcl_DecrRefCount(statePtr->errorStack); } Tcl_DecrRefCount(statePtr->objResult); - ckfree(statePtr); + Tcl_Free(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); -} - -/* - *---------------------------------------------------------------------- - * - * 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. - * - *---------------------------------------------------------------------- - */ - -const char * -Tcl_GetStringResult( - Tcl_Interp *interp)/* Interpreter whose result to return. */ -{ - 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; -} -#endif /* !TCL_NO_DEPRECATED */ - -/* - *---------------------------------------------------------------------- - * * Tcl_SetObjResult -- * * Arrange for objPtr to be an interpreter's result value. @@ -538,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 } /* @@ -583,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. @@ -675,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); } @@ -712,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 = TclGetStringFromObj(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. @@ -930,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) { @@ -1003,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; @@ -1015,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. @@ -1032,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; /* @@ -1043,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 *); @@ -1053,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); } @@ -1132,7 +559,6 @@ Tcl_SetObjErrorCode( *---------------------------------------------------------------------- */ -#undef Tcl_GetErrorLine int Tcl_GetErrorLine( Tcl_Interp *interp) @@ -1150,7 +576,6 @@ Tcl_GetErrorLine( *---------------------------------------------------------------------- */ -#undef Tcl_SetErrorLine void Tcl_SetErrorLine( Tcl_Interp *interp, @@ -1296,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) TclGetStringFromObj(valuePtr, &length); + if (length) { iPtr->errorInfo = valuePtr; Tcl_IncrRefCount(iPtr->errorInfo); iPtr->flags |= ERR_ALREADY_LOGGED; diff --git a/generic/tclScan.c b/generic/tclScan.c index 67fe6f3..3387f34 100644 --- a/generic/tclScan.c +++ b/generic/tclScan.c @@ -34,7 +34,7 @@ typedef struct { Tcl_UniChar end; } Range; -typedef struct CharSet { +typedef struct { int exclude; /* 1 if this is an exclusion set. */ int nchars; Tcl_UniChar *chars; @@ -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); } } @@ -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; /* @@ -948,7 +948,7 @@ Tcl_ScanObjCmd( if (res == TCL_ERROR) { if (objs != NULL) { - ckfree(objs); + Tcl_Free(objs); } Tcl_DecrRefCount(objPtr); Tcl_SetObjResult(interp, Tcl_NewStringObj( @@ -1084,12 +1084,12 @@ Tcl_ScanObjCmd( } } if (objs != NULL) { - ckfree(objs); + Tcl_Free(objs); } if (code == TCL_OK) { if (underflow && (nconversions == 0)) { if (numVars) { - TclNewIntObj(objPtr, TCL_INDEX_NONE); + TclNewIndexObj(objPtr, TCL_INDEX_NONE); } else { if (objPtr) { Tcl_SetListObj(objPtr, 0, NULL); diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c index 6444823..33b91a3 100644 --- a/generic/tclStrToD.c +++ b/generic/tclStrToD.c @@ -479,7 +479,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. */ @@ -488,7 +488,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 @@ -533,7 +533,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. */ @@ -671,7 +670,6 @@ TclParseNumber( if (under) { goto endgame; } - explicitOctal = 1; state = ZERO_O; break; } @@ -682,10 +680,7 @@ TclParseNumber( state = ZERO_D; break; } -#ifdef TCL_NO_DEPRECATED goto decimal; -#endif - /* FALLTHROUGH */ case OCTAL: /* @@ -761,62 +756,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; /* @@ -962,9 +901,7 @@ TclParseNumber( * digits. */ -#ifdef TCL_NO_DEPRECATED decimal: -#endif acceptState = state; acceptPoint = p; acceptLen = len; @@ -1275,7 +1212,7 @@ TclParseNumber( } } if (endPtrPtr == NULL) { - if ((len != 0) && ((numBytes > 0) || (*p != '\0'))) { + if ((len != 0) && ((numBytes + 1 > 1) || (*p != '\0'))) { status = TCL_ERROR; } } else { @@ -1291,7 +1228,6 @@ TclParseNumber( TclFreeIntRep(objPtr); switch (acceptState) { case SIGNUM: - case BAD_OCTAL: case ZERO_X: case ZERO_O: case ZERO_B: @@ -1530,9 +1466,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); } @@ -2398,7 +2331,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 @@ -2417,13 +2350,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; @@ -2454,7 +2387,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) { @@ -3000,7 +2933,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 -= 5.; if (d > eps.d) { @@ -3011,7 +2944,7 @@ QuickConversion( *decpt = k; return retval; } else { - ckfree(retval); + Tcl_Free(retval); return NULL; } } @@ -3026,7 +2959,7 @@ QuickConversion( end = StrictQuickFormat(d, k, ilim, eps.d, retval, decpt); } if (end == NULL) { - ckfree(retval); + Tcl_Free(retval); return NULL; } *end = '\0'; @@ -3111,7 +3044,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 @@ -3274,7 +3207,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 @@ -3474,7 +3407,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. */ @@ -3681,7 +3614,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. */ @@ -3881,7 +3814,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. */ @@ -4115,7 +4048,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. */ @@ -4281,15 +4214,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 @@ -4625,7 +4557,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; @@ -4735,7 +4667,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 03aceaf..9f46b9d 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -46,28 +46,28 @@ 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); + const Tcl_UniChar *unicode, size_t numChars); +static size_t UnicodeLength(const Tcl_UniChar *unicode); static void UpdateStringOfString(Tcl_Obj *objPtr); /* @@ -123,7 +123,7 @@ const Tcl_ObjType tclStringType = { static void GrowStringBuffer( Tcl_Obj *objPtr, - int needed, + size_t needed, int flag) { /* @@ -135,28 +135,26 @@ GrowStringBuffer( 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 + 1); - } + attempt = 2 * needed; + ptr = (char *)Tcl_AttemptRealloc(objPtr->bytes, attempt + 1); 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 + 1); + ptr = (char *)Tcl_AttemptRealloc(objPtr->bytes, attempt + 1); } } if (ptr == NULL) { @@ -165,7 +163,7 @@ GrowStringBuffer( */ attempt = needed; - ptr = (char *)ckrealloc(objPtr->bytes, attempt + 1); + ptr = (char *)Tcl_Realloc(objPtr->bytes, attempt + 1); } objPtr->bytes = ptr; stringPtr->allocated = attempt; @@ -174,39 +172,34 @@ GrowStringBuffer( static void GrowUnicodeBuffer( Tcl_Obj *objPtr, - int needed) + size_t needed) { /* * Pre-conditions: * objPtr->typePtr == &tclStringType * needed > stringPtr->maxChars - * needed < STRING_MAXCHARS */ String *ptr = NULL, *stringPtr = GET_STRING(objPtr); - int attempt; + size_t attempt; if (stringPtr->maxChars > 0) { /* * Subsequent appends - apply the growth algorithm. */ - if (needed <= STRING_MAXCHARS / 2) { - attempt = 2 * needed; - ptr = stringAttemptRealloc(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 = 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; + attempt = needed + extra; ptr = stringAttemptRealloc(stringPtr, attempt); } } @@ -254,7 +247,7 @@ 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 * byte. */ @@ -266,14 +259,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); @@ -315,10 +307,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 @@ -326,7 +317,7 @@ Tcl_DbNewStringObj( { Tcl_Obj *objPtr; - if (length < 0) { + if (length == TCL_INDEX_NONE) { length = (bytes? strlen(bytes) : 0); } TclDbNewObj(objPtr, file, line); @@ -338,10 +329,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*/) { @@ -372,7 +362,7 @@ Tcl_Obj * 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; @@ -399,13 +389,13 @@ Tcl_NewUnicodeObj( *---------------------------------------------------------------------- */ -int +size_t Tcl_GetCharLength( Tcl_Obj *objPtr) /* The String object to get the num chars * of. */ { String *stringPtr; - int numChars; + size_t numChars = 0; /* * Quick, no-shimmer return for short string reps. @@ -428,10 +418,8 @@ Tcl_GetCharLength( */ if (TclIsPureByteArray(objPtr)) { - int length; - - (void) Tcl_GetByteArrayFromObj(objPtr, &length); - return length; + (void) TclGetByteArrayFromObj(objPtr, &numChars); + return numChars; } /* @@ -446,7 +434,7 @@ Tcl_GetCharLength( * If numChars is unknown, compute it. */ - if (numChars == -1) { + if (numChars == TCL_INDEX_NONE) { TclNumUtfChars(numChars, objPtr->bytes, objPtr->length); stringPtr->numChars = numChars; } @@ -517,14 +505,10 @@ 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 @@ -532,12 +516,13 @@ Tcl_GetUniChar( */ if (TclIsPureByteArray(objPtr)) { - unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &length); + size_t length = 0; + unsigned char *bytes = TclGetByteArrayFromObj(objPtr, &length); if (index >= length) { return -1; } - return (int) bytes[index]; + return bytes[index]; } /* @@ -552,7 +537,7 @@ Tcl_GetUniChar( * If numChars is unknown, compute it. */ - if (stringPtr->numChars == -1) { + if (stringPtr->numChars == TCL_INDEX_NONE) { TclNumUtfChars(stringPtr->numChars, objPtr->bytes, objPtr->length); } if (stringPtr->numChars == objPtr->length) { @@ -588,36 +573,6 @@ Tcl_GetUniChar( /* *---------------------------------------------------------------------- * - * 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. - * - *---------------------------------------------------------------------- - */ - -#ifndef TCL_NO_DEPRECATED -#undef Tcl_GetUnicode -Tcl_UniChar * -Tcl_GetUnicode( - Tcl_Obj *objPtr) /* The object to find the unicode string - * for. */ -{ - return Tcl_GetUnicodeFromObj(objPtr, NULL); -} -#endif /* TCL_NO_DEPRECATED */ - -/* - *---------------------------------------------------------------------- - * * Tcl_GetUnicodeFromObj -- * * Get the Unicode form of the String object with length. If the object @@ -680,15 +635,18 @@ Tcl_GetUnicodeFromObj( 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. */ + 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. */ String *stringPtr; - int length; + size_t length = 0; - if (first < 0) { - first = 0; + if (first == TCL_INDEX_NONE) { + first = TCL_INDEX_START; + } + if (last + 2 <= first + 1) { + return Tcl_NewObj(); } /* @@ -697,7 +655,7 @@ Tcl_GetRange( */ if (TclIsPureByteArray(objPtr)) { - unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &length); + unsigned char *bytes = TclGetByteArrayFromObj(objPtr, &length); if (last >= length) { last = length - 1; @@ -720,7 +678,7 @@ Tcl_GetRange( * If numChars is unknown, compute it. */ - if (stringPtr->numChars == -1) { + if (stringPtr->numChars == TCL_INDEX_NONE) { TclNumUtfChars(stringPtr->numChars, objPtr->bytes, objPtr->length); } if (stringPtr->numChars == objPtr->length) { @@ -752,11 +710,11 @@ Tcl_GetRange( } #if TCL_UTF_MAX <= 3 /* 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; @@ -791,8 +749,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)) { @@ -811,7 +769,7 @@ Tcl_SetStringObj( */ TclInvalidateStringRep(objPtr); - if (length < 0) { + if (length == TCL_INDEX_NONE) { length = (bytes? strlen(bytes) : 0); } TclInitStringRep(objPtr, bytes, length); @@ -844,21 +802,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. */ { String *stringPtr; - if (length < 0) { - /* - * Setting to a negative length is nonsense. This is probably the - * result of overflowing the signed integer range. - */ - - Tcl_Panic("Tcl_SetObjLength: negative length requested: " - "%d (integer overflow?)", length); - } if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetObjLength"); } @@ -879,9 +828,9 @@ Tcl_SetObjLength( * Need to enlarge the buffer. */ if (objPtr->bytes == &tclEmptyString) { - objPtr->bytes = (char *)ckalloc(length + 1); + objPtr->bytes = (char *)Tcl_Alloc(length + 1); } else { - objPtr->bytes = (char *)ckrealloc(objPtr->bytes, length + 1); + objPtr->bytes = (char *)Tcl_Realloc(objPtr->bytes, length + 1); } stringPtr->allocated = length; } @@ -893,14 +842,9 @@ Tcl_SetObjLength( * Invalidate the unicode data. */ - stringPtr->numChars = -1; + stringPtr->numChars = TCL_INDEX_NONE; stringPtr->hasUnicode = 0; } else { - /* - * Changing length of pure unicode string. - */ - - stringCheckLimits(length); if (length > stringPtr->maxChars) { stringPtr = stringRealloc(stringPtr, length); SET_STRING(objPtr, stringPtr); @@ -949,20 +893,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. */ { String *stringPtr; - if (length < 0) { - /* - * Setting to a negative length is nonsense. This is probably the - * result of overflowing the signed integer range. - */ - - return 0; - } if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_AttemptSetObjLength"); } @@ -985,9 +921,9 @@ Tcl_AttemptSetObjLength( char *newBytes; if (objPtr->bytes == &tclEmptyString) { - newBytes = (char *)attemptckalloc(length + 1); + newBytes = (char *)Tcl_AttemptAlloc(length + 1); } else { - newBytes = (char *)attemptckrealloc(objPtr->bytes, length + 1); + newBytes = (char *)Tcl_AttemptRealloc(objPtr->bytes, length + 1); } if (newBytes == NULL) { return 0; @@ -1003,16 +939,13 @@ 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 > STRING_MAXCHARS) { - return 0; - } if (length > stringPtr->maxChars) { stringPtr = stringAttemptRealloc(stringPtr, length); if (stringPtr == NULL) { @@ -1059,7 +992,7 @@ Tcl_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. */ { if (Tcl_IsShared(objPtr)) { @@ -1069,18 +1002,17 @@ Tcl_SetUnicodeObj( SetUnicodeObj(objPtr, unicode, numChars); } -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++; } } - stringCheckLimits(numChars); return numChars; } @@ -1089,12 +1021,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. */ { String *stringPtr; - if (numChars < 0) { + if (numChars == TCL_INDEX_NONE) { numChars = UnicodeLength(unicode); } @@ -1102,7 +1034,6 @@ SetUnicodeObj( * Allocate enough space for the String structure + Unicode string. */ - stringCheckLimits(numChars); stringPtr = stringAlloc(numChars); SET_STRING(objPtr, stringPtr); objPtr->typePtr = &tclStringType; @@ -1140,20 +1071,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. */ { String *stringPtr; - int toCopy = 0; - int eLen = 0; + size_t toCopy = 0; + size_t eLen = 0; - if (length < 0) { + if (length == TCL_INDEX_NONE) { length = (bytes ? strlen(bytes) : 0); } if (length == 0) { @@ -1190,7 +1121,7 @@ Tcl_AppendLimitedToObj( SetStringFromAny(NULL, 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); @@ -1201,7 +1132,7 @@ Tcl_AppendLimitedToObj( } stringPtr = GET_STRING(objPtr); - if (stringPtr->hasUnicode && stringPtr->numChars > 0) { + if (stringPtr->hasUnicode && (stringPtr->numChars+1) > 1) { AppendUtfToUnicodeRep(objPtr, ellipsis, eLen); } else { AppendUtfToUtfRep(objPtr, ellipsis, eLen); @@ -1230,17 +1161,17 @@ 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 -1, 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); } /* *---------------------------------------------------------------------- * - * Tcl_AppendUnicodeToObj -- + * TclAppendUnicodeToObj -- * * This function appends a Unicode string to an object in the most * efficient manner possible. Length must be >= 0. @@ -1255,16 +1186,16 @@ Tcl_AppendToObj( */ void -Tcl_AppendUnicodeToObj( +TclAppendUnicodeToObj( 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". */ { String *stringPtr; if (Tcl_IsShared(objPtr)) { - Tcl_Panic("%s called with shared object", "Tcl_AppendUnicodeToObj"); + Tcl_Panic("%s called with shared object", "TclAppendUnicodeToObj"); } if (length == 0) { @@ -1313,7 +1244,8 @@ Tcl_AppendObjToObj( Tcl_Obj *appendObjPtr) /* Object to append. */ { String *stringPtr; - int length, numChars, appendNumChars = -1; + size_t length = 0, numChars; + size_t appendNumChars = TCL_INDEX_NONE; const char *bytes; /* @@ -1337,7 +1269,7 @@ Tcl_AppendObjToObj( /* * You might expect the code here to be * - * bytes = Tcl_GetByteArrayFromObj(appendObjPtr, &length); + * bytes = TclGetByteArrayFromObj(appendObjPtr, &length); * TclAppendBytesToByteArray(objPtr, bytes, length); * * and essentially all of the time that would be fine. However, it @@ -1353,10 +1285,10 @@ Tcl_AppendObjToObj( * First, get the lengths. */ - int lengthSrc; + size_t lengthSrc = 0; - (void) Tcl_GetByteArrayFromObj(objPtr, &length); - (void) Tcl_GetByteArrayFromObj(appendObjPtr, &lengthSrc); + (void) TclGetByteArrayFromObj(objPtr, &length); + (void) TclGetByteArrayFromObj(appendObjPtr, &lengthSrc); /* * Grow buffer enough for the append. @@ -1399,7 +1331,7 @@ Tcl_AppendObjToObj( if (TclHasIntRep(appendObjPtr, &tclStringType)) { Tcl_UniChar *unicode = - Tcl_GetUnicodeFromObj(appendObjPtr, &numChars); + TclGetUnicodeFromObj(appendObjPtr, &numChars); AppendUnicodeToUnicodeRep(objPtr, unicode, numChars); } else { @@ -1418,7 +1350,7 @@ Tcl_AppendObjToObj( bytes = TclGetStringFromObj(appendObjPtr, &length); numChars = stringPtr->numChars; - if ((numChars >= 0) && TclHasIntRep(appendObjPtr, &tclStringType)) { + if ((numChars != TCL_INDEX_NONE) && TclHasIntRep(appendObjPtr, &tclStringType)) { String *appendStringPtr = GET_STRING(appendObjPtr); appendNumChars = appendStringPtr->numChars; @@ -1426,7 +1358,7 @@ Tcl_AppendObjToObj( AppendUtfToUtfRep(objPtr, bytes, length); - if (numChars >= 0 && appendNumChars >= 0) { + if ((numChars != TCL_INDEX_NONE) && (appendNumChars != TCL_INDEX_NONE)) { stringPtr->numChars = numChars + appendNumChars; } } @@ -1452,12 +1384,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. */ { String *stringPtr; - int numChars; + size_t numChars; - if (appendNumChars < 0) { + if (appendNumChars == TCL_INDEX_NONE) { appendNumChars = UnicodeLength(unicode); } if (appendNumChars == 0) { @@ -1476,10 +1408,9 @@ AppendUnicodeToUnicodeRep( */ numChars = stringPtr->numChars + appendNumChars; - stringCheckLimits(numChars); if (numChars > stringPtr->maxChars) { - int offset = -1; + size_t index = TCL_INDEX_NONE; /* * Protect against case where unicode points into the existing @@ -1489,7 +1420,7 @@ AppendUnicodeToUnicodeRep( if (unicode && unicode >= stringPtr->unicode && unicode <= stringPtr->unicode + stringPtr->maxChars) { - offset = unicode - stringPtr->unicode; + index = unicode - stringPtr->unicode; } GrowUnicodeBuffer(objPtr, numChars); @@ -1499,8 +1430,8 @@ AppendUnicodeToUnicodeRep( * Relocate unicode if needed; see above. */ - if (offset >= 0) { - unicode = stringPtr->unicode + offset; + if (index != TCL_INDEX_NONE) { + unicode = stringPtr->unicode + index; } } @@ -1541,13 +1472,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. */ { String *stringPtr = GET_STRING(objPtr); numChars = ExtendStringRepWithUnicode(objPtr, unicode, numChars); - if (stringPtr->numChars != -1) { + if (stringPtr->numChars != TCL_INDEX_NONE) { stringPtr->numChars += numChars; } } @@ -1574,7 +1505,7 @@ 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. */ { String *stringPtr; @@ -1610,10 +1541,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. */ { String *stringPtr; - int newLength, oldLength; + size_t newLength, oldLength; if (numBytes == 0) { return; @@ -1629,13 +1560,10 @@ AppendUtfToUtfRep( } oldLength = objPtr->length; newLength = numBytes + oldLength; - if (newLength < 0) { - Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); - } 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 @@ -1659,7 +1587,7 @@ AppendUtfToUtfRep( * Relocate bytes if needed; see above. */ - if (offset >= 0) { + if (offset != TCL_INDEX_NONE) { bytes = objPtr->bytes + offset; } } @@ -1668,7 +1596,7 @@ AppendUtfToUtfRep( * Invalidate the unicode data. */ - stringPtr->numChars = -1; + stringPtr->numChars = TCL_INDEX_NONE; stringPtr->hasUnicode = 0; if (bytes) { @@ -1681,7 +1609,7 @@ AppendUtfToUtfRep( /* *---------------------------------------------------------------------- * - * Tcl_AppendStringsToObjVA -- + * Tcl_AppendStringsToObj -- * * This function appends one or more null-terminated strings to an * object. @@ -1697,10 +1625,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"); } @@ -1713,35 +1644,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); } @@ -1774,8 +1676,8 @@ Tcl_AppendFormatToObj( Tcl_Obj *const objv[]) { const char *span = format, *msg, *errCode; - int numBytes = 0, objIndex = 0, gotXpg = 0, gotSequential = 0; - int originalLength, limit; + int objIndex = 0, gotXpg = 0, gotSequential = 0; + size_t originalLength, limit, numBytes = 0; Tcl_UniChar ch = 0; static const char *mixedXPG = "cannot mix \"%\" and \"%n$\" conversion specifiers"; @@ -1788,8 +1690,8 @@ Tcl_AppendFormatToObj( if (Tcl_IsShared(appendObj)) { Tcl_Panic("%s called with shared object", "Tcl_AppendFormatToObj"); } - TclGetStringFromObj(appendObj, &originalLength); - limit = INT_MAX - originalLength; + (void)TclGetStringFromObj(appendObj, &originalLength); + limit = (size_t)INT_MAX - originalLength; /* * Format string is NUL-terminated. @@ -1802,7 +1704,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); @@ -1934,7 +1837,7 @@ Tcl_AppendFormatToObj( format += step; step = TclUtfToUniChar(format, &ch); } - if (width > limit) { + if (width > (int) limit) { msg = overflow; errCode = "OVERFLOW"; goto errorMsg; @@ -2160,20 +2063,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; @@ -2208,10 +2103,10 @@ 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++; } @@ -2219,10 +2114,10 @@ Tcl_AppendFormatToObj( } if (gotZero) { length += Tcl_GetCharLength(segment); - if (length < width) { + if (length < (size_t)width) { segmentLimit -= width - length; } - while (length < width) { + while (length < (size_t)width) { Tcl_AppendToObj(segment, "0", 1); length++; } @@ -2243,9 +2138,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; @@ -2309,9 +2205,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; @@ -2323,7 +2219,7 @@ Tcl_AppendFormatToObj( } shift -= numBits; } - digitOffset = (int) (bits % base); + digitOffset = bits % base; if (digitOffset > 9) { if (ch == 'X') { bytes[numDigits] = 'A' + digitOffset - 10; @@ -2339,10 +2235,10 @@ 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++; } @@ -2350,10 +2246,10 @@ Tcl_AppendFormatToObj( } if (gotZero) { length += Tcl_GetCharLength(segment); - if (length < width) { + if (length < (size_t)width) { segmentLimit -= width - length; } - while (length < width) { + while (length < (size_t)width) { Tcl_AppendToObj(segment, "0", 1); length++; } @@ -2472,7 +2368,7 @@ Tcl_AppendFormatToObj( } } - TclGetStringFromObj(segment, &segmentNumBytes); + (void)TclGetStringFromObj(segment, &segmentNumBytes); if (segmentNumBytes > limit) { if (allocSegment) { Tcl_DecrRefCount(segment); @@ -2617,7 +2513,7 @@ AppendPrintfToObjVA( */ q = TclUtfPrev(end, bytes); - if (!Tcl_UtfCharComplete(q, (int)(end - q))) { + if (!Tcl_UtfCharComplete(q, (end - q))) { end = q; } @@ -2628,7 +2524,7 @@ AppendPrintfToObjVA( } Tcl_ListObjAppendElement(NULL, list, - Tcl_NewStringObj(bytes , (int)(end - bytes))); + Tcl_NewStringObj(bytes , (end - bytes))); break; } @@ -2678,7 +2574,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; @@ -2686,7 +2582,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; } @@ -2738,7 +2634,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); } @@ -2819,12 +2715,12 @@ Tcl_ObjPrintf( char * TclGetStringStorage( Tcl_Obj *objPtr, - unsigned int *sizePtr) + size_t *sizePtr) { String *stringPtr; if (!TclHasIntRep(objPtr, &tclStringType) || objPtr->bytes == NULL) { - return TclGetStringFromObj(objPtr, (int *)sizePtr); + return TclGetStringFromObj(objPtr, sizePtr); } stringPtr = GET_STRING(objPtr); @@ -2853,12 +2749,12 @@ 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); /* assert (count >= 2) */ @@ -2881,13 +2777,13 @@ TclStringRepeat( if (binary) { /* Result will be pure byte array. Pre-size it */ - Tcl_GetByteArrayFromObj(objPtr, &length); + (void)TclGetByteArrayFromObj(objPtr, &length); } else if (unichar) { /* Result will be pure Tcl_UniChar array. Pre-size it. */ - Tcl_GetUnicodeFromObj(objPtr, &length); + (void)TclGetUnicodeFromObj(objPtr, &length); } else { /* Result will be concat of string reps. Pre-size it. */ - Tcl_GetStringFromObj(objPtr, &length); + (void)TclGetStringFromObj(objPtr, &length); } if (length == 0) { @@ -2945,7 +2841,7 @@ TclStringRepeat( Tcl_AppendObjToObj(objResultPtr, objResultPtr); done *= 2; } - Tcl_AppendUnicodeToObj(objResultPtr, Tcl_GetUnicode(objResultPtr), + TclAppendUnicodeToObj(objResultPtr, Tcl_GetUnicode(objResultPtr), (count - done) * length); } else { /* @@ -2953,7 +2849,7 @@ TclStringRepeat( */ if (!inPlace || Tcl_IsShared(objPtr)) { - objResultPtr = Tcl_NewStringObj(Tcl_GetString(objPtr), length); + objResultPtr = Tcl_NewStringObj(TclGetString(objPtr), length); } else { TclFreeIntRep(objPtr); objResultPtr = objPtr; @@ -2961,7 +2857,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); } @@ -2972,7 +2868,7 @@ TclStringRepeat( Tcl_AppendObjToObj(objResultPtr, objResultPtr); done *= 2; } - Tcl_AppendToObj(objResultPtr, Tcl_GetString(objResultPtr), + Tcl_AppendToObj(objResultPtr, TclGetString(objResultPtr), (count - done) * length); } return objResultPtr; @@ -3003,7 +2899,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; int first = objc - 1; /* Index of first value possibly not empty */ int last = 0; /* Index of last value possibly not empty */ @@ -3063,7 +2960,7 @@ TclStringCat( * Result will be pure byte array. Pre-size it */ - int numBytes; + size_t numBytes = 0; ov = objv; oc = objc; do { @@ -3076,14 +2973,12 @@ TclStringCat( */ if (TclIsPureByteArray(objPtr)) { - Tcl_GetByteArrayFromObj(objPtr, &numBytes); /* PANIC? */ + (void)TclGetByteArrayFromObj(objPtr, &numBytes); /* PANIC? */ if (numBytes) { last = objc - oc; if (length == 0) { first = last; - } else if (numBytes > INT_MAX - length) { - goto overflow; } length += numBytes; } @@ -3100,15 +2995,13 @@ TclStringCat( Tcl_Obj *objPtr = *ov++; if ((objPtr->bytes == NULL) || (objPtr->length)) { - int numChars; + size_t numChars; - Tcl_GetUnicodeFromObj(objPtr, &numChars); /* PANIC? */ + (void)TclGetUnicodeFromObj(objPtr, &numChars); /* PANIC? */ if (numChars) { last = objc - oc; if (length == 0) { first = last; - } else if (numChars > INT_MAX - length) { - goto overflow; } length += numChars; } @@ -3135,7 +3028,7 @@ TclStringCat( /* No string rep; Take the chance we can avoid making it */ pendingPtr = objPtr; } else { - Tcl_GetStringFromObj(objPtr, &length); /* PANIC? */ + (void)TclGetStringFromObj(objPtr, &length); /* PANIC? */ } } while (--oc && (length == 0) && (pendingPtr == NULL)); @@ -3149,7 +3042,7 @@ TclStringCat( first = last = objc - oc - 1; if (oc && (length == 0)) { - int numBytes; + size_t numBytes; /* assert ( pendingPtr != NULL ) */ @@ -3161,20 +3054,20 @@ TclStringCat( do { Tcl_Obj *objPtr = *ov++; - Tcl_GetStringFromObj(objPtr, &numBytes); /* PANIC? */ + (void)TclGetStringFromObj(objPtr, &numBytes); /* PANIC? */ } while (--oc && numBytes == 0 && pendingPtr->bytes == NULL); if (numBytes) { last = objc -oc -1; } if (oc || numBytes) { - Tcl_GetStringFromObj(pendingPtr, &length); + (void)TclGetStringFromObj(pendingPtr, &length); } if (length == 0) { if (numBytes) { first = last; } - } else if (numBytes > INT_MAX - length) { + } else if (numBytes + length > (size_t)INT_MAX) { goto overflow; } length += numBytes; @@ -3182,15 +3075,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 + length > (size_t)INT_MAX) { goto overflow; } length += numBytes; @@ -3217,10 +3111,10 @@ TclStringCat( */ if (inPlace && !Tcl_IsShared(*objv)) { - int start; + size_t start = 0; objResultPtr = *objv++; objc--; - Tcl_GetByteArrayFromObj(objResultPtr, &start); + (void)TclGetByteArrayFromObj(objResultPtr, &start); dst = Tcl_SetByteArrayLength(objResultPtr, length) + start; } else { objResultPtr = Tcl_NewByteArrayObj(NULL, length); @@ -3236,8 +3130,8 @@ TclStringCat( */ if (TclIsPureByteArray(objPtr)) { - int more; - unsigned char *src = Tcl_GetByteArrayFromObj(objPtr, &more); + size_t more = 0; + unsigned char *src = TclGetByteArrayFromObj(objPtr, &more); memcpy(dst, src, more); dst += more; } @@ -3247,12 +3141,12 @@ 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. */ - Tcl_GetUnicodeFromObj(objResultPtr, &start); + (void)TclGetUnicodeFromObj(objResultPtr, &start); Tcl_InvalidateStringRep(objResultPtr); if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) { if (interp) { @@ -3287,8 +3181,8 @@ TclStringCat( Tcl_Obj *objPtr = *objv++; if ((objPtr->bytes == NULL) || (objPtr->length)) { - int more; - Tcl_UniChar *src = Tcl_GetUnicodeFromObj(objPtr, &more); + size_t more; + Tcl_UniChar *src = TclGetUnicodeFromObj(objPtr, &more); memcpy(dst, src, more * sizeof(Tcl_UniChar)); dst += more; } @@ -3298,21 +3192,21 @@ TclStringCat( char *dst; if (inPlace && !Tcl_IsShared(*objv)) { - int start; + size_t start; objResultPtr = *objv++; objc--; - Tcl_GetStringFromObj(objResultPtr, &start); + (void)TclGetStringFromObj(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 ) */ TclFreeIntRep(objResultPtr); @@ -3322,20 +3216,20 @@ 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; - char *src = Tcl_GetStringFromObj(objPtr, &more); + size_t more; + char *src = TclGetStringFromObj(objPtr, &more); memcpy(dst, src, more); dst += more; @@ -3377,10 +3271,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)) { @@ -3398,8 +3293,8 @@ TclStringCmp( * arrays anyway, and we have no memcasecmp() for some reason... :^) */ - s1 = (char *) Tcl_GetByteArrayFromObj(value1Ptr, &s1len); - s2 = (char *) Tcl_GetByteArrayFromObj(value2Ptr, &s2len); + s1 = (char *) TclGetByteArrayFromObj(value1Ptr, &s1len); + s2 = (char *) TclGetByteArrayFromObj(value2Ptr, &s2len); memCmpFn = memcmp; } else if (TclHasIntRep(value1Ptr, &tclStringType) && TclHasIntRep(value2Ptr, &tclStringType)) { @@ -3411,9 +3306,9 @@ TclStringCmp( */ if (nocase) { - s1 = (char *) Tcl_GetUnicodeFromObj(value1Ptr, &s1len); - s2 = (char *) Tcl_GetUnicodeFromObj(value2Ptr, &s2len); - memCmpFn = (memCmpFn_t)(void *)Tcl_UniCharNcasecmp; + s1 = (char *) TclGetUnicodeFromObj(value1Ptr, &s1len); + s2 = (char *) TclGetUnicodeFromObj(value2Ptr, &s2len); + memCmpFn = (memCmpFn_t)TclUniCharNcasecmp; } else { s1len = Tcl_GetCharLength(value1Ptr); s2len = Tcl_GetCharLength(value2Ptr); @@ -3438,7 +3333,7 @@ TclStringCmp( s1len *= sizeof(Tcl_UniChar); s2len *= sizeof(Tcl_UniChar); } else { - memCmpFn = (memCmpFn_t)(void *)Tcl_UniCharNcmp; + memCmpFn = (memCmpFn_t) TclUniCharNcmp; } } } @@ -3495,27 +3390,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)) { @@ -3559,14 +3454,14 @@ Tcl_Obj * TclStringFirst( Tcl_Obj *needle, Tcl_Obj *haystack, - int start) + size_t start) { - int lh, ln = Tcl_GetCharLength(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) { @@ -3578,10 +3473,10 @@ TclStringFirst( if (TclIsPureByteArray(needle) && TclIsPureByteArray(haystack)) { unsigned char *end, *check, *bh; - unsigned char *bn = Tcl_GetByteArrayFromObj(needle, &ln); + unsigned char *bn = TclGetByteArrayFromObj(needle, &ln); /* Find bytes in bytes */ - bh = Tcl_GetByteArrayFromObj(haystack, &lh); + bh = TclGetByteArrayFromObj(haystack, &lh); if ((lh < ln) || (start > lh - ln)) { /* Don't start the loop if there cannot be a valid answer */ goto firstEnd; @@ -3624,8 +3519,8 @@ TclStringFirst( * do only the well-defined Tcl_UniChar array search. */ - un = Tcl_GetUnicodeFromObj(needle, &ln); - uh = Tcl_GetUnicodeFromObj(haystack, &lh); + un = TclGetUnicodeFromObj(needle, &ln); + uh = TclGetUnicodeFromObj(haystack, &lh); if ((lh < ln) || (start > lh - ln)) { /* Don't start the loop if there cannot be a valid answer */ goto firstEnd; @@ -3640,8 +3535,8 @@ TclStringFirst( } } firstEnd: - TclNewIntObj(result, value); - return result; + TclNewIndexObj(obj, value); + return obj; } /* @@ -3666,12 +3561,12 @@ Tcl_Obj * TclStringLast( Tcl_Obj *needle, Tcl_Obj *haystack, - int last) + size_t last) { - int lh, ln = Tcl_GetCharLength(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) { /* @@ -3684,10 +3579,10 @@ TclStringLast( } if (TclIsPureByteArray(needle) && TclIsPureByteArray(haystack)) { - unsigned char *check, *bh = Tcl_GetByteArrayFromObj(haystack, &lh); - unsigned char *bn = Tcl_GetByteArrayFromObj(needle, &ln); + unsigned char *check, *bh = TclGetByteArrayFromObj(haystack, &lh); + unsigned char *bn = TclGetByteArrayFromObj(needle, &ln); - if (last >= lh) { + if (last + 1 >= lh + 1) { last = lh - 1; } if (last + 1 < ln) { @@ -3707,10 +3602,10 @@ TclStringLast( goto lastEnd; } - uh = Tcl_GetUnicodeFromObj(haystack, &lh); - un = Tcl_GetUnicodeFromObj(needle, &ln); + uh = TclGetUnicodeFromObj(haystack, &lh); + un = TclGetUnicodeFromObj(needle, &ln); - if (last >= lh) { + if (last + 1 >= lh + 1) { last = lh - 1; } if (last + 1 < ln) { @@ -3727,8 +3622,8 @@ TclStringLast( checkStr--; } lastEnd: - TclNewIntObj(result, value); - return result; + TclNewIndexObj(obj, value); + return obj; } /* @@ -3753,7 +3648,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; @@ -3783,8 +3678,8 @@ TclStringReverse( int inPlace = flags & TCL_STRING_IN_PLACE; if (TclIsPureByteArray(objPtr)) { - int numBytes; - unsigned char *from = Tcl_GetByteArrayFromObj(objPtr, &numBytes); + size_t numBytes = 0; + unsigned char *from = TclGetByteArrayFromObj(objPtr, &numBytes); if (!inPlace || Tcl_IsShared(objPtr)) { objPtr = Tcl_NewByteArrayObj(NULL, numBytes); @@ -3828,8 +3723,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)) { @@ -3838,7 +3733,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, @@ -3848,8 +3743,8 @@ TclStringReverse( * Pass 1. Reverse the bytes of each multi-byte character. */ - int charCount = 0; - int bytesLeft = numBytes; + size_t charCount = 0; + size_t bytesLeft = numBytes; while (bytesLeft) { /* @@ -3858,7 +3753,7 @@ TclStringReverse( * skip calling Tcl_UtfCharComplete() here. */ - int bytesInChar = TclUtfToUniChar(from, &ch); + size_t bytesInChar = TclUtfToUniChar(from, &ch); ReverseBytes((unsigned char *)to, (unsigned char *)from, bytesInChar); @@ -3908,18 +3803,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) { @@ -3937,8 +3828,8 @@ TclStringReplace( */ if (TclIsPureByteArray(objPtr)) { - int numBytes; - unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &numBytes); + size_t numBytes = 0; + unsigned char *bytes = TclGetByteArrayFromObj(objPtr, &numBytes); if (insertPtr == NULL) { /* Replace something with nothing. */ @@ -3960,9 +3851,9 @@ TclStringReplace( } if (TclIsPureByteArray(insertPtr)) { - int newBytes; + size_t newBytes = 0; unsigned char *iBytes - = Tcl_GetByteArrayFromObj(insertPtr, &newBytes); + = TclGetByteArrayFromObj(insertPtr, &newBytes); if (count == newBytes && inPlace && !Tcl_IsShared(objPtr)) { /* @@ -3975,7 +3866,7 @@ TclStringReplace( return objPtr; } - if (newBytes > INT_MAX - (numBytes - count)) { + if ((size_t)newBytes > INT_MAX - (numBytes - count)) { if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "max size for a Tcl value (%d bytes) exceeded", @@ -4005,8 +3896,8 @@ TclStringReplace( /* The traditional implementation... */ { - int numChars; - Tcl_UniChar *ustring = Tcl_GetUnicodeFromObj(objPtr, &numChars); + size_t numChars; + Tcl_UniChar *ustring = TclGetUnicodeFromObj(objPtr, &numChars); /* TODO: Is there an in-place option worth pursuing here? */ @@ -4014,8 +3905,8 @@ TclStringReplace( if (insertPtr) { Tcl_AppendObjToObj(result, insertPtr); } - if (first + count < numChars) { - Tcl_AppendUnicodeToObj(result, ustring + first + count, + if (first + count < (size_t)numChars) { + TclAppendUnicodeToObj(result, ustring + first + count, numChars - first - count); } @@ -4055,21 +3946,20 @@ static void ExtendUnicodeRepWithString( Tcl_Obj *objPtr, const char *bytes, - int numBytes, - int numAppendChars) + size_t numBytes, + size_t numAppendChars) { String *stringPtr = GET_STRING(objPtr); - int needed, numOrigChars = 0; + size_t needed, numOrigChars = 0; Tcl_UniChar *dst, unichar = 0; if (stringPtr->hasUnicode) { numOrigChars = stringPtr->numChars; } - if (numAppendChars == -1) { + if (numAppendChars == TCL_INDEX_NONE) { TclNumUtfChars(numAppendChars, bytes, numBytes); } needed = numOrigChars + numAppendChars; - stringCheckLimits(needed); if (needed > stringPtr->maxChars) { GrowUnicodeBuffer(objPtr, needed); @@ -4117,7 +4007,7 @@ DupStringInternalRep( 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 @@ -4253,21 +4143,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; String *stringPtr = GET_STRING(objPtr); - if (numChars < 0) { + if (numChars == TCL_INDEX_NONE) { numChars = UnicodeLength(unicode); } @@ -4289,12 +4179,9 @@ ExtendStringRepWithUnicode( goto copyBytes; } - for (i = 0; i < numChars && size >= 0; i++) { + for (i = 0; i < numChars; i++) { size += TclUtfCount(unicode[i]); } - if (size < 0) { - Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); - } /* * Grow space if needed. @@ -4335,7 +4222,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 e01ba2d..c8f87be 100644 --- a/generic/tclStringRep.h +++ b/generic/tclStringRep.h @@ -31,6 +31,10 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ + +#ifndef _TCLSTRINGREP +#define _TCLSTRINGREP + /* * The following structure is the internal rep for a String object. It keeps @@ -47,15 +51,15 @@ */ typedef struct { - int numChars; /* The number of chars in the string. -1 means - * this value has not been calculated. >= 0 + size_t numChars; /* The number of chars in the string. -1 means + * this value has not been calculated. Any other * 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 + size_t 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 + size_t 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. */ @@ -64,31 +68,23 @@ typedef struct { * field above. */ } String; -#define STRING_MAXCHARS \ - (int)(((size_t)UINT_MAX - 1 - offsetof(String, unicode))/sizeof(Tcl_UniChar)) #define STRING_SIZE(numChars) \ (offsetof(String, unicode) + ((numChars + 1) * sizeof(Tcl_UniChar))) -#define stringCheckLimits(numChars) \ - do { \ - if ((numChars) < 0 || (numChars) > STRING_MAXCHARS) { \ - Tcl_Panic("max length for a Tcl unicode value (%d chars) exceeded", \ - (int)STRING_MAXCHARS); \ - } \ - } while (0) #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) \ ((objPtr)->internalRep.twoPtrValue.ptr2 = NULL), \ ((objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (stringPtr)) +#endif /* _TCLSTRINGREP */ /* * Local Variables: * mode: c diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 0204bca..93529d1 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -41,13 +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_DumpActiveMemory #undef Tcl_ValidateAllMemory #undef Tcl_FindHashEntry @@ -67,48 +62,45 @@ #undef TclWinNToHS #undef TclStaticPackage #undef Tcl_BackgroundError -#undef TclGuessPackageName -#undef TclGetLoadedPackages #define TclStaticPackage Tcl_StaticPackage #undef Tcl_UniCharToUtfDString #undef Tcl_UtfToUniCharDString #undef Tcl_UtfToUniChar -#undef Tcl_MacOSXOpenBundleResources -#if TCL_UTF_MAX > 3 -static void uniCodePanic(void) { +#if TCL_UTF_MAX <= 3 +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 (int *(*)(Tcl_Obj *))(void *)uniCodePanic -# define Tcl_GetUnicodeFromObj (int *(*)(Tcl_Obj *, Tcl_UniChar *))(void *)uniCodePanic -# define Tcl_NewUnicodeObj (Tcl_Obj *(*)(const int *, Tcl_UniChar))(void *)uniCodePanic -# define Tcl_SetUnicodeObj (void(*)(Tcl_Obj *, const Tcl_UniChar *, int))(void *)uniCodePanic -# define Tcl_AppendUnicodeToObj (void(*)(Tcl_Obj *, const Tcl_UniChar *, int))(void *)uniCodePanic -# define Tcl_UniCharNcasecmp (int(*)(const Tcl_UniChar *, const Tcl_UniChar *, unsigned long))(void *)uniCodePanic -# define Tcl_UniCharCaseMatch (int(*)(const Tcl_UniChar *, const Tcl_UniChar *, int))(void *)uniCodePanic -# define Tcl_UniCharLen (int(*)(const Tcl_UniChar *))(void *)uniCodePanic -# define Tcl_UniCharNcmp (int(*)(const Tcl_UniChar *, const Tcl_UniChar *, unsigned long))(void *)uniCodePanic +# define Tcl_GetUnicodeFromObj (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 #endif #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 @@ -116,6 +108,7 @@ static void uniCodePanic(void) { #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 @@ -130,11 +123,8 @@ static void uniCodePanic(void) { #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 @@ -152,247 +142,6 @@ static void uniCodePanic(void) { #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 NULL - -/* 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, 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 -#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 TclGetLoadedPackagesEx(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 -#endif -#endif /* TCL_NO_DEPRECATED */ #define TclpCreateTempFile_ TclpCreateTempFile #define TclUnixWaitForFile_ TclUnixWaitForFile @@ -412,41 +161,14 @@ TclWinGetPlatformId(void) # 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) @@ -469,35 +191,12 @@ void *TclWinGetTclInstance() return hInstance; } -int +size_t TclpGetPid(Tcl_Pid pid) { - return (int)(size_t)pid; + return (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); -} -#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 * we have to make sure that all stub entries on Cygwin64 follow the Win64 @@ -536,16 +235,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); } @@ -559,170 +248,6 @@ static int utfNcasecmp(const char *s1, const char *s2, unsigned int n){ #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_GetStringResult -# define Tcl_GetStringResult 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 -# define Tcl_GetUnicode 0 -#if TCL_UTF_MAX < 4 -# define Tcl_AppendUnicodeToObj 0 -# define Tcl_UniCharCaseMatch 0 -# define Tcl_UniCharLen 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 -#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 - -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 -#endif - /* * WARNING: The contents of this file is automatically generated by the * tools/genStubs.tcl script. Any modifications to the function declarations @@ -754,7 +279,7 @@ static const TclIntStubs tclIntStubs = { TclCleanupChildren, /* 5 */ TclCleanupCommand, /* 6 */ TclCopyAndCollapse, /* 7 */ - TclCopyChannelOld, /* 8 */ + 0, /* 8 */ TclCreatePipeline, /* 9 */ TclCreateProc, /* 10 */ TclDeleteCompiledLocalVars, /* 11 */ @@ -780,23 +305,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 */ 0, /* 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 */ @@ -823,7 +348,7 @@ static const TclIntStubs tclIntStubs = { TclpFree, /* 74 */ TclpGetClicks, /* 75 */ TclpGetSeconds, /* 76 */ - TclpGetTime, /* 77 */ + 0, /* 77 */ 0, /* 78 */ 0, /* 79 */ 0, /* 80 */ @@ -834,7 +359,7 @@ static const TclIntStubs tclIntStubs = { 0, /* 85 */ 0, /* 86 */ 0, /* 87 */ - TclPrecTraceProc, /* 88 */ + 0, /* 88 */ TclPreventAliasLoop, /* 89 */ 0, /* 90 */ TclProcCleanupProc, /* 91 */ @@ -850,7 +375,7 @@ static const TclIntStubs tclIntStubs = { TclSetPreInitScript, /* 101 */ TclSetupEnv, /* 102 */ TclSockGetPort, /* 103 */ - TclSockMinimumBuffersOld, /* 104 */ + 0, /* 104 */ 0, /* 105 */ 0, /* 106 */ 0, /* 107 */ @@ -858,28 +383,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, /* 133 */ 0, /* 134 */ 0, /* 135 */ 0, /* 136 */ @@ -904,8 +429,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 */ @@ -913,8 +438,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 */ @@ -924,12 +449,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 */ @@ -982,7 +507,7 @@ static const TclIntStubs tclIntStubs = { TclGetSrcInfoForPc, /* 233 */ TclVarHashCreateVar, /* 234 */ TclInitVarHashTable, /* 235 */ - TclBackgroundException, /* 236 */ + 0, /* 236 */ TclResetCancellation, /* 237 */ TclNRInterpProc, /* 238 */ TclNRInterpProcCore, /* 239 */ @@ -1005,8 +530,8 @@ static const TclIntStubs tclIntStubs = { TclPtrUnsetVar, /* 256 */ TclStaticPackage, /* 257 */ TclpCreateTemporaryDirectory, /* 258 */ - TclGetBytesFromObj, /* 259 */ - TclUnusedStubEntry, /* 260 */ + TclAppendUnicodeToObj, /* 259 */ + TclGetBytesFromObj, /* 260 */ }; static const TclIntPlatStubs tclIntPlatStubs = { @@ -1023,10 +548,10 @@ static const TclIntPlatStubs tclIntPlatStubs = { TclpOpenFile, /* 7 */ TclUnixWaitForFile, /* 8 */ TclpCreateTempFile, /* 9 */ - TclpReaddir, /* 10 */ - TclpLocaltime_unix, /* 11 */ - TclpGmtime_unix, /* 12 */ - TclpInetNtoa, /* 13 */ + 0, /* 10 */ + 0, /* 11 */ + 0, /* 12 */ + 0, /* 13 */ TclUnixCopyFile, /* 14 */ TclMacOSXGetFileAttribute, /* 15 */ TclMacOSXSetFileAttribute, /* 16 */ @@ -1047,16 +572,16 @@ static const TclIntPlatStubs tclIntPlatStubs = { #endif /* UNIX */ #if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ TclWinConvertError, /* 0 */ - TclWinConvertWSAError, /* 1 */ - TclWinGetServByName, /* 2 */ - TclWinGetSockOpt, /* 3 */ + 0, /* 1 */ + 0, /* 2 */ + 0, /* 3 */ TclWinGetTclInstance, /* 4 */ TclUnixWaitForFile, /* 5 */ - TclWinNToHS, /* 6 */ - TclWinSetSockOpt, /* 7 */ + 0, /* 6 */ + 0, /* 7 */ TclpGetPid, /* 8 */ - TclWinGetPlatformId, /* 9 */ - TclpReaddir, /* 10 */ + 0, /* 9 */ + 0, /* 10 */ TclGetAndDetachPids, /* 11 */ TclpCloseFile, /* 12 */ TclpCreateCommandChannel, /* 13 */ @@ -1067,14 +592,14 @@ static const TclIntPlatStubs tclIntPlatStubs = { TclpMakeFile, /* 18 */ TclpOpenFile, /* 19 */ TclWinAddProcess, /* 20 */ - TclpInetNtoa, /* 21 */ + 0, /* 21 */ TclpCreateTempFile, /* 22 */ 0, /* 23 */ TclWinNoBackslash, /* 24 */ 0, /* 25 */ - TclWinSetInterfaces, /* 26 */ + 0, /* 26 */ TclWinFlushDirtyChannels, /* 27 */ - TclWinResetInterfaces, /* 28 */ + 0, /* 28 */ TclWinCPUID, /* 29 */ TclUnixOpenTemporaryFile, /* 30 */ #endif /* WIN */ @@ -1089,10 +614,10 @@ static const TclIntPlatStubs tclIntPlatStubs = { TclpOpenFile, /* 7 */ TclUnixWaitForFile, /* 8 */ TclpCreateTempFile, /* 9 */ - TclpReaddir, /* 10 */ - TclpLocaltime_unix, /* 11 */ - TclpGmtime_unix, /* 12 */ - TclpInetNtoa, /* 13 */ + 0, /* 10 */ + 0, /* 11 */ + 0, /* 12 */ + 0, /* 13 */ TclUnixCopyFile, /* 14 */ TclMacOSXGetFileAttribute, /* 15 */ TclMacOSXSetFileAttribute, /* 16 */ @@ -1116,12 +641,8 @@ static const TclIntPlatStubs tclIntPlatStubs = { static const TclPlatStubs tclPlatStubs = { TCL_STUB_MAGIC, 0, -#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ - Tcl_WinUtfToTChar, /* 0 */ - Tcl_WinTCharToUtf, /* 1 */ -#endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ - Tcl_MacOSXOpenBundleResources, /* 0 */ + 0, /* 0 */ Tcl_MacOSXOpenVersionedBundleResources, /* 1 */ #endif /* MACOSX */ }; @@ -1146,7 +667,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 */ @@ -1168,47 +689,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 */ 0, /* 71 */ 0, /* 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 */ 0, /* 77 */ TclBN_mp_to_ubin, /* 78 */ - TclBN_mp_div_ld, /* 79 */ + 0, /* 79 */ TclBN_mp_to_radix, /* 80 */ }; @@ -1259,11 +780,11 @@ 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 */ @@ -1273,7 +794,7 @@ const TclStubs tclStubs = { Tcl_GetByteArrayFromObj, /* 33 */ Tcl_GetDouble, /* 34 */ Tcl_GetDoubleFromObj, /* 35 */ - Tcl_GetIndexFromObj, /* 36 */ + 0, /* 36 */ Tcl_GetInt, /* 37 */ Tcl_GetIntFromObj, /* 38 */ Tcl_GetLongFromObj, /* 39 */ @@ -1286,25 +807,25 @@ const TclStubs tclStubs = { Tcl_ListObjIndex, /* 46 */ Tcl_ListObjLength, /* 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 */ @@ -1313,12 +834,12 @@ 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 */ - Tcl_Close, /* 81 */ + 0, /* 81 */ Tcl_CommandComplete, /* 82 */ Tcl_Concat, /* 83 */ Tcl_ConvertElement, /* 84 */ @@ -1332,7 +853,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 */ @@ -1366,9 +887,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 */ @@ -1381,10 +902,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 */ @@ -1419,11 +940,11 @@ const TclStubs tclStubs = { 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 */ @@ -1465,7 +986,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 */ @@ -1475,55 +996,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_StaticPackage, /* 244 */ - Tcl_StringMatch, /* 245 */ - Tcl_TellOld, /* 246 */ - Tcl_TraceVar, /* 247 */ + 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 */ @@ -1535,7 +1056,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 */ @@ -1559,8 +1080,8 @@ const TclStubs tclStubs = { Tcl_ConditionWait, /* 311 */ Tcl_NumUtfChars, /* 312 */ Tcl_ReadChars, /* 313 */ - Tcl_RestoreResult, /* 314 */ - Tcl_SaveResult, /* 315 */ + 0, /* 314 */ + 0, /* 315 */ Tcl_SetSystemEncoding, /* 316 */ Tcl_SetVar2Ex, /* 317 */ Tcl_ThreadAlert, /* 318 */ @@ -1586,8 +1107,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 */ @@ -1597,12 +1118,12 @@ const TclStubs tclStubs = { Tcl_UniCharIsSpace, /* 349 */ Tcl_UniCharIsUpper, /* 350 */ Tcl_UniCharIsWordChar, /* 351 */ - Tcl_UniCharLen, /* 352 */ - Tcl_UniCharNcmp, /* 353 */ + 0, /* 352 */ + 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 */ @@ -1627,9 +1148,9 @@ const TclStubs tclStubs = { Tcl_SetUnicodeObj, /* 379 */ Tcl_GetCharLength, /* 380 */ Tcl_GetUniChar, /* 381 */ - Tcl_GetUnicode, /* 382 */ + 0, /* 382 */ Tcl_GetRange, /* 383 */ - Tcl_AppendUnicodeToObj, /* 384 */ + 0, /* 384 */ Tcl_RegExpMatchObj, /* 385 */ Tcl_SetNotifier, /* 386 */ Tcl_GetAllocMutex, /* 387 */ @@ -1646,11 +1167,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 */ @@ -1664,10 +1185,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 */ @@ -1680,8 +1201,8 @@ const TclStubs tclStubs = { Tcl_AttemptSetObjLength, /* 432 */ Tcl_GetChannelThread, /* 433 */ Tcl_GetUnicodeFromObj, /* 434 */ - Tcl_GetMathFuncInfo, /* 435 */ - Tcl_ListMathFuncs, /* 436 */ + 0, /* 435 */ + 0, /* 436 */ Tcl_SubstObj, /* 437 */ Tcl_DetachChannel, /* 438 */ Tcl_IsStandardChannel, /* 439 */ @@ -1764,7 +1285,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 */ diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c index 22e8b9b..9381532 100644 --- a/generic/tclStubLib.c +++ b/generic/tclStubLib.c @@ -66,8 +66,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; + iPtr->legacyResult = "interpreter uses an incompatible stubs mechanism"; + iPtr->legacyFreeProc = 0; /* TCL_STATIC */ return NULL; } diff --git a/generic/tclTest.c b/generic/tclTest.c index a8ca463..91e3b49 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -208,7 +208,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; @@ -265,9 +265,9 @@ static Tcl_ObjCmdProc TestprintObjCmd; static Tcl_ObjCmdProc TestregexpObjCmd; static Tcl_ObjCmdProc TestreturnObjCmd; static void TestregexpXflags(const char *string, - int length, int *cflagsPtr, int *eflagsPtr); + size_t length, int *cflagsPtr, int *eflagsPtr); static Tcl_ObjCmdProc TestsaveresultCmd; -static void TestsaveresultFree(char *blockPtr); +static void TestsaveresultFree(void *blockPtr); static Tcl_CmdProc TestsetassocdataCmd; static Tcl_CmdProc TestsetCmd; static Tcl_CmdProc Testset2Cmd; @@ -745,8 +745,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; @@ -764,8 +764,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; @@ -788,8 +788,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); @@ -860,7 +860,8 @@ AsyncHandlerProc( { TestAsyncHandler *asyncPtr; int id = PTR2INT(clientData); - const char *listArgv[4], *cmd; + const char *listArgv[4]; + char *cmd; char string[TCL_INTEGER_SPACE]; Tcl_MutexLock(&asyncTestMutex); @@ -879,7 +880,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); @@ -891,7 +892,7 @@ AsyncHandlerProc( * invoked, it's possible. Better error checking is needed here. */ } - ckfree(cmd); + Tcl_Free(cmd); return code; } @@ -1526,9 +1527,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, @@ -1546,8 +1547,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; } @@ -1559,8 +1560,8 @@ DelDeleteProc( Tcl_EvalEx(dPtr->interp, dPtr->deleteCmd, -1, 0); Tcl_ResetResult(dPtr->interp); - ckfree(dPtr->deleteCmd); - ckfree(dPtr); + Tcl_Free(dPtr->deleteCmd); + Tcl_Free(dPtr); } /* @@ -1679,7 +1680,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_NewIntObj(decpt)); strObj = Tcl_NewStringObj(signum ? "-" : "+", 1); @@ -1756,11 +1757,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 { @@ -1809,9 +1810,9 @@ TestdstringCmd( */ static void SpecialFree( - char *blockPtr /* Block to free. */ + void *blockPtr /* Block to free. */ ) { - ckfree(blockPtr - 16); + Tcl_Free(((char *)blockPtr) - 16); } /* @@ -1861,15 +1862,15 @@ TestencodingObjCmd( if (objc != 5) { 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); @@ -1969,9 +1970,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); } /* @@ -2126,7 +2127,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; @@ -2977,12 +2978,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]); } } @@ -3084,12 +3085,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"); @@ -3380,7 +3381,7 @@ CleanupTestSetassocdataTests( void *clientData, /* Data to be released. */ TCL_UNUSED(Tcl_Interp *)) { - ckfree(clientData); + Tcl_Free(clientData); } /* @@ -3785,7 +3786,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; @@ -3898,12 +3900,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, -1, &start, &end); - sprintf(resinfo, "%d %d", start, end-1); + sprintf(resinfo, "%d %d", (int)start, (int)(end-1)); value = Tcl_SetVar2(interp, varName, NULL, resinfo, 0); if (value == NULL) { Tcl_AppendResult(interp, "couldn't set variable \"", @@ -3917,7 +3919,7 @@ TestregexpObjCmd( Tcl_RegExpGetInfo(regExpr, &info); varName = Tcl_GetString(objv[2]); - sprintf(resinfo, "%ld", info.extendStart); + sprintf(resinfo, "%d", (int)info.extendStart); value = Tcl_SetVar2(interp, varName, NULL, resinfo, 0); if (value == NULL) { Tcl_AppendResult(interp, "couldn't set variable \"", @@ -3938,19 +3940,19 @@ 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) ? -1 : i; + ii = ((cflags®_EXPECT) && i == objc-1) ? TCL_INDEX_NONE : (size_t)i; if (indices) { Tcl_Obj *objs[2]; - if (ii == -1) { + if (ii == TCL_INDEX_NONE) { TclRegExpRangeUniChar(regExpr, ii, &start, &end); } else if (ii > info.nsubs) { - start = -1; - end = -1; + start = TCL_INDEX_NONE; + end = TCL_INDEX_NONE; } else { start = info.matches[ii].start; end = info.matches[ii].end; @@ -3961,16 +3963,16 @@ 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_NewIntObj(start); + objs[1] = Tcl_NewIntObj(end); newPtr = Tcl_NewListObj(2, objs); } else { - if (ii == -1) { + if (ii == TCL_INDEX_NONE) { TclRegExpRangeUniChar(regExpr, ii, &start, &end); newPtr = Tcl_GetRange(objPtr, start, end); } else if (ii > info.nsubs) { @@ -4014,11 +4016,12 @@ TestregexpObjCmd( static void TestregexpXflags( const char *string, /* The string of flags. */ - int length, /* The length of the string in bytes. */ + size_t length, /* The length of the string in bytes. */ int *cflagsPtr, /* compile flags word */ int *eflagsPtr) /* exec flags word */ { - int i, cflags, eflags; + size_t i; + int cflags, eflags; cflags = *cflagsPtr; eflags = *eflagsPtr; @@ -4145,7 +4148,7 @@ TestsetassocdataCmd( return TCL_ERROR; } - buf = (char *)ckalloc(strlen(argv[2]) + 1); + buf = (char *)Tcl_Alloc(strlen(argv[2]) + 1); strcpy(buf, argv[2]); /* @@ -4155,7 +4158,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); @@ -4539,7 +4542,7 @@ TestpanicCmd( char *argString = Tcl_Merge(argc-1, argv+1); Tcl_Panic("%s", argString); - ckfree(argString); + Tcl_Free(argString); return TCL_OK; } @@ -4719,8 +4722,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); @@ -4728,10 +4731,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); @@ -4741,7 +4744,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); @@ -4767,7 +4770,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, "TclGetStringFromObj of \"12345\" 100000 times\n"); @@ -4993,7 +4996,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; } @@ -5069,7 +5072,7 @@ TestbytestringObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { - int n = 0; + size_t n = 0; const char *p; if (objc != 2) { @@ -5191,7 +5194,6 @@ TestsaveresultCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { - Interp* iPtr = (Interp*) interp; int discard, result, index; Tcl_SavedResult state; Tcl_Obj *objPtr; @@ -5228,7 +5230,7 @@ TestsaveresultCmd( Tcl_AppendResult(interp, "append result", NULL); break; case RESULT_FREE: { - char *buf = (char *)ckalloc(200); + char *buf = (char *)Tcl_Alloc(200); strcpy(buf, "free result"); Tcl_SetResult(interp, buf, TCL_DYNAMIC); @@ -5259,12 +5261,9 @@ TestsaveresultCmd( } switch ((enum options) index) { - case RESULT_DYNAMIC: { - int presentOrFreed = (iPtr->freeProc == TestsaveresultFree) ^ freeCount; - - Tcl_AppendElement(interp, presentOrFreed ? "presentOrFreed" : "missingOrLeak"); + case RESULT_DYNAMIC: + Tcl_AppendElement(interp, freeCount ? "freed" : "leak"); break; - } case RESULT_OBJECT: Tcl_AppendElement(interp, Tcl_GetObjResult(interp) == objPtr ? "same" : "different"); @@ -5293,7 +5292,7 @@ TestsaveresultCmd( static void TestsaveresultFree( - TCL_UNUSED(char *)) + TCL_UNUSED(void *)) { freeCount++; } @@ -5479,7 +5478,7 @@ TestChannelCmd( *nextPtrPtr = curPtr->nextPtr; curPtr->nextPtr = NULL; chan = curPtr->chan; - ckfree(curPtr); + Tcl_Free(curPtr); break; } } @@ -5548,7 +5547,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; @@ -5945,7 +5944,7 @@ TestChannelEventCmd( return TCL_ERROR; } - esPtr = (EventScriptRecord *)ckalloc(sizeof(EventScriptRecord)); + esPtr = (EventScriptRecord *)Tcl_Alloc(sizeof(EventScriptRecord)); esPtr->nextPtr = statePtr->scriptRecordPtr; statePtr->scriptRecordPtr = esPtr; @@ -6002,7 +6001,7 @@ TestChannelEventCmd( Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr, TclChannelEventScriptInvoker, esPtr); Tcl_DecrRefCount(esPtr->scriptPtr); - ckfree(esPtr); + Tcl_Free(esPtr); return TCL_OK; } @@ -6043,7 +6042,7 @@ TestChannelEventCmd( Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr, TclChannelEventScriptInvoker, esPtr); Tcl_DecrRefCount(esPtr->scriptPtr); - ckfree(esPtr); + Tcl_Free(esPtr); } statePtr->scriptRecordPtr = NULL; return TCL_OK; @@ -6877,7 +6876,7 @@ TestUtfNextCmd( int objc, Tcl_Obj *const objv[]) { - int numBytes; + size_t numBytes; char *bytes; const char *result, *first; char buffer[32]; @@ -6888,7 +6887,8 @@ TestUtfNextCmd( Tcl_WrongNumArgs(interp, 1, objv, "?-bytestring? bytes"); return TCL_ERROR; } - bytes = Tcl_GetStringFromObj(objv[1], &numBytes); + bytes = Tcl_GetString(objv[1]); + numBytes = objv[1]->length; if (numBytes > (int)sizeof(buffer) - 4) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( @@ -6936,7 +6936,7 @@ TestUtfPrevCmd( int objc, Tcl_Obj *const objv[]) { - int numBytes, offset; + size_t numBytes, offset; char *bytes; const char *result; @@ -6945,13 +6945,14 @@ TestUtfPrevCmd( return TCL_ERROR; } - bytes = Tcl_GetStringFromObj(objv[1], &numBytes); + bytes = Tcl_GetString(objv[1]); + numBytes = objv[1]->length; if (objc == 3) { 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) { @@ -6961,7 +6962,7 @@ TestUtfPrevCmd( offset = numBytes; } result = TclUtfPrev(bytes + offset, bytes); - Tcl_SetObjResult(interp, Tcl_NewIntObj(result - bytes)); + Tcl_SetObjResult(interp, Tcl_NewWideIntObj(result - bytes)); return TCL_OK; } @@ -6977,8 +6978,9 @@ TestNumUtfCharsCmd( Tcl_Obj *const objv[]) { if (objc > 1) { - int numBytes, len, limit = -1; - const char *bytes = Tcl_GetStringFromObj(objv[1], &numBytes); + size_t len, limit = TCL_INDEX_NONE; + const char *bytes = Tcl_GetString(objv[1]); + size_t numBytes = objv[1]->length; if (objc > 2) { if (Tcl_GetIntForIndex(interp, objv[2], numBytes, &limit) != TCL_OK) { @@ -6989,7 +6991,7 @@ TestNumUtfCharsCmd( } } len = Tcl_NumUtfChars(bytes, limit); - Tcl_SetObjResult(interp, Tcl_NewIntObj(len)); + Tcl_SetObjResult(interp, Tcl_NewWideIntObj(len)); } return TCL_OK; } @@ -7136,7 +7138,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; @@ -7212,7 +7214,7 @@ TestlongsizeCmd( Tcl_AppendResult(interp, "wrong # args", NULL); return TCL_ERROR; } - Tcl_SetObjResult(interp, Tcl_NewIntObj((int)sizeof(long))); + Tcl_SetObjResult(interp, Tcl_NewIntObj(sizeof(long))); return TCL_OK; } @@ -7235,9 +7237,9 @@ NREUnwind_callback( &none, NULL); } else { Tcl_Obj *idata[3]; - idata[0] = Tcl_NewIntObj((int) ((char *) data[1] - (char *) data[0])); - idata[1] = Tcl_NewIntObj((int) ((char *) data[2] - (char *) data[0])); - idata[2] = Tcl_NewIntObj((int) ((char *) &none - (char *) data[0])); + idata[0] = Tcl_NewIntObj(((char *) data[1] - (char *) data[0])); + idata[1] = Tcl_NewIntObj(((char *) data[2] - (char *) data[0])); + idata[2] = Tcl_NewIntObj(((char *) &none - (char *) data[0])); Tcl_SetObjResult(interp, Tcl_NewListObj(3, idata)); } return TCL_OK; @@ -7697,7 +7699,7 @@ TestparseargsCmd( result[1] = Tcl_NewIntObj(count); result[2] = Tcl_NewListObj(count, remObjv); Tcl_SetObjResult(interp, Tcl_NewListObj(3, result)); - ckfree(remObjv); + Tcl_Free(remObjv); return TCL_OK; } @@ -7824,7 +7826,7 @@ HashVarFree( Tcl_Var var) { if (VarHashRefCount(var) < 2) { - ckfree(var); + Tcl_Free(var); } else { VarHashRefCount(var)--; } @@ -7840,7 +7842,7 @@ MyCompiledVarFree( if (resVarInfo->var) { HashVarFree(resVarInfo->var); } - ckfree(vInfoPtr); + Tcl_Free(vInfoPtr); } #define TclVarHashGetValue(hPtr) \ @@ -7883,7 +7885,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(); */ @@ -7900,7 +7902,7 @@ InterpCompiledVarResolver( 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 bd5d92e..39b81f8 100644 --- a/generic/tclTestObj.c +++ b/generic/tclTestObj.c @@ -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: @@ -62,7 +54,7 @@ static void VarPtrDeleteProc(void *clientData, Tcl_Interp *interp) if (varPtr[i]) Tcl_DecrRefCount(varPtr[i]); } Tcl_DeleteAssocData(interp, VARPTR_KEY); - ckfree(varPtr); + Tcl_Free(varPtr); } static Tcl_Obj **GetVarPtr(Tcl_Interp *interp) @@ -102,7 +94,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; } @@ -580,8 +572,8 @@ TestindexobjCmd( */ struct IndexRep { 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. */ }; struct IndexRep *indexRep; @@ -620,7 +612,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]); } @@ -629,7 +621,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_SetIntObj(Tcl_GetObjResult(interp), index); } @@ -1277,8 +1269,8 @@ TeststringobjCmd( if (objc != 3) { goto wrongNumArgs; } - Tcl_SetIntObj(Tcl_GetObjResult(interp), (varPtr[varIndex] != NULL) - ? varPtr[varIndex]->length : -1); + Tcl_SetWideIntObj(Tcl_GetObjResult(interp), (varPtr[varIndex] != NULL) + ? (Tcl_WideInt)varPtr[varIndex]->length : (Tcl_WideInt)-1); break; case 5: /* length2 */ if (objc != 3) { @@ -1407,7 +1399,7 @@ TeststringobjCmd( return TCL_ERROR; } - Tcl_AppendUnicodeToObj(varPtr[varIndex], unicode + i, length - i); + TclAppendUnicodeToObj(varPtr[varIndex], unicode + i, length - i); Tcl_SetObjResult(interp, varPtr[varIndex]); break; } diff --git a/generic/tclTestProcBodyObj.c b/generic/tclTestProcBodyObj.c index db6ec8a..1a577d9 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 */ @@ -190,7 +190,7 @@ ProcBodyTestInitInternal( } } - return Tcl_PkgProvide(interp, packageName, packageVersion); + return Tcl_PkgProvideEx(interp, packageName, packageVersion, NULL); } /* @@ -339,7 +339,7 @@ ProcBodyTestCheckObjCmd( return TCL_ERROR; } - version = Tcl_PkgPresent(interp, packageName, packageVersion, 1); + version = Tcl_PkgPresentEx(interp, packageName, packageVersion, 1, NULL); Tcl_SetObjResult(interp, Tcl_NewWideIntObj( strcmp(version, packageVersion) == 0)); return TCL_OK; diff --git a/generic/tclThread.c b/generic/tclThread.c index 76aaf4b..c5ed9e3 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 = 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 eb8a35d..1ff5997 100644 --- a/generic/tclThreadAlloc.c +++ b/generic/tclThreadAlloc.c @@ -82,18 +82,18 @@ typedef union Block { * and statistics information. */ -typedef struct Bucket { +typedef struct { Block *firstPtr; /* First block available */ Block *lastPtr; /* End of block list */ - long numFree; /* Number of blocks available */ + size_t numFree; /* Number of blocks available */ /* All fields below for accounting only */ - long numRemoves; /* Number of removes from bucket */ - long numInserts; /* Number of inserts into bucket */ - long numWaits; /* Number of waits to acquire a lock */ - long numLocks; /* Number of locks acquired */ - long totalAssigned; /* Total space assigned to bucket */ + size_t numRemoves; /* Number of removes from bucket */ + size_t numInserts; /* Number of inserts into bucket */ + size_t numWaits; /* Number of waits to acquire a lock */ + size_t numLocks; /* Number of locks acquired */ + size_t totalAssigned; /* Total space assigned to bucket */ } Bucket; /* @@ -120,8 +120,8 @@ typedef struct Cache { static struct { size_t blockSize; /* Bucket blocksize. */ - int maxBlocks; /* Max blocks before move to share. */ - int numMove; /* Num blocks to move to share. */ + size_t maxBlocks; /* Max blocks before move to share. */ + size_t numMove; /* Num blocks to move to share. */ Tcl_Mutex *lockPtr; /* Share bucket lock. */ } bucketInfo[NBUCKETS]; @@ -211,7 +211,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"); } @@ -301,26 +301,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); /* @@ -337,7 +324,7 @@ TclpAlloc( #endif if (size > MAXALLOC) { bucket = NBUCKETS; - blockPtr = (Block *)TclpSysAlloc(size, 0); + blockPtr = (Block *)TclpSysAlloc(size); if (blockPtr != NULL) { cachePtr->totalAssigned += reqSize; } @@ -438,7 +425,7 @@ TclpFree( void * TclpRealloc( void *ptr, - unsigned int reqSize) + size_t reqSize) { Cache *cachePtr; Block *blockPtr; @@ -450,19 +437,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); /* @@ -563,7 +537,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 %d new objects", numMove); } @@ -671,8 +645,8 @@ Tcl_GetMemoryInfo( Tcl_DStringAppendElement(dsPtr, buf); } for (n = 0; n < NBUCKETS; ++n) { - sprintf(buf, "%lu %ld %ld %ld %ld %ld %ld", - (unsigned long) bucketInfo[n].blockSize, + sprintf(buf, "%" TCL_Z_MODIFIER "u %" TCL_Z_MODIFIER "u %" TCL_Z_MODIFIER "u %" TCL_Z_MODIFIER "u %" TCL_Z_MODIFIER "u %" TCL_Z_MODIFIER "u %" TCL_Z_MODIFIER "u", + bucketInfo[n].blockSize, cachePtr->buckets[n].numFree, cachePtr->buckets[n].numRemoves, cachePtr->buckets[n].numInserts, @@ -961,7 +935,7 @@ GetBlocks( int bucket) { Block *blockPtr; - int n; + size_t n; /* * First, atttempt to move blocks from the shared cache. Note the @@ -1016,7 +990,7 @@ GetBlocks( blockPtr = NULL; n = NBUCKETS; size = 0; - while (--n > bucket) { + while (--n > (size_t)bucket) { if (cachePtr->buckets[n].numFree > 0) { size = bucketInfo[n].blockSize; blockPtr = cachePtr->buckets[n].firstPtr; @@ -1032,7 +1006,7 @@ GetBlocks( if (blockPtr == NULL) { size = MAXALLOC; - blockPtr = (Block*)TclpSysAlloc(size, 0); + blockPtr = (Block*)TclpSysAlloc(size); if (blockPtr == NULL) { return 0; } @@ -1082,7 +1056,7 @@ TclInitThreadAlloc(void) objLockPtr = TclpNewAllocMutex(); for (i = 0; i < NBUCKETS; ++i) { bucketInfo[i].blockSize = MINALLOC << i; - bucketInfo[i].maxBlocks = 1 << (NBUCKETS - 1 - i); + bucketInfo[i].maxBlocks = ((size_t)1) << (NBUCKETS - 1 - i); bucketInfo[i].numMove = i < NBUCKETS - 1 ? 1 << (NBUCKETS - 2 - i) : 1; bucketInfo[i].lockPtr = TclpNewAllocMutex(); diff --git a/generic/tclThreadJoin.c b/generic/tclThreadJoin.c index 0aff0a7..483a6c0 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 74c23af..2622352 100644 --- a/generic/tclThreadStorage.c +++ b/generic/tclThreadStorage.c @@ -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]); } } diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c index 0bb55e1..f566eb2 100644 --- a/generic/tclThreadTest.c +++ b/generic/tclThreadTest.c @@ -431,10 +431,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; @@ -593,7 +593,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); @@ -668,7 +668,7 @@ ThreadErrorProc( argv[2] = errorInfo; script = Tcl_Merge(3, argv); ThreadSend(interp, errorThreadId, script, 0); - ckfree(script); + Tcl_Free(script); } } @@ -838,13 +838,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; /* @@ -916,19 +916,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; } @@ -1036,18 +1036,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); @@ -1081,7 +1081,7 @@ ThreadFreeProc( void *clientData) { if (clientData) { - ckfree(clientData); + Tcl_Free(clientData); } } @@ -1108,7 +1108,7 @@ ThreadDeleteEvent( TCL_UNUSED(void *)) { if (eventPtr->proc == ThreadEventProc) { - ckfree(((ThreadEvent *) eventPtr)->script); + Tcl_Free(((ThreadEvent *) eventPtr)->script); return 1; } @@ -1154,14 +1154,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); @@ -1184,7 +1184,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 @@ -1194,7 +1194,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 6b94cbb..84332a0 100644 --- a/generic/tclTimer.c +++ b/generic/tclTimer.c @@ -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; } } @@ -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; @@ -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"); @@ -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 9d6eb1c..a47f7ef 100644 --- a/generic/tclTomMath.decls +++ b/generic/tclTomMath.decls @@ -33,7 +33,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) @@ -51,7 +51,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) @@ -66,7 +66,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) @@ -74,14 +74,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 {deprecated {is private function in libtommath}} { +# 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) @@ -96,7 +97,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) @@ -114,7 +115,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) @@ -140,12 +141,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 {deprecated {macro calling mp_set_u64}} { +# 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) } @@ -153,20 +156,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) @@ -174,55 +180,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 {deprecated {macro calling mp_init_u64}} { +# mp_err TclBN_mp_init_ul(mp_int *a, unsigned long i) +#} +# Removed in 9.0 +#declare 62 {deprecated {macro calling mp_set_u64}} { +# 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 {deprecated {macro calling mp_init_i64}} { +# 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) } @@ -230,10 +202,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) @@ -246,15 +218,18 @@ declare 70 { } # 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) } @@ -263,9 +238,10 @@ declare 76 { 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 1427e8b..7a4fb9a 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 @@ -59,16 +59,8 @@ #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_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); #ifdef __cplusplus } #endif @@ -78,40 +70,40 @@ MODULE_SCOPE mp_err TclBN_s_mp_sub_d(const mp_int *a, mp_digit b, mp_int *c); #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 @@ -129,7 +121,7 @@ MODULE_SCOPE mp_err TclBN_s_mp_sub_d(const mp_int *a, mp_digit b, mp_int *c); #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 @@ -157,12 +149,6 @@ MODULE_SCOPE mp_err TclBN_s_mp_sub_d(const mp_int *a, mp_digit b, mp_int *c); #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") TclBN_mp_init_u64(a,(unsigned int)(b))) -#define mp_set_int(a,b) (MP_DEPRECATED_PRAGMA("replaced by mp_set_ul") (TclBN_mp_set_u64((a),((unsigned int)(b))),MP_OKAY)) -#define mp_set_long(a,b) (MP_DEPRECATED_PRAGMA("replaced by mp_set_ul") (TclBN_mp_set_u64((a),(long)(b)),MP_OKAY)) -#define mp_set_long_long(a,b) (MP_DEPRECATED_PRAGMA("replaced by mp_set_u64") (TclBN_mp_set_u64((a),(b)),MP_OKAY)) -#define mp_unsigned_bin_size(mp) (MP_DEPRECATED_PRAGMA("replaced by mp_ubin_size") (int)TclBN_mp_ubin_size(mp)) - #undef TCL_STORAGE_CLASS #ifdef BUILD_tcl # define TCL_STORAGE_CLASS DLLEXPORT @@ -198,7 +184,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, @@ -212,7 +198,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 */ @@ -223,21 +209,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; @@ -248,7 +231,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 */ @@ -262,7 +245,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; @@ -283,96 +266,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 */ @@ -381,18 +315,9 @@ EXTERN uint64_t TclBN_mp_get_mag_u64(const mp_int *a) MP_WUR; EXTERN void TclBN_mp_set_i64(mp_int *a, int64_t i); /* Slot 71 is reserved */ /* Slot 72 is reserved */ -/* 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; @@ -400,9 +325,7 @@ EXTERN mp_err TclBN_mp_signed_rsh(const mp_int *a, int b, /* 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; @@ -414,34 +337,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 */ @@ -450,47 +373,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 */ void (*reserved71)(void); void (*reserved72)(void); - 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 */ void (*reserved77)(void); 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; @@ -540,8 +463,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 \ @@ -584,64 +506,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 \ @@ -650,19 +552,15 @@ extern const TclTomMathStubs *tclTomMathStubsPtr; (tclTomMathStubsPtr->tclBN_mp_set_i64) /* 70 */ /* Slot 71 is reserved */ /* Slot 72 is reserved */ -#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 */ /* Slot 77 is reserved */ #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 */ @@ -670,55 +568,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 d189581..10935c9 100644 --- a/generic/tclTrace.c +++ b/generic/tclTrace.c @@ -120,7 +120,7 @@ static Tcl_TraceTypeObjCmd *const traceSubCmds[] = { */ static int CallTraceFunction(Tcl_Interp *interp, Trace *tracePtr, - Command *cmdPtr, const char *command, int numChars, + Command *cmdPtr, const char *command, size_t numChars, int objc, Tcl_Obj *const objv[]); static char * TraceVarProc(ClientData clientData, Tcl_Interp *interp, const char *name1, const char *name2, int flags); @@ -269,7 +269,8 @@ Tcl_TraceObjCmd( case TRACE_OLD_VDELETE: { Tcl_Obj *copyObjv[6]; Tcl_Obj *opsList; - int code, numFlags; + int code; + size_t numFlags; if (objc != 5) { Tcl_WrongNumArgs(interp, 2, objv, "name ops command"); @@ -321,7 +322,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; @@ -401,9 +402,9 @@ TraceExecutionObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int commandLength, index; + int index; const char *name, *command; - size_t length; + size_t commandLength, length; enum traceOptions { TRACE_ADD, TRACE_INFO, TRACE_REMOVE }; @@ -465,9 +466,9 @@ TraceExecutionObjCmd( } } command = TclGetStringFromObj(objv[5], &commandLength); - length = (size_t) commandLength; + length = commandLength; if ((enum traceOptions) optionIndex == TRACE_ADD) { - TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)ckalloc( + TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)Tcl_Alloc( offsetof(TraceCommandInfo, command) + 1 + length); tcmdPtr->flags = flags; @@ -482,10 +483,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 { @@ -501,7 +502,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; } @@ -519,7 +520,7 @@ TraceExecutionObjCmd( && ((tcmdPtr->flags & (TCL_TRACE_ANY_EXEC | TCL_TRACE_RENAME | TCL_TRACE_DELETE)) == flags) && (strncmp(command, tcmdPtr->command, - (size_t) length) == 0)) { + length) == 0)) { flags |= TCL_TRACE_DELETE; if (flags & (TCL_TRACE_ENTER_DURING_EXEC | TCL_TRACE_LEAVE_DURING_EXEC)) { @@ -535,7 +536,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) { /* @@ -545,7 +546,7 @@ TraceExecutionObjCmd( tcmdPtr->flags = 0; } if (tcmdPtr->refCount-- <= 1) { - ckfree(tcmdPtr); + Tcl_Free(tcmdPtr); } break; } @@ -562,7 +563,7 @@ TraceExecutionObjCmd( return TCL_ERROR; } - name = Tcl_GetString(objv[3]); + name = TclGetString(objv[3]); /* * First ensure the name given is valid. @@ -649,9 +650,9 @@ TraceCommandObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int commandLength, index; + int index; const char *name, *command; - size_t length; + size_t commandLength, length; enum traceOptions { TRACE_ADD, TRACE_INFO, TRACE_REMOVE }; static const char *const opStrings[] = { "delete", "rename", NULL }; enum operations { TRACE_CMD_DELETE, TRACE_CMD_RENAME }; @@ -702,9 +703,9 @@ TraceCommandObjCmd( } command = TclGetStringFromObj(objv[5], &commandLength); - length = (size_t) commandLength; + length = commandLength; if ((enum traceOptions) optionIndex == TRACE_ADD) { - TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)ckalloc( + TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)Tcl_Alloc( offsetof(TraceCommandInfo, command) + 1 + length); tcmdPtr->flags = flags; @@ -715,10 +716,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 { @@ -734,7 +735,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; } @@ -744,12 +745,12 @@ TraceCommandObjCmd( if ((tcmdPtr->length == length) && (tcmdPtr->flags == flags) && (strncmp(command, tcmdPtr->command, - (size_t) length) == 0)) { + length) == 0)) { Tcl_UntraceCommand(interp, name, flags | TCL_TRACE_DELETE, TraceCommandProc, clientData); tcmdPtr->flags |= TCL_TRACE_DESTROYED; if (tcmdPtr->refCount-- <= 1) { - ckfree(tcmdPtr); + Tcl_Free(tcmdPtr); } break; } @@ -770,7 +771,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; } @@ -843,9 +844,9 @@ TraceVariableObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int commandLength, index; + int index; const char *name, *command; - size_t length; + size_t commandLength, length; ClientData clientData; enum traceOptions { TRACE_ADD, TRACE_INFO, TRACE_REMOVE }; static const char *const opStrings[] = { @@ -905,9 +906,9 @@ TraceVariableObjCmd( } } command = TclGetStringFromObj(objv[5], &commandLength); - length = (size_t) commandLength; + length = commandLength; if ((enum traceOptions) optionIndex == TRACE_ADD) { - CombinedTraceVarInfo *ctvarPtr = (CombinedTraceVarInfo *)ckalloc( + CombinedTraceVarInfo *ctvarPtr = (CombinedTraceVarInfo *)Tcl_Alloc( offsetof(CombinedTraceVarInfo, traceCmdInfo.command) + 1 + length); @@ -923,10 +924,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 +937,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; @@ -947,7 +948,7 @@ TraceVariableObjCmd( #endif )==flags) && (strncmp(command, tvarPtr->command, - (size_t) length) == 0)) { + length) == 0)) { Tcl_UntraceVar2(interp, name, NULL, flags | TCL_TRACE_UNSETS | TCL_TRACE_RESULT_OBJECT, TraceVarProc, clientData); @@ -966,7 +967,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; @@ -1123,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 & @@ -1229,7 +1230,7 @@ Tcl_UntraceCommand( tracePtr->flags = 0; if (tracePtr->refCount-- <= 1) { - ckfree(tracePtr); + Tcl_Free(tracePtr); } if (hasExecTraces) { @@ -1300,7 +1301,7 @@ TraceCommandProc( */ Tcl_DStringInit(&cmd); - Tcl_DStringAppend(&cmd, tcmdPtr->command, (int) tcmdPtr->length); + Tcl_DStringAppend(&cmd, tcmdPtr->command, tcmdPtr->length); Tcl_DStringAppendElement(&cmd, oldName); Tcl_DStringAppendElement(&cmd, (newName ? newName : "")); if (flags & TCL_TRACE_RENAME) { @@ -1342,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) { /* @@ -1384,7 +1385,7 @@ TraceCommandProc( tcmdPtr->refCount--; } if (tcmdPtr->refCount-- <= 1) { - ckfree(tcmdPtr); + Tcl_Free(tcmdPtr); } } @@ -1418,7 +1419,7 @@ TclCheckExecutionTraces( Tcl_Interp *interp, /* The current interpreter. */ const char *command, /* Pointer to beginning of the current command * string. */ - TCL_UNUSED(int) /*numChars*/, + TCL_UNUSED(size_t) /*numChars*/, Command *cmdPtr, /* Points to command's Command struct. */ int code, /* The current result code. */ int traceFlags, /* Current tracing situation. */ @@ -1475,7 +1476,7 @@ TclCheckExecutionTraces( traceCode = TraceExecutionProc(tcmdPtr, interp, curLevel, command, (Tcl_Command) cmdPtr, objc, objv); if (tcmdPtr->refCount-- <= 1) { - ckfree(tcmdPtr); + Tcl_Free(tcmdPtr); } } } @@ -1523,7 +1524,7 @@ TclCheckInterpTraces( Tcl_Interp *interp, /* The current interpreter. */ const char *command, /* Pointer to beginning of the current command * string. */ - int numChars, /* The number of characters in 'command' which + size_t numChars, /* The number of characters in 'command' which * are part of the command string. */ Command *cmdPtr, /* Points to command's Command struct. */ int code, /* The current result code. */ @@ -1670,7 +1671,7 @@ CallTraceFunction( Command *cmdPtr, /* Points to command's Command struct. */ const char *command, /* Points to the first character of the * command's source before substitutions. */ - int numChars, /* The number of characters in the command's + size_t numChars, /* The number of characters in the command's * source. */ int objc, /* Number of arguments for the command. */ Tcl_Obj *const objv[]) /* Pointers to Tcl_Obj of each argument. */ @@ -1722,7 +1723,7 @@ CommandObjTraceDeleted( TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)clientData; if (tcmdPtr->refCount-- <= 1) { - ckfree(tcmdPtr); + Tcl_Free(tcmdPtr); } } @@ -1804,7 +1805,7 @@ TraceExecutionProc( && (strcmp(command, tcmdPtr->startCmd) == 0)) { Tcl_DeleteTrace(interp, tcmdPtr->stepTrace); tcmdPtr->stepTrace = NULL; - ckfree(tcmdPtr->startCmd); + Tcl_Free(tcmdPtr->startCmd); } /* @@ -1816,7 +1817,7 @@ TraceExecutionProc( int i, saveInterpFlags; Tcl_DStringInit(&cmd); - Tcl_DStringAppend(&cmd, tcmdPtr->command, (int)tcmdPtr->length); + Tcl_DStringAppend(&cmd, tcmdPtr->command, tcmdPtr->length); /* * Append command with arguments. @@ -1824,7 +1825,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); @@ -1848,7 +1849,7 @@ TraceExecutionProc( */ TclNewIntObj(resultCode, code); - resultCodeStr = Tcl_GetString(resultCode); + resultCodeStr = TclGetString(resultCode); Tcl_DStringAppendElement(&cmd, resultCodeStr); Tcl_DecrRefCount(resultCode); @@ -1917,7 +1918,7 @@ 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, @@ -1929,12 +1930,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; @@ -1984,14 +1985,14 @@ TraceVarProc( result = NULL; if ((tvarPtr->flags & flags) && !Tcl_InterpDeleted(interp) && !Tcl_LimitExceeded(interp)) { - if (tvarPtr->length != (size_t) 0) { + if (tvarPtr->length) { /* * Generate a command to execute by appending list elements for * the two variable names and the operation. */ Tcl_DStringInit(&cmd); - Tcl_DStringAppend(&cmd, tvarPtr->command, (int) tvarPtr->length); + Tcl_DStringAppend(&cmd, tvarPtr->command, tvarPtr->length); Tcl_DStringAppendElement(&cmd, name1); Tcl_DStringAppendElement(&cmd, (name2 ? name2 : "")); #ifndef TCL_REMOVE_OBSOLETE_TRACES @@ -2160,7 +2161,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; @@ -2223,7 +2224,7 @@ Tcl_CreateTrace( * command. */ ClientData 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; @@ -2270,7 +2271,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; @@ -2307,7 +2308,7 @@ static void StringTraceDeleteProc( ClientData clientData) { - ckfree(clientData); + Tcl_Free(clientData); } /* @@ -2558,9 +2559,6 @@ TclObjCallVarTraces( leaveErrMsg); } -#undef TCL_INTERP_DESTROYED -#define TCL_INTERP_DESTROYED 0x100 - int TclCallVarTraces( Interp *iPtr, /* Interpreter containing variable. */ @@ -2640,13 +2638,6 @@ TclCallVarTraces( } /* - * Ignore any caller-provided TCL_INTERP_DESTROYED flag. Only we can - * set it correctly. - */ - - flags &= ~TCL_INTERP_DESTROYED; - - /* * Invoke traces on the array containing the variable, if relevant. */ @@ -2668,9 +2659,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) { @@ -2712,9 +2700,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) { @@ -2776,7 +2761,7 @@ TclCallVarTraces( (part2 ? ")" : "") )); if (disposeFlags & TCL_TRACE_RESULT_OBJECT) { TclVarErrMsg((Tcl_Interp *) iPtr, part1, part2, verb, - Tcl_GetString((Tcl_Obj *) result)); + TclGetString((Tcl_Obj *) result)); } else { TclVarErrMsg((Tcl_Interp *) iPtr, part1, part2, verb, result); } @@ -2835,7 +2820,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); } @@ -2844,41 +2829,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. @@ -3009,49 +2959,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 @@ -3122,47 +3029,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 @@ -3200,7 +3066,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; @@ -3208,7 +3074,7 @@ Tcl_TraceVar2( result = TraceVarEx(interp, part1, part2, tracePtr); if (result != TCL_OK) { - ckfree(tracePtr); + Tcl_Free(tracePtr); } return result; } @@ -3244,7 +3110,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 11bde5c..ae87e1b 100644 --- a/generic/tclUtf.c +++ b/generic/tclUtf.c @@ -119,7 +119,7 @@ static int Invalid(const char *src); *--------------------------------------------------------------------------- */ -int +size_t TclUtfCount( int ch) /* The Unicode character whose size is returned. */ { @@ -314,13 +314,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. @@ -329,7 +329,7 @@ Tcl_UniCharToUtfDString( if (uniStr == NULL) { return NULL; } - if (uniLength < 0) { + if (uniLength == TCL_INDEX_NONE) { uniLength = 0; w = uniStr; while (*w != '\0') { @@ -355,13 +355,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. @@ -370,7 +371,7 @@ Tcl_Char16ToUtfDString( if (uniStr == NULL) { return NULL; } - if (uniLength < 0) { + if (uniLength == TCL_INDEX_NONE) { uniLength = 0; w = uniStr; @@ -421,7 +422,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 <= 3, 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 @@ -654,7 +655,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 @@ -662,7 +663,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 */ @@ -671,7 +672,7 @@ Tcl_UtfToUniCharDString( if (src == NULL) { return NULL; } - if (length < 0) { + if (length == TCL_INDEX_NONE) { length = strlen(src); } @@ -711,7 +712,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 @@ -719,7 +720,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 */ @@ -728,12 +729,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. */ @@ -789,7 +790,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)]; } @@ -812,18 +813,18 @@ Tcl_UtfCharComplete( *--------------------------------------------------------------------------- */ -int +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++; } @@ -966,7 +967,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) { @@ -1140,15 +1141,15 @@ 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. */ { Tcl_UniChar ch = 0; int i = 0; - if (index < 0) { + if (index == TCL_INDEX_NONE) { return -1; } - while (index-- > 0) { + while (index--) { i = TclUtfToUniChar(src, &ch); src += i; } @@ -1184,21 +1185,28 @@ Tcl_UniCharAtIndex( const char * 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; +#if TCL_UTF_MAX <= 3 + size_t len = 0; +#endif - while (index-- > 0) { - len = TclUtfToUniChar(src, &ch); - src += len; - } + if (index != TCL_INDEX_NONE) { + while (index--) { +#if TCL_UTF_MAX <= 3 + src += (len = TclUtfToUniChar(src, &ch)); +#else + src += TclUtfToUniChar(src, &ch); +#endif + } #if TCL_UTF_MAX <= 3 if ((ch >= 0xD800) && (len < 3)) { /* Index points at character following high Surrogate */ src += TclUtfToUniChar(src, &ch); } #endif + } return src; } @@ -1228,7 +1236,7 @@ Tcl_UtfAtIndex( *--------------------------------------------------------------------------- */ -int +size_t Tcl_UtfBackslash( const char *src, /* Points to the backslash character of a * backslash sequence. */ @@ -1238,8 +1246,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) { @@ -1279,7 +1286,7 @@ Tcl_UtfToUpper( { int ch, upChar; char *src, *dst; - int len; + size_t len; /* * Iterate over the string until we hit the terminating null. @@ -1332,7 +1339,7 @@ Tcl_UtfToLower( { int ch, lowChar; char *src, *dst; - int len; + size_t len; /* * Iterate over the string until we hit the terminating null. @@ -1386,7 +1393,7 @@ Tcl_UtfToTitle( { int ch, titleChar, lowChar; char *src, *dst; - int len; + size_t len; /* * Capitalize the first character and then lowercase the rest of the @@ -1448,7 +1455,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 @@ -1495,7 +1502,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; @@ -1553,7 +1560,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; @@ -1788,7 +1795,7 @@ Tcl_UniCharToTitle( /* *---------------------------------------------------------------------- * - * Tcl_UniCharLen -- + * TclUniCharLen -- * * Find the length of a UniChar string. The str input must be null * terminated. @@ -1802,11 +1809,11 @@ Tcl_UniCharToTitle( *---------------------------------------------------------------------- */ -int -Tcl_UniCharLen( +size_t +TclUniCharLen( const Tcl_UniChar *uniStr) /* Unicode string to find length of. */ { - int len = 0; + size_t len = 0; while (*uniStr != '\0') { len++; @@ -1818,7 +1825,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. @@ -1833,10 +1840,10 @@ Tcl_UniCharLen( */ int -Tcl_UniCharNcmp( +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. */ + size_t numChars) /* Number of unichars to compare. */ { #ifdef WORDS_BIGENDIAN /* @@ -1862,7 +1869,7 @@ Tcl_UniCharNcmp( /* *---------------------------------------------------------------------- * - * 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 @@ -1878,10 +1885,10 @@ Tcl_UniCharNcmp( */ int -Tcl_UniCharNcasecmp( +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. */ + size_t numChars) /* Number of unichars to compare. */ { for ( ; numChars != 0; numChars--, ucs++, uct++) { if (*ucs != *uct) { @@ -2207,7 +2214,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* @@ -2228,7 +2235,7 @@ Tcl_UniCharIsWordChar( */ int -Tcl_UniCharCaseMatch( +TclUniCharCaseMatch( const Tcl_UniChar *uniStr, /* Unicode String. */ const Tcl_UniChar *uniPattern, /* Pattern, which may contain special @@ -2295,7 +2302,7 @@ Tcl_UniCharCaseMatch( } } } - if (Tcl_UniCharCaseMatch(uniStr, uniPattern, nocase)) { + if (TclUniCharCaseMatch(uniStr, uniPattern, nocase)) { return 1; } if (*uniStr == 0) { @@ -2401,7 +2408,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: @@ -2418,10 +2425,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; diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 170a85e..ac1cd35 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. */ @@ -116,7 +109,7 @@ static int GetWideForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr, static int FindElement(Tcl_Interp *interp, const char *string, int 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 @@ -394,12 +387,12 @@ 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 == -1) && (*bytes == '\0'))) { + if ((numBytes == 0) || ((numBytes == TCL_INDEX_NONE) && (*bytes == '\0'))) { /* Empty string case - quick exit */ goto done; } @@ -415,7 +408,7 @@ TclMaxListLength( */ while (numBytes) { - if ((numBytes == -1) && (*bytes == '\0')) { + if ((numBytes == TCL_INDEX_NONE) && (*bytes == '\0')) { break; } if (TclIsSpaceProcM(*bytes)) { @@ -426,9 +419,9 @@ TclMaxListLength( count++; do { bytes++; - numBytes -= (numBytes != -1); + numBytes -= (numBytes != TCL_INDEX_NONE); } while (numBytes && TclIsSpaceProcM(*bytes)); - if ((numBytes == 0) || ((numBytes == -1) && (*bytes == '\0'))) { + if ((numBytes == 0) || ((numBytes == TCL_INDEX_NONE) && (*bytes == '\0'))) { break; } @@ -437,7 +430,7 @@ TclMaxListLength( */ } bytes++; - numBytes -= (numBytes != -1); + numBytes -= (numBytes != TCL_INDEX_NONE); } /* @@ -506,7 +499,7 @@ TclFindElement( 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 @@ -535,7 +528,7 @@ TclFindDictElement( 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 @@ -567,7 +560,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 @@ -582,7 +575,7 @@ FindElement( int openBraces = 0; /* Brace nesting level during parse. */ int inQuotes = 0; int size = 0; - int numChars; + size_t numChars; int literal = 1; const char *p2; @@ -790,20 +783,20 @@ 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 == '\\') { - int numRead; - int backslashCount = TclParseBackslash(src, count, &numRead, dst); + size_t numRead; + size_t backslashCount = TclParseBackslash(src, count, &numRead, dst); dst += backslashCount; newCount += backslashCount; @@ -861,7 +854,8 @@ Tcl_SplitList( { const char **argv, *end, *element; char *p; - int length, size, i, result, elSize; + int length, size, i, result; + size_t elSize; /* * Allocate enough space to work in. A (const char *) for each (possible) @@ -873,7 +867,7 @@ Tcl_SplitList( size = TclMaxListLength(list, -1, &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++) { @@ -884,14 +878,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", -1)); @@ -938,11 +932,11 @@ Tcl_SplitList( *---------------------------------------------------------------------- */ -int +size_t Tcl_ScanElement( const char *src, /* String to convert to list element. */ int *flagPtr) /* Where to store information to guide - * Tcl_ConvertCountedElement. */ + * Tcl_ConvertCountedElement. */ { return Tcl_ScanCountedElement(src, -1, flagPtr); } @@ -970,10 +964,10 @@ 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 -1. */ + size_t length, /* Number of bytes in src, or -1. */ int *flagPtr) /* Where to store information to guide * Tcl_ConvertElement. */ { @@ -1014,10 +1008,10 @@ Tcl_ScanCountedElement( *---------------------------------------------------------------------- */ -int +size_t TclScanElement( const char *src, /* String to convert to Tcl list element. */ - int length, /* Number of bytes in src, or -1. */ + size_t length, /* Number of bytes in src, or -1. */ char *flagPtr) /* Where to store information to guide * Tcl_ConvertElement. */ { @@ -1030,7 +1024,7 @@ TclScanElement( int extra = 0; /* Count of number of extra bytes needed for * formatted element, assuming we use escape * sequences in formatting. */ - int bytesNeeded; /* Buffer length computed to complete the + size_t bytesNeeded; /* Buffer length computed to complete the * element formatting in the selected mode. */ #if COMPAT int preferEscape = 0; /* Use preferences to track whether to use */ @@ -1038,7 +1032,7 @@ TclScanElement( int braceCount = 0; /* Count of all braces '{' '}' seen. */ #endif /* COMPAT */ - if ((p == NULL) || (length == 0) || ((*p == '\0') && (length == -1))) { + if ((p == NULL) || (length == 0) || ((*p == '\0') && (length == TCL_INDEX_NONE))) { /* * Empty string element must be brace quoted. */ @@ -1121,7 +1115,7 @@ TclScanElement( break; case '\\': /* TYPE_SUBS */ extra++; /* Escape '\' => '\\' */ - if ((length == 1) || ((length == -1) && (p[1] == '\0'))) { + if ((length == 1) || ((length == TCL_INDEX_NONE) && (p[1] == '\0'))) { /* * Final backslash. Cannot format with brace quoting. */ @@ -1152,7 +1146,7 @@ TclScanElement( #endif /* COMPAT */ break; case '\0': /* TYPE_SUBS */ - if (length == -1) { + if (length == TCL_INDEX_NONE) { goto endOfString; } /* TODO: Panic on improper encoding? */ @@ -1168,7 +1162,7 @@ TclScanElement( break; } } - length -= (length > 0); + length -= (length+1 > 1); p++; } @@ -1203,7 +1197,7 @@ TclScanElement( bytesNeeded++; } *flagPtr = CONVERT_ESCAPE; - goto overflowCheck; + return bytesNeeded; } if (*flagPtr & CONVERT_ANY) { /* @@ -1251,7 +1245,7 @@ TclScanElement( bytesNeeded += braceCount; } *flagPtr = CONVERT_MASK; - goto overflowCheck; + return bytesNeeded; } #endif /* COMPAT */ if (*flagPtr & TCL_DONT_USE_BRACES) { @@ -1277,7 +1271,7 @@ TclScanElement( bytesNeeded += 2; } *flagPtr = CONVERT_BRACE; - goto overflowCheck; + return bytesNeeded; } /* @@ -1292,11 +1286,6 @@ TclScanElement( bytesNeeded += 2; } *flagPtr = CONVERT_NONE; - - overflowCheck: - if (bytesNeeded < 0) { - Tcl_Panic("TclScanElement: string length overflow"); - } return bytesNeeded; } @@ -1321,7 +1310,7 @@ TclScanElement( *---------------------------------------------------------------------- */ -int +size_t Tcl_ConvertElement( const char *src, /* Source information for list element. */ char *dst, /* Place to put list-ified element. */ @@ -1351,14 +1340,14 @@ Tcl_ConvertElement( *---------------------------------------------------------------------- */ -int +size_t Tcl_ConvertCountedElement( const char *src, /* Source information for list element. */ - int length, /* Number of bytes in src, or -1. */ + size_t length, /* Number of bytes in src, or -1. */ 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; } @@ -1384,10 +1373,10 @@ Tcl_ConvertCountedElement( *---------------------------------------------------------------------- */ -int +size_t TclConvertElement( const char *src, /* Source information for list element. */ - int length, /* Number of bytes in src, or -1. */ + size_t length, /* Number of bytes in src, or -1. */ char *dst, /* Place to put list-ified element. */ int flags) /* Flags produced by Tcl_ScanElement. */ { @@ -1406,7 +1395,7 @@ TclConvertElement( * No matter what the caller demands, empty string must be braced! */ - if ((src == NULL) || (length == 0) || (*src == '\0' && length == -1)) { + if ((src == NULL) || (length == 0) || (*src == '\0' && length == TCL_INDEX_NONE)) { p[0] = '{'; p[1] = '}'; return 2; @@ -1422,7 +1411,7 @@ TclConvertElement( p[1] = '#'; p += 2; src++; - length -= (length > 0); + length -= (length+1 > 1); } else { conversion = CONVERT_BRACE; } @@ -1433,7 +1422,7 @@ TclConvertElement( */ if (conversion == CONVERT_NONE) { - if (length == -1) { + if (length == TCL_INDEX_NONE) { /* TODO: INT_MAX overflow? */ while (*src) { *p++ = *src++; @@ -1452,7 +1441,7 @@ TclConvertElement( if (conversion == CONVERT_BRACE) { *p = '{'; p++; - if (length == -1) { + if (length == TCL_INDEX_NONE) { /* TODO: INT_MAX overflow? */ while (*src) { *p++ = *src++; @@ -1463,7 +1452,7 @@ TclConvertElement( } *p = '}'; p++; - return p - dst; + return (size_t)(p - dst); } /* conversion == CONVERT_ESCAPE or CONVERT_MASK */ @@ -1472,7 +1461,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 '[': @@ -1525,8 +1514,8 @@ TclConvertElement( p++; continue; case '\0': - if (length == -1) { - return p - dst; + if (length == TCL_INDEX_NONE) { + return (size_t)(p - dst); } /* @@ -1542,7 +1531,7 @@ TclConvertElement( *p = *src; p++; } - return p - dst; + return (size_t)(p - dst); } /* @@ -1572,7 +1561,8 @@ Tcl_Merge( { #define LOCAL_SIZE 64 char localFlags[LOCAL_SIZE], *flagPtr = NULL; - int i, bytesNeeded = 0; + int i; + size_t bytesNeeded = 0; char *result, *dst; /* @@ -1581,7 +1571,7 @@ Tcl_Merge( */ if (argc == 0) { - result = (char *)ckalloc(1); + result = (char *)Tcl_Alloc(1); result[0] = '\0'; return result; } @@ -1593,17 +1583,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], -1, &flagPtr[i]); - if (bytesNeeded < 0) { - Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); - } - } - if (bytesNeeded > INT_MAX - argc + 1) { - Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); } bytesNeeded += argc; @@ -1611,7 +1595,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 ); @@ -1622,47 +1606,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 */ - /* *---------------------------------------------------------------------- * @@ -1680,14 +1628,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'). */ { @@ -1705,7 +1653,7 @@ TclTrimRight( do { const char *q = trim; - int pInc = 0, bytesLeft = numTrim; + size_t pInc = 0, bytesLeft = numTrim; pp = TclUtfPrev(p, bytes); do { @@ -1718,7 +1666,7 @@ TclTrimRight( */ do { - int qInc = TclUtfToUCS4(q, &ch2); + size_t qInc = TclUtfToUCS4(q, &ch2); if (ch1 == ch2) { break; @@ -1759,14 +1707,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'). */ { @@ -1783,16 +1731,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; @@ -1833,19 +1781,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)) { @@ -1893,14 +1841,15 @@ 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. */ const char *const *argv) /* Array of strings to concatenate. */ { - int i, needSpace = 0, bytesNeeded = 0; + int i; + size_t needSpace = 0, bytesNeeded = 0; char *result, *p; /* @@ -1908,7 +1857,7 @@ Tcl_Concat( */ if (argc == 0) { - result = (char *) ckalloc(1); + result = (char *) Tcl_Alloc(1); result[0] = '\0'; return result; } @@ -1919,27 +1868,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]; @@ -2000,7 +1938,8 @@ Tcl_ConcatObj( int objc, /* Number of objects to concatenate. */ Tcl_Obj *const objv[]) /* Array of objects to concatenate. */ { - int i, elemLength, needSpace = 0, bytesNeeded = 0; + int i, needSpace = 0; + size_t bytesNeeded = 0, elemLength; const char *element; Tcl_Obj *objPtr, *resPtr; @@ -2011,13 +1950,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)TclGetStringFromObj(objPtr, &length); if (length > 0) { break; } @@ -2056,9 +1995,6 @@ Tcl_ConcatObj( for (i = 0; i < objc; i++) { element = TclGetStringFromObj(objv[i], &elemLength); bytesNeeded += elemLength; - if (bytesNeeded < 0) { - break; - } } /* @@ -2072,7 +2008,7 @@ Tcl_ConcatObj( Tcl_SetObjLength(resPtr, 0); for (i = 0; i < objc; i++) { - int triml, trimr; + size_t triml, trimr; element = TclGetStringFromObj(objv[i], &elemLength); @@ -2106,35 +2042,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 */ /* *---------------------------------------------------------------------- * @@ -2392,11 +2299,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; @@ -2573,7 +2480,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. @@ -2585,15 +2493,15 @@ TclStringMatchObj( if (TclHasIntRep(strObj, &tclStringType) || (strObj->typePtr == NULL)) { Tcl_UniChar *udata, *uptn; - udata = Tcl_GetUnicodeFromObj(strObj, &length); - uptn = Tcl_GetUnicodeFromObj(ptnObj, &plen); + udata = TclGetUnicodeFromObj(strObj, &length); + uptn = TclGetUnicodeFromObj(ptnObj, &plen); match = TclUniCharMatch(udata, length, uptn, plen, flags); } else if (TclIsPureByteArray(strObj) && TclIsPureByteArray(ptnObj) && !flags) { unsigned char *data, *ptn; - data = Tcl_GetByteArrayFromObj(strObj, &length); - ptn = Tcl_GetByteArrayFromObj(ptnObj, &plen); + data = TclGetByteArrayFromObj(strObj, &length); + ptn = TclGetByteArrayFromObj(ptnObj, &plen); match = TclByteArrayMatch(data, length, ptn, plen, 0); } else { match = Tcl_StringCaseMatch(TclGetString(strObj), @@ -2651,15 +2559,15 @@ Tcl_DStringInit( char * Tcl_DStringAppend( Tcl_DString *dsPtr, /* Structure describing dynamic string. */ - const char *bytes, /* String to append. If length is -1 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 + const char *bytes, /* String to append. If length is + * TCL_INDEX_NONE then this must be null-terminated. */ + size_t length) /* Number of bytes from "bytes" to append. If + * TCL_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; @@ -2673,23 +2581,23 @@ 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 offset = -1; + size_t index = TCL_INDEX_NONE; /* See [16896d49fd] */ if (bytes >= dsPtr->string && bytes <= dsPtr->string + dsPtr->length) { - offset = bytes - dsPtr->string; + index = bytes - dsPtr->string; } - dsPtr->string = (char *)ckrealloc(dsPtr->string, dsPtr->spaceAvl); + dsPtr->string = (char *)Tcl_Realloc(dsPtr->string, dsPtr->spaceAvl); - if (offset >= 0) { - bytes = dsPtr->string + offset; + if (index != TCL_INDEX_NONE) { + bytes = dsPtr->string + index; } } } @@ -2720,8 +2628,8 @@ TclDStringAppendObj( Tcl_DString *dsPtr, Tcl_Obj *objPtr) { - int length; - char *bytes = TclGetStringFromObj(objPtr, &length); + size_t length; + const char *bytes = TclGetStringFromObj(objPtr, &length); return Tcl_DStringAppend(dsPtr, bytes, length); } @@ -2762,7 +2670,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) { /* @@ -2804,7 +2713,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; @@ -2817,7 +2726,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; @@ -2855,8 +2764,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. * *---------------------------------------------------------------------- */ @@ -2864,13 +2772,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 @@ -2891,12 +2796,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; @@ -2926,7 +2831,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; @@ -2988,86 +2893,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; - TclFreeIntRep(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 */ } /* @@ -3193,10 +3024,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. @@ -3216,7 +3046,6 @@ Tcl_PrintDouble( int signum; char *digits; char *end; - int *precisionPtr = (int *)Tcl_GetThreadData(&precisionKey, sizeof(int)); /* * Handle NaN. @@ -3248,53 +3077,8 @@ Tcl_PrintDouble( * Ordinary (normal and denormal) values. */ - if (*precisionPtr == 0) { - digits = TclDoubleDigits(value, -1, 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++ = '-'; } @@ -3314,16 +3098,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. @@ -3355,87 +3130,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( - ClientData 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)*/ /* *---------------------------------------------------------------------- @@ -3555,15 +3251,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"; /* @@ -3623,11 +3318,11 @@ TclFormatInt( static int GetWideForIndex( Tcl_Interp *interp, /* Interpreter to use for error reporting. If - * NULL, then no error message is left after - * errors. */ + * NULL, then no error message is left after + * errors. */ Tcl_Obj *objPtr, /* Points to the value to be parsed */ size_t endValue, /* The value to be stored at *widePtr if - * objPtr holds "end". + * objPtr holds "end". * NOTE: this value may be TCL_INDEX_NONE. */ Tcl_WideInt *widePtr) /* Location filled in with a wide integer * representing an index. */ @@ -3659,21 +3354,26 @@ GetWideForIndex( * * Tcl_GetIntForIndex -- * - * This function returns an integer corresponding to the list index held - * in a Tcl object. The Tcl object's value is expected to be in the - * format integer([+-]integer)? or the format end([+-]integer)?. + * Provides an integer corresponding to the list index held in a Tcl + * object. The string value 'objPtr' is expected have the format + * integer([+-]integer)? or end([+-]integer)?. * - * Results: - * The return value is normally TCL_OK, which means that the index was - * successfully stored into the location referenced by "indexPtr". If the - * Tcl object referenced by "objPtr" has the value "end", the value - * stored is "endValue". If "objPtr"s values is not of one of the - * expected formats, TCL_ERROR is returned and, if "interp" is non-NULL, - * an error message is left in the interpreter's result object. + * Value + * TCL_OK * - * Side effects: - * The object referenced by "objPtr" might be converted to an integer, - * wide integer, or end-based-index object. + * The index is stored at the address given by by 'indexPtr'. If + * 'objPtr' has the value "end", the value stored is 'endValue'. + * + * TCL_ERROR + * + * The value of 'objPtr' does not have one of the expected formats. If + * 'interp' is non-NULL, an error message is left in the interpreter's + * result object. + * + * Effect + * + * The object referenced by 'objPtr' is converted, as needed, to an + * integer, wide integer, or end-based-index object. * *---------------------------------------------------------------------- */ @@ -3685,25 +3385,25 @@ 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 - * representing an index. May be NULL.*/ + size_t *indexPtr) /* Location filled in with an integer + * representing an index. */ { Tcl_WideInt wide; - if (GetWideForIndex(interp, objPtr, (size_t)(endValue + 1) - 1, &wide) == TCL_ERROR) { + /* Use platform-related size_t to wide-int to consider negative value + * TCL_INDEX_NONE if wide-int and size_t have different dimensions. */ + if (GetWideForIndex(interp, objPtr, endValue, &wide) == TCL_ERROR) { return TCL_ERROR; } if (indexPtr != NULL) { - if ((wide < 0) && (endValue > TCL_INDEX_END)) { - *indexPtr = -1; - } else if (wide > INT_MAX) { - *indexPtr = INT_MAX; - } else if (wide < INT_MIN) { - *indexPtr = INT_MIN; + if ((wide < 0) && (endValue != TCL_INDEX_END)) { + *indexPtr = TCL_INDEX_NONE; + } else if ((Tcl_WideUInt)wide > TCL_INDEX_END) { + *indexPtr = TCL_INDEX_END; } else { - *indexPtr = (int) wide; + *indexPtr = (size_t) wide; } } return TCL_OK; @@ -3751,13 +3451,13 @@ GetEndOffsetFromObj( while ((irPtr = TclFetchIntRep(objPtr, &endOffsetType)) == NULL) { Tcl_ObjIntRep ir; - int length; + size_t length; const char *bytes = TclGetStringFromObj(objPtr, &length); if (*bytes != 'e') { int numType; const char *opPtr; - int t1 = 0, t2 = 0; + int len, t1 = 0, t2 = 0; /* Value doesn't start with "e" */ @@ -3777,8 +3477,8 @@ GetEndOffsetFromObj( if ((TclMaxListLength(bytes, -1, NULL) > 1) /* If it's possible, do the full list parse. */ - && (TCL_OK == Tcl_ListObjLength(NULL, objPtr, &length)) - && (length > 1)) { + && (TCL_OK == Tcl_ListObjLength(NULL, objPtr, &len)) + && (len > 1)) { goto parseError; } @@ -3966,7 +3666,6 @@ GetEndOffsetFromObj( if (!strncmp(bytes, "end-", 4)) { bytes += 4; } - TclCheckBadOctal(interp, bytes); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL); } @@ -4032,8 +3731,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; @@ -4055,7 +3754,7 @@ TclIndexEncode( * 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 { @@ -4084,17 +3783,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; } @@ -4102,73 +3800,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)", -1); - } - return 1; - } - } - return 0; -} - -/* - *---------------------------------------------------------------------- - * * ClearHash -- * * Remove all the entries in the hash table *tablePtr. @@ -4218,7 +3849,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); } @@ -4247,7 +3878,7 @@ FreeThreadHash( ClearHash(tablePtr); Tcl_DeleteHashTable(tablePtr); - ckfree(tablePtr); + Tcl_Free(tablePtr); } /* @@ -4269,7 +3900,7 @@ FreeProcessGlobalValue( pgvPtr->epoch++; pgvPtr->numBytes = 0; - ckfree(pgvPtr->value); + Tcl_Free(pgvPtr->value); pgvPtr->value = NULL; if (pgvPtr->encoding) { Tcl_FreeEncoding(pgvPtr->encoding); @@ -4308,13 +3939,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); @@ -4356,7 +3987,7 @@ TclGetProcessGlobalValue( Tcl_Obj *value = NULL; Tcl_HashTable *cacheMap; Tcl_HashEntry *hPtr; - unsigned int epoch = pgvPtr->epoch; + size_t epoch = pgvPtr->epoch; if (pgvPtr->encoding) { Tcl_Encoding current = Tcl_GetEncoding(NULL, NULL); @@ -4377,8 +4008,8 @@ TclGetProcessGlobalValue( Tcl_ExternalToUtfDString(current, Tcl_DStringValue(&native), Tcl_DStringLength(&native), &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); @@ -4518,31 +4149,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 @@ -4587,7 +4193,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 0f0bc25..3de3a89 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -342,7 +342,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)); @@ -384,7 +384,7 @@ CleanupVar( && (VarHashRefCount(varPtr) == (unsigned) !TclIsVarDeadHash(varPtr))) { if (VarHashRefCount(varPtr) == 0) { - ckfree(varPtr); + Tcl_Free(varPtr); } else { VarHashDeleteEntry(varPtr); } @@ -394,7 +394,7 @@ CleanupVar( (VarHashRefCount(arrayPtr) == (unsigned) !TclIsVarDeadHash(arrayPtr))) { if (VarHashRefCount(arrayPtr) == 0) { - ckfree(arrayPtr); + Tcl_Free(arrayPtr); } else { VarHashDeleteEntry(arrayPtr); } @@ -664,7 +664,7 @@ TclObjLookupVarEx( * part1Ptr is possibly an unparsed array element. */ - int len; + size_t len; const char *part1 = TclGetStringFromObj(part1Ptr, &len); if ((len > 1) && (part1[len - 1] == ')')) { @@ -846,7 +846,8 @@ TclLookupSimpleVar( * the variable. */ Namespace *varNsPtr, *cxtNsPtr, *dummy1Ptr, *dummy2Ptr; ResolverScheme *resPtr; - int isNew, i, result, varLen; + int isNew, i, result; + size_t varLen; const char *varName = TclGetStringFromObj(varNamePtr, &varLen); varPtr = NULL; @@ -919,12 +920,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; } /* @@ -980,7 +977,7 @@ 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; @@ -999,7 +996,7 @@ TclLookupSimpleVar( tablePtr = varFramePtr->varTablePtr; if (create) { if (tablePtr == NULL) { - tablePtr = (TclVarHashTable *)ckalloc(sizeof(TclVarHashTable)); + tablePtr = (TclVarHashTable *)Tcl_Alloc(sizeof(TclVarHashTable)); TclInitVarHashTable(tablePtr, NULL); varFramePtr->varTablePtr = tablePtr; } @@ -1147,51 +1144,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 @@ -1557,53 +1509,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 @@ -2356,57 +2261,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. @@ -3216,7 +3070,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); /* @@ -3337,7 +3191,7 @@ ArrayForLoopCallback( ArrayDoneSearch(iPtr, varPtr, searchPtr); Tcl_DecrRefCount(searchPtr->name); - ckfree(searchPtr); + Tcl_Free(searchPtr); } TclDecrRefCount(varListObj); @@ -3423,7 +3277,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; @@ -3687,7 +3541,7 @@ ArrayDoneSearchCmd( ArrayDoneSearch(iPtr, varPtr, searchPtr); Tcl_DecrRefCount(searchPtr->name); - ckfree(searchPtr); + Tcl_Free(searchPtr); return TCL_OK; } @@ -4341,7 +4195,7 @@ ArrayStatsCmd( return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewStringObj(stats, -1)); - ckfree(stats); + Tcl_Free(stats); return TCL_OK; } @@ -4799,63 +4653,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" @@ -5403,7 +5200,7 @@ DeleteSearches( searchPtr = nextPtr) { nextPtr = searchPtr->nextPtr; Tcl_DecrRefCount(searchPtr->name); - ckfree(searchPtr); + Tcl_Free(searchPtr); } arrayVarPtr->flags &= ~VAR_SEARCH_ACTIVE; Tcl_DeleteHashEntry(sPtr); @@ -5980,6 +5777,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); @@ -6544,7 +6345,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; @@ -6566,7 +6367,7 @@ FreeVarEntry( if (TclIsVarUndefined(varPtr) && !TclIsVarTraced(varPtr) && (VarHashRefCount(varPtr) == 1)) { - ckfree(varPtr); + Tcl_Free(varPtr); } else { VarHashInvalidateEntry(varPtr); TclSetVarUndefined(varPtr); @@ -6577,13 +6378,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. @@ -6773,7 +6574,7 @@ void TclInitArrayVar( Var *arrayPtr) { - ArrayVarHashTable *tablePtr = (ArrayVarHashTable *)ckalloc(sizeof(ArrayVarHashTable)); + ArrayVarHashTable *tablePtr = (ArrayVarHashTable *)Tcl_Alloc(sizeof(ArrayVarHashTable)); /* * Mark the variable as an array. @@ -6817,7 +6618,7 @@ DeleteArrayVar( */ VarHashDeleteTable(arrayPtr->value.tablePtr); - ckfree(tablePtr); + Tcl_Free(tablePtr); } /* diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index 4a13970..bc59f15 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -332,10 +332,6 @@ static int ZipChannelClose(void *instanceData, static Tcl_DriverGetHandleProc ZipChannelGetFile; static int ZipChannelRead(void *instanceData, char *buf, int toRead, int *errloc); -#ifndef TCL_NO_DEPRECATED -static int ZipChannelSeek(void *instanceData, long offset, - int mode, int *errloc); -#endif static Tcl_WideInt ZipChannelWideSeek(void *instanceData, Tcl_WideInt offset, int mode, int *errloc); static void ZipChannelWatchChannel(void *instanceData, @@ -388,14 +384,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 */ -#ifndef TCL_NO_DEPRECATED - 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 */ @@ -408,12 +400,6 @@ static Tcl_ChannelType ZipChannelType = { NULL, /* Thread action function, NULL'able */ NULL, /* Truncate function, NULL'able */ }; - -/* - * Miscellaneous constants. - */ - -#define ERROR_LENGTH ((size_t) -1) /* *------------------------------------------------------------------------- @@ -860,12 +846,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; @@ -888,11 +874,11 @@ ZipFSCloseArchive( #endif /* _WIN32 */ if (zf->ptrToFree) { - ckfree(zf->ptrToFree); + Tcl_Free(zf->ptrToFree); zf->ptrToFree = NULL; } if (zf->chan) { - Tcl_Close(interp, zf->chan); + Tcl_CloseEx(interp, zf->chan, 0); zf->chan = NULL; } } @@ -1066,7 +1052,7 @@ ZipFSOpenArchive( } if (Tcl_GetChannelHandle(zf->chan, TCL_READABLE, &handle) != TCL_OK) { zf->length = Tcl_Seek(zf->chan, 0, SEEK_END); - if (zf->length == ERROR_LENGTH) { + if (zf->length == TCL_IO_FAILURE) { ZIPFS_POSIX_ERROR(interp, "seek error"); goto error; } @@ -1082,7 +1068,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_ERROR(interp, "out of memory"); if (interp) { @@ -1095,7 +1081,7 @@ ZipFSOpenArchive( ZIPFS_POSIX_ERROR(interp, "file read error"); goto error; } - Tcl_Close(interp, zf->chan); + Tcl_CloseEx(interp, zf->chan, 0); zf->chan = NULL; } else { #ifdef _WIN32 @@ -1125,7 +1111,7 @@ ZipFSOpenArchive( } #else /* !_WIN32 */ zf->length = lseek(PTR2INT(handle), 0, SEEK_END); - if (zf->length == ERROR_LENGTH || zf->length < ZIP_CENTRAL_END_LEN) { + if (zf->length == TCL_IO_FAILURE || zf->length < ZIP_CENTRAL_END_LEN) { ZIPFS_POSIX_ERROR(interp, "invalid file size"); goto error; } @@ -1222,7 +1208,7 @@ ZipFSCatalogFilesystem( ZipFSCloseArchive(interp, zf0); return TCL_ERROR; } - zf = (ZipFile *)attemptckalloc(sizeof(ZipFile) + strlen(mountPoint) + 1); + zf = (ZipFile *)Tcl_AttemptAlloc(sizeof(ZipFile) + strlen(mountPoint) + 1); if (!zf) { if (interp) { Tcl_AppendResult(interp, "out of memory", (char *) NULL); @@ -1239,7 +1225,7 @@ ZipFSCatalogFilesystem( Tcl_CreateExitHandler(ZipfsExitHandler, zf); 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); zf->entries = NULL; zf->topEnts = NULL; @@ -1258,7 +1244,7 @@ ZipFSCatalogFilesystem( if (mountPoint[0] != '\0') { hPtr = Tcl_CreateHashEntry(&ZipFS.fileHash, mountPoint, &isNew); if (isNew) { - z = (ZipEntry *)ckalloc(sizeof(ZipEntry)); + z = (ZipEntry *)Tcl_Alloc(sizeof(ZipEntry)); Tcl_SetHashValue(hPtr, z); z->tnext = NULL; @@ -1353,7 +1339,7 @@ ZipFSCatalogFilesystem( } Tcl_DStringSetLength(&fpBuf, 0); fullpath = CanonicalPath(mountPoint, path, &fpBuf, 1); - z = (ZipEntry *)ckalloc(sizeof(ZipEntry)); + z = (ZipEntry *)Tcl_Alloc(sizeof(ZipEntry)); z->name = NULL; z->tnext = NULL; z->depth = CountSlashes(fullpath); @@ -1382,7 +1368,7 @@ ZipFSCatalogFilesystem( hPtr = Tcl_CreateHashEntry(&ZipFS.fileHash, fullpath, &isNew); if (!isNew) { /* should not happen but skip it anyway */ - ckfree(z); + Tcl_Free(z); } else { Tcl_SetHashValue(hPtr, z); z->name = (char *)Tcl_GetHashKey(&ZipFS.fileHash, hPtr); @@ -1407,7 +1393,7 @@ ZipFSCatalogFilesystem( if (!isNew) { break; } - zd = (ZipEntry *)ckalloc(sizeof(ZipEntry)); + zd = (ZipEntry *)Tcl_Alloc(sizeof(ZipEntry)); zd->name = NULL; zd->tnext = NULL; zd->depth = CountSlashes(dir); @@ -1621,7 +1607,7 @@ TclZipfs_Mount( return TCL_ERROR; } } - zf = (ZipFile *)attemptckalloc(sizeof(ZipFile) + strlen(mountPoint) + 1); + zf = (ZipFile *)Tcl_AttemptAlloc(sizeof(ZipFile) + strlen(mountPoint) + 1); if (!zf) { if (interp) { Tcl_AppendResult(interp, "out of memory", (char *) NULL); @@ -1630,15 +1616,15 @@ 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) != TCL_OK) { - ckfree(zf); + Tcl_Free(zf); return TCL_ERROR; } - ckfree(zf); + Tcl_Free(zf); return TCL_OK; } @@ -1702,7 +1688,7 @@ TclZipfs_MountBuffer( * Have both a mount point and data to mount there. */ - zf = (ZipFile *)attemptckalloc(sizeof(ZipFile) + strlen(mountPoint) + 1); + zf = (ZipFile *)Tcl_AttemptAlloc(sizeof(ZipFile) + strlen(mountPoint) + 1); if (!zf) { if (interp) { Tcl_AppendResult(interp, "out of memory", (char *) NULL); @@ -1713,7 +1699,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) { if (interp) { Tcl_AppendResult(interp, "out of memory", (char *) NULL); @@ -1733,7 +1719,7 @@ TclZipfs_MountBuffer( } result = ZipFSCatalogFilesystem(interp, zf, mountPoint, NULL, "Memory Buffer"); - ckfree(zf); + Tcl_Free(zf); return result; } @@ -1797,13 +1783,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(ZipfsExitHandler, zf); - ckfree(zf); + Tcl_Free(zf); unmounted = 1; done: Unlock(); @@ -1843,9 +1829,9 @@ ZipFSMountObjCmd( return TCL_ERROR; } - return TclZipfs_Mount(interp, (objc > 1) ? Tcl_GetString(objv[1]) : NULL, - (objc > 2) ? Tcl_GetString(objv[2]) : NULL, - (objc > 3) ? Tcl_GetString(objv[3]) : NULL); + return TclZipfs_Mount(interp, (objc > 1) ? TclGetString(objv[1]) : NULL, + (objc > 2) ? TclGetString(objv[2]) : NULL, + (objc > 3) ? TclGetString(objv[3]) : NULL); } /* @@ -1873,7 +1859,7 @@ ZipFSMountBufferObjCmd( { const char *mountPoint; /* Mount point path. */ unsigned char *data; - int length; + size_t length = 0; if (objc > 3) { Tcl_WrongNumArgs(interp, 1, objv, "?mountpoint? ?data?"); @@ -1888,7 +1874,7 @@ ZipFSMountBufferObjCmd( return ret; } - mountPoint = Tcl_GetString(objv[1]); + mountPoint = TclGetString(objv[1]); if (objc < 3) { ReadLock(); DescribeMounted(interp, mountPoint); @@ -1958,7 +1944,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])); } /* @@ -1992,7 +1978,7 @@ ZipFSMkKeyObjCmd( Tcl_WrongNumArgs(interp, 1, objv, "password"); return TCL_ERROR; } - pw = Tcl_GetString(objv[1]); + pw = TclGetString(objv[1]); len = strlen(pw); if (len == 0) { return TCL_OK; @@ -2088,11 +2074,11 @@ ZipAddFile( #ifdef _WIN32 /* hopefully a directory */ if (strcmp("permission denied", Tcl_PosixError(interp)) == 0) { - Tcl_Close(interp, in); + Tcl_CloseEx(interp, in, 0); return TCL_OK; } #endif /* _WIN32 */ - Tcl_Close(interp, in); + Tcl_CloseEx(interp, in, 0); return TCL_ERROR; } else { Tcl_Obj *pathObj = Tcl_NewStringObj(path, -1); @@ -2109,14 +2095,14 @@ ZipAddFile( nbyte = nbytecompr = 0; while (1) { len = Tcl_Read(in, buf, bufsize); - if (len == ERROR_LENGTH) { + if (len == TCL_IO_FAILURE) { if (nbyte == 0 && errno == EISDIR) { - Tcl_Close(interp, in); + Tcl_CloseEx(interp, in, 0); return TCL_OK; } Tcl_SetObjResult(interp, Tcl_ObjPrintf("read error on \"%s\": %s", path, Tcl_PosixError(interp))); - Tcl_Close(interp, in); + Tcl_CloseEx(interp, in, 0); return TCL_ERROR; } if (len == 0) { @@ -2128,18 +2114,18 @@ ZipAddFile( if (Tcl_Seek(in, 0, SEEK_SET) == -1) { Tcl_SetObjResult(interp, Tcl_ObjPrintf("seek error on \"%s\": %s", path, Tcl_PosixError(interp))); - Tcl_Close(interp, in); + Tcl_CloseEx(interp, in, 0); return TCL_ERROR; } pos[0] = Tcl_Tell(out); memset(buf, '\0', ZIP_LOCAL_HEADER_LEN); memcpy(buf + ZIP_LOCAL_HEADER_LEN, zpath, zpathlen); len = zpathlen + ZIP_LOCAL_HEADER_LEN; - if ((size_t) Tcl_Write(out, buf, len) != len) { + if (Tcl_Write(out, buf, len) != len) { wrerr: Tcl_SetObjResult(interp, Tcl_ObjPrintf( "write error on %s: %s", path, Tcl_PosixError(interp))); - Tcl_Close(interp, in); + Tcl_CloseEx(interp, in, 0); return TCL_ERROR; } if ((len + pos[0]) & 3) { @@ -2154,7 +2140,7 @@ ZipAddFile( ZipWriteShort(abuf, 0xffff); ZipWriteShort(abuf + 2, align - 4); ZipWriteInt(abuf + 4, 0x03020100); - if ((size_t) Tcl_Write(out, (const char *) abuf, align) != align) { + if (Tcl_Write(out, (const char *) abuf, align) != align) { goto wrerr; } } @@ -2173,7 +2159,7 @@ ZipAddFile( i); Tcl_AppendObjToErrorInfo(interp, eiPtr); - Tcl_Close(interp, in); + Tcl_CloseEx(interp, in, 0); return TCL_ERROR; } ret = Tcl_GetObjResult(interp); @@ -2183,7 +2169,7 @@ ZipAddFile( i); Tcl_AppendObjToErrorInfo(interp, eiPtr); - Tcl_Close(interp, in); + Tcl_CloseEx(interp, in, 0); return TCL_ERROR; } ch = (int) (r * 256); @@ -2201,7 +2187,7 @@ ZipAddFile( if (len != 12) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "write error on %s: %s", path, Tcl_PosixError(interp))); - Tcl_Close(interp, in); + Tcl_CloseEx(interp, in, 0); return TCL_ERROR; } memcpy(keys0, keys, sizeof(keys0)); @@ -2219,16 +2205,16 @@ ZipAddFile( Tcl_SetObjResult(interp, Tcl_ObjPrintf( "compression init error on \"%s\"", path)); Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "DEFLATE_INIT", NULL); - Tcl_Close(interp, in); + Tcl_CloseEx(interp, in, 0); return TCL_ERROR; } do { len = Tcl_Read(in, buf, bufsize); - if (len == ERROR_LENGTH) { + if (len == TCL_IO_FAILURE) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "read error on %s: %s", path, Tcl_PosixError(interp))); deflateEnd(&stream); - Tcl_Close(interp, in); + Tcl_CloseEx(interp, in, 0); return TCL_ERROR; } stream.avail_in = len; @@ -2243,7 +2229,7 @@ ZipAddFile( "deflate error on %s", path)); Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "DEFLATE", NULL); deflateEnd(&stream); - Tcl_Close(interp, in); + Tcl_CloseEx(interp, in, 0); return TCL_ERROR; } olen = sizeof(obuf) - stream.avail_out; @@ -2255,11 +2241,11 @@ ZipAddFile( obuf[i] = (char) zencode(keys, crc32tab, obuf[i], tmp); } } - if (olen && ((size_t) Tcl_Write(out, obuf, olen) != olen)) { + if (olen && (Tcl_Write(out, obuf, olen) != olen)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "write error: %s", Tcl_PosixError(interp))); deflateEnd(&stream); - Tcl_Close(interp, in); + Tcl_CloseEx(interp, in, 0); return TCL_ERROR; } nbytecompr += olen; @@ -2277,7 +2263,7 @@ ZipAddFile( } if (Tcl_Seek(out, pos[2], SEEK_SET) != pos[2]) { seekErr: - Tcl_Close(interp, in); + Tcl_CloseEx(interp, in, 0); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "seek error: %s", Tcl_PosixError(interp))); return TCL_ERROR; @@ -2285,11 +2271,11 @@ ZipAddFile( nbytecompr = (passwd ? 12 : 0); while (1) { len = Tcl_Read(in, buf, bufsize); - if (len == ERROR_LENGTH) { + if (len == TCL_IO_FAILURE) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "read error on \"%s\": %s", path, Tcl_PosixError(interp))); - Tcl_Close(interp, in); + Tcl_CloseEx(interp, in, 0); return TCL_ERROR; } else if (len == 0) { break; @@ -2302,10 +2288,10 @@ ZipAddFile( buf[i] = (char) zencode(keys0, crc32tab, buf[i], tmp); } } - if ((size_t) Tcl_Write(out, buf, len) != len) { + if (Tcl_Write(out, buf, len) != len) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "write error: %s", Tcl_PosixError(interp))); - Tcl_Close(interp, in); + Tcl_CloseEx(interp, in, 0); return TCL_ERROR; } nbytecompr += len; @@ -2315,7 +2301,7 @@ ZipAddFile( pos[1] = Tcl_Tell(out); Tcl_TruncateChannel(out, pos[1]); } - Tcl_Close(interp, in); + Tcl_CloseEx(interp, in, 0); hPtr = Tcl_CreateHashEntry(fileHash, zpath, &isNew); if (!isNew) { @@ -2325,7 +2311,7 @@ ZipAddFile( return TCL_ERROR; } - z = (ZipEntry *)ckalloc(sizeof(ZipEntry)); + z = (ZipEntry *)Tcl_Alloc(sizeof(ZipEntry)); Tcl_SetHashValue(hPtr, z); z->name = NULL; z->tnext = NULL; @@ -2359,14 +2345,14 @@ ZipAddFile( ZipWriteShort(buf + ZIP_LOCAL_EXTRALEN_OFFS, align); if (Tcl_Seek(out, pos[0], SEEK_SET) != pos[0]) { 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; @@ -2374,7 +2360,7 @@ ZipAddFile( Tcl_Flush(out); if (Tcl_Seek(out, pos[1], SEEK_SET) != pos[1]) { Tcl_DeleteHashEntry(hPtr); - ckfree(z); + Tcl_Free(z); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "seek error: %s", Tcl_PosixError(interp))); return TCL_ERROR; @@ -2426,7 +2412,7 @@ ZipFSMkZipOrImgObjCmd( passBuf[0] = 0; if (objc > (isList ? 3 : 4)) { - pw = Tcl_GetString(objv[isList ? 3 : 4]); + pw = TclGetString(objv[isList ? 3 : 4]); pwlen = strlen(pw); if ((pwlen > 255) || strchr(pw, 0xff)) { Tcl_SetObjResult(interp, @@ -2470,7 +2456,7 @@ ZipFSMkZipOrImgObjCmd( Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "EMPTY", NULL); return TCL_ERROR; } - out = Tcl_OpenFileChannel(interp, Tcl_GetString(objv[1]), "wb", 0755); + out = Tcl_OpenFileChannel(interp, TclGetString(objv[1]), "wb", 0755); if (out == NULL) { Tcl_DecrRefCount(list); return TCL_ERROR; @@ -2485,10 +2471,10 @@ ZipFSMkZipOrImgObjCmd( const char *imgName; if (isList) { - imgName = (objc > 4) ? Tcl_GetString(objv[4]) : + imgName = (objc > 4) ? TclGetString(objv[4]) : Tcl_GetNameOfExecutable(); } else { - imgName = (objc > 5) ? Tcl_GetString(objv[5]) : + imgName = (objc > 5) ? TclGetString(objv[5]) : Tcl_GetNameOfExecutable(); } if (pwlen) { @@ -2527,13 +2513,13 @@ ZipFSMkZipOrImgObjCmd( zf = &zf0; } if (isMounted || ZipFSOpenArchive(interp, imgName, 0, zf) == TCL_OK) { - if ((size_t) Tcl_Write(out, (char *) zf->data, + if (Tcl_Write(out, (char *) zf->data, zf->passOffset) != zf->passOffset) { memset(passBuf, 0, sizeof(passBuf)); Tcl_DecrRefCount(list); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "write error: %s", Tcl_PosixError(interp))); - Tcl_Close(interp, out); + Tcl_CloseEx(interp, out, 0); if (zf == &zf0) { ZipFSCloseArchive(interp, zf); } else { @@ -2566,18 +2552,18 @@ ZipFSMkZipOrImgObjCmd( if (!in) { memset(passBuf, 0, sizeof(passBuf)); Tcl_DecrRefCount(list); - Tcl_Close(interp, out); + Tcl_CloseEx(interp, out, 0); return TCL_ERROR; } i = Tcl_Seek(in, 0, SEEK_END); - if (i == ERROR_LENGTH) { + if (i == TCL_IO_FAILURE) { cperr: memset(passBuf, 0, sizeof(passBuf)); Tcl_DecrRefCount(list); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "%s: %s", errMsg, Tcl_PosixError(interp))); - Tcl_Close(interp, out); - Tcl_Close(interp, in); + Tcl_CloseEx(interp, out, 0); + Tcl_CloseEx(interp, in, 0); return TCL_ERROR; } Tcl_Seek(in, 0, SEEK_SET); @@ -2599,7 +2585,7 @@ ZipFSMkZipOrImgObjCmd( goto cperr; } } - Tcl_Close(interp, in); + Tcl_CloseEx(interp, in, 0); } len = strlen(passBuf); if (len > 0) { @@ -2608,7 +2594,7 @@ ZipFSMkZipOrImgObjCmd( Tcl_DecrRefCount(list); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "write error: %s", Tcl_PosixError(interp))); - Tcl_Close(interp, out); + Tcl_CloseEx(interp, out, 0); return TCL_ERROR; } } @@ -2618,15 +2604,15 @@ ZipFSMkZipOrImgObjCmd( Tcl_InitHashTable(&fileHash, TCL_STRING_KEYS); pos[0] = Tcl_Tell(out); if (!isList && (objc > 3)) { - strip = Tcl_GetString(objv[3]); + strip = TclGetString(objv[3]); slen = strlen(strip); } for (i = 0; i < (size_t) lobjc; i += (isList ? 2 : 1)) { const char *path, *name; - path = Tcl_GetString(lobjv[i]); + path = TclGetString(lobjv[i]); if (isList) { - name = Tcl_GetString(lobjv[i + 1]); + name = TclGetString(lobjv[i + 1]); } else { name = path; if (slen > 0) { @@ -2653,9 +2639,9 @@ ZipFSMkZipOrImgObjCmd( for (i = 0; i < (size_t) lobjc; i += (isList ? 2 : 1)) { const char *path, *name; - path = Tcl_GetString(lobjv[i]); + path = TclGetString(lobjv[i]); if (isList) { - name = Tcl_GetString(lobjv[i + 1]); + name = TclGetString(lobjv[i + 1]); } else { name = path; if (slen > 0) { @@ -2697,7 +2683,7 @@ ZipFSMkZipOrImgObjCmd( ZipWriteInt(buf + ZIP_CENTRAL_LOCALHDR_OFFS, z->offset - pos[0]); if ((Tcl_Write(out, buf, ZIP_CENTRAL_HEADER_LEN) != ZIP_CENTRAL_HEADER_LEN) - || ((size_t) Tcl_Write(out, z->name, len) != len)) { + || (Tcl_Write(out, z->name, len) != len)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "write error: %s", Tcl_PosixError(interp))); goto done; @@ -2724,15 +2710,15 @@ ZipFSMkZipOrImgObjCmd( done: if (ret == TCL_OK) { - ret = Tcl_Close(interp, out); + ret = Tcl_CloseEx(interp, out, 0); } else { - Tcl_Close(interp, out); + Tcl_CloseEx(interp, out, 0); } Tcl_DecrRefCount(list); 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); @@ -2889,11 +2875,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; @@ -2901,8 +2887,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)); @@ -2947,7 +2933,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); @@ -2994,7 +2980,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) { @@ -3048,13 +3034,13 @@ ZipFSListObjCmd( return TCL_ERROR; } if (objc == 3) { - int n; - char *what = Tcl_GetStringFromObj(objv[1], &n); + size_t n; + char *what = TclGetStringFromObj(objv[1], &n); if ((n >= 2) && (strncmp(what, "-glob", n) == 0)) { - pattern = Tcl_GetString(objv[2]); + pattern = TclGetString(objv[2]); } else if ((n >= 2) && (strncmp(what, "-regexp", n) == 0)) { - regexp = Tcl_RegExpCompile(interp, Tcl_GetString(objv[2])); + regexp = Tcl_RegExpCompile(interp, TclGetString(objv[2])); if (!regexp) { return TCL_ERROR; } @@ -3065,7 +3051,7 @@ ZipFSListObjCmd( return TCL_ERROR; } } else if (objc == 2) { - pattern = Tcl_GetString(objv[1]); + pattern = TclGetString(objv[1]); } ReadLock(); if (pattern) { @@ -3164,7 +3150,7 @@ TclZipfs_TclLibrary(void) */ #if defined(_WIN32) - hModule = TclWinGetTclInstance(); + hModule = (HMODULE)TclWinGetTclInstance(); GetModuleFileNameW(hModule, wName, MAX_PATH); WideCharToMultiByte(CP_UTF8, 0, wName, -1, dllName, sizeof(dllName), NULL, NULL); @@ -3274,7 +3260,7 @@ ZipChannelClose( } if (info->iscompr && info->ubuf) { - ckfree(info->ubuf); + Tcl_Free(info->ubuf); info->ubuf = NULL; } if (info->isEncrypted) { @@ -3283,11 +3269,11 @@ ZipChannelClose( } if (info->isWriting) { ZipEntry *z = info->zipEntryPtr; - unsigned char *newdata = (unsigned char *)attemptckrealloc(info->ubuf, info->numRead); + unsigned char *newdata = (unsigned char *)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; @@ -3298,13 +3284,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; } @@ -3498,18 +3484,6 @@ ZipChannelWideSeek( info->numRead = (size_t) offset; return info->numRead; } - -#ifndef TCL_NO_DEPRECATED -static int -ZipChannelSeek( - void *instanceData, - long offset, - int mode, - int *errloc) -{ - return ZipChannelWideSeek(instanceData, offset, mode, errloc); -} -#endif /* *------------------------------------------------------------------------- @@ -3646,7 +3620,7 @@ ZipChannelOpen( } else { flags = TCL_WRITABLE; } - info = (ZipChannel *)attemptckalloc(sizeof(ZipChannel)); + info = (ZipChannel *)Tcl_AttemptAlloc(sizeof(ZipChannel)); if (!info) { ZIPFS_ERROR(interp, "out of memory"); if (interp) { @@ -3664,13 +3638,13 @@ ZipChannelOpen( info->maxWrite = ZipFS.wrmax; info->iscompr = 0; info->isEncrypted = 0; - info->ubuf = (unsigned char *)attemptckalloc(info->maxWrite); + info->ubuf = (unsigned char *)Tcl_AttemptAlloc(info->maxWrite); if (!info->ubuf) { merror0: if (info->ubuf) { - ckfree(info->ubuf); + Tcl_Free(info->ubuf); } - ckfree(info); + Tcl_Free(info); ZIPFS_ERROR(interp, "out of memory"); if (interp) { Tcl_SetErrorCode(interp, "TCL", "MALLOC", NULL); @@ -3681,7 +3655,7 @@ ZipChannelOpen( if (trunc) { info->numBytes = 0; } else if (z->data) { - unsigned int j = z->numBytes; + size_t j = z->numBytes; if (j > info->maxWrite) { j = info->maxWrite; @@ -3719,10 +3693,10 @@ ZipChannelOpen( stream.opaque = Z_NULL; stream.avail_in = z->numCompressedBytes; if (z->isEncrypted) { - unsigned int j; + size_t j; stream.avail_in -= 12; - cbuf = (unsigned char *)attemptckalloc(stream.avail_in); + cbuf = (unsigned char *)Tcl_AttemptAlloc(stream.avail_in); if (!cbuf) { goto merror0; } @@ -3745,19 +3719,19 @@ ZipChannelOpen( || ((err == Z_OK) && (stream.avail_in == 0))) { if (cbuf) { memset(info->keys, 0, sizeof(info->keys)); - ckfree(cbuf); + Tcl_Free(cbuf); } goto wrapchan; } cerror0: if (cbuf) { memset(info->keys, 0, sizeof(info->keys)); - ckfree(cbuf); + Tcl_Free(cbuf); } if (info->ubuf) { - ckfree(info->ubuf); + Tcl_Free(info->ubuf); } - ckfree(info); + Tcl_Free(info); ZIPFS_ERROR(interp, "decompression error"); if (interp) { Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "CORRUPT", NULL); @@ -3813,7 +3787,7 @@ ZipChannelOpen( z_stream stream; int err; unsigned char *ubuf = NULL; - unsigned int j; + size_t j; memset(&stream, 0, sizeof(z_stream)); stream.zalloc = Z_NULL; @@ -3822,7 +3796,7 @@ ZipChannelOpen( 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 merror; @@ -3835,15 +3809,15 @@ ZipChannelOpen( } else { stream.next_in = info->ubuf; } - stream.next_out = info->ubuf = (unsigned char *)attemptckalloc(info->numBytes); + stream.next_out = info->ubuf = (unsigned char *)Tcl_AttemptAlloc(info->numBytes); if (!info->ubuf) { merror: if (ubuf) { info->isEncrypted = 0; memset(info->keys, 0, sizeof(info->keys)); - ckfree(ubuf); + Tcl_Free(ubuf); } - ckfree(info); + Tcl_Free(info); if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj("out of memory", -1)); @@ -3862,7 +3836,7 @@ ZipChannelOpen( if (ubuf) { info->isEncrypted = 0; memset(info->keys, 0, sizeof(info->keys)); - ckfree(ubuf); + Tcl_Free(ubuf); } goto wrapchan; } @@ -3870,12 +3844,12 @@ ZipChannelOpen( 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); } - ckfree(info); + Tcl_Free(info); ZIPFS_ERROR(interp, "decompression error"); if (interp) { Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "CORRUPT", NULL); @@ -3883,7 +3857,7 @@ ZipChannelOpen( goto error; } else if (info->isEncrypted) { unsigned char *ubuf = NULL; - unsigned int j, len; + size_t j, len; /* * Decode encrypted but uncompressed file, since we support @@ -3891,9 +3865,9 @@ ZipChannelOpen( */ len = z->numCompressedBytes - 12; - ubuf = (unsigned char *) attemptckalloc(len); + ubuf = (unsigned char *) Tcl_AttemptAlloc(len); if (ubuf == NULL) { - ckfree((char *) info); + Tcl_Free((char *) info); if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj("out of memory", -1)); @@ -4017,13 +3991,11 @@ ZipFSOpenFileChannelProc( int mode, int permissions) { - int len; - pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr); if (!pathPtr) { return NULL; } - return ZipChannelOpen(interp, Tcl_GetStringFromObj(pathPtr, &len), mode, + return ZipChannelOpen(interp, TclGetString(pathPtr), mode, permissions); } @@ -4049,13 +4021,12 @@ ZipFSStatProc( Tcl_Obj *pathPtr, Tcl_StatBuf *buf) { - int len; pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr); if (!pathPtr) { return -1; } - return ZipEntryStat(Tcl_GetStringFromObj(pathPtr, &len), buf); + return ZipEntryStat(TclGetString(pathPtr), buf); } /* @@ -4080,13 +4051,11 @@ ZipFSAccessProc( Tcl_Obj *pathPtr, int mode) { - int len; - pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr); if (!pathPtr) { return -1; } - return ZipEntryAccess(Tcl_GetStringFromObj(pathPtr, &len), mode); + return ZipEntryAccess(TclGetString(pathPtr), mode); } /* @@ -4145,8 +4114,8 @@ ZipFSMatchInDirectoryProc( Tcl_HashEntry *hPtr; Tcl_HashSearch search; Tcl_Obj *normPathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr); - int scnt, l, dirOnly = -1, prefixLen, strip = 0; - size_t len; + int scnt, l, dirOnly = -1, strip = 0; + size_t len, prefixLen; char *pat, *prefix, *path; Tcl_DString dsPref; @@ -4161,14 +4130,13 @@ ZipFSMatchInDirectoryProc( * The prefix that gets prepended to results. */ - prefix = Tcl_GetStringFromObj(pathPtr, &prefixLen); + prefix = TclGetStringFromObj(pathPtr, &prefixLen); /* * The (normalized) path we're searching. */ - path = Tcl_GetString(normPathPtr); - len = normPathPtr->length; + path = TclGetStringFromObj(normPathPtr, &len); Tcl_DStringInit(&dsPref); Tcl_DStringAppend(&dsPref, prefix, prefixLen); @@ -4267,7 +4235,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; @@ -4299,7 +4267,7 @@ ZipFSMatchInDirectoryProc( } } } - ckfree(pat); + Tcl_Free(pat); end: Unlock(); @@ -4340,13 +4308,11 @@ ZipFSPathInFilesystemProc( return -1; } - path = Tcl_GetString(pathPtr); + path = TclGetStringFromObj(pathPtr, &len); if (strncmp(path, ZIPFS_VOLUME, ZIPFS_VOLUME_LEN) != 0) { return -1; } - len = pathPtr->length; - ReadLock(); hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, path); if (hPtr) { @@ -4466,7 +4432,7 @@ ZipFSFileAttrsGetProc( Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef) { - int len, ret = TCL_OK; + int ret = TCL_OK; char *path; ZipEntry *z; @@ -4474,7 +4440,7 @@ ZipFSFileAttrsGetProc( if (!pathPtr) { return -1; } - path = Tcl_GetStringFromObj(pathPtr, &len); + path = TclGetString(pathPtr); ReadLock(); z = ZipFSLookup(path); if (!z) { @@ -4771,7 +4737,7 @@ TclZipfs_Init( Tcl_NewStringObj("::tcl::zipfs::find", -1)); Tcl_CreateObjCommand(interp, "::tcl::zipfs::tcl_library_init", ZipFSTclLibraryObjCmd, NULL, NULL); - Tcl_PkgProvide(interp, "zipfs", "2.0"); + Tcl_PkgProvideEx(interp, "zipfs", "2.0", NULL); } return TCL_OK; #else /* !HAVE_ZLIB */ diff --git a/generic/tclZlib.c b/generic/tclZlib.c index ea6a1f2..154325a 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 = TclGetStringFromObj(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 = TclGetStringFromObj(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; @@ -593,8 +594,8 @@ SetInflateDictionary( Tcl_Obj *compDictObj) { if (compDictObj != NULL) { - int length; - unsigned char *bytes = Tcl_GetByteArrayFromObj(compDictObj, &length); + size_t length = 0; + unsigned char *bytes = TclGetByteArrayFromObj(compDictObj, &length); return inflateSetDictionary(strm, bytes, length); } @@ -607,8 +608,8 @@ SetDeflateDictionary( Tcl_Obj *compDictObj) { if (compDictObj != NULL) { - int length; - unsigned char *bytes = Tcl_GetByteArrayFromObj(compDictObj, &length); + size_t length = 0; + unsigned char *bytes = TclGetByteArrayFromObj(compDictObj, &length); return deflateSetDictionary(strm, bytes, length); } @@ -619,9 +620,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 +639,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 +701,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 +735,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 +761,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 +861,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 +974,10 @@ ZlibStreamCleanup( Tcl_DecrRefCount(zshPtr->compDictObj); } if (zshPtr->gzHeaderPtr) { - ckfree(zshPtr->gzHeaderPtr); + Tcl_Free(zshPtr->gzHeaderPtr); } - ckfree(zshPtr); + Tcl_Free(zshPtr); } /* @@ -1196,7 +1197,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) { @@ -1245,7 +1247,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 +1281,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 +1290,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 +1323,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, i, listLen; + size_t 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. @@ -1343,7 +1346,7 @@ Tcl_ZlibStreamGet( } 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. @@ -1383,7 +1386,7 @@ Tcl_ZlibStreamGet( if (Tcl_IsShared(itemObj)) { itemObj = Tcl_DuplicateObj(itemObj); } - itemPtr = Tcl_GetByteArrayFromObj(itemObj, &itemLen); + itemPtr = TclGetByteArrayFromObj(itemObj, &itemLen); Tcl_IncrRefCount(itemObj); zshPtr->currentInput = itemObj; zshPtr->stream.next_in = itemPtr; @@ -1455,7 +1458,7 @@ Tcl_ZlibStreamGet( if (Tcl_IsShared(itemObj)) { itemObj = Tcl_DuplicateObj(itemObj); } - itemPtr = Tcl_GetByteArrayFromObj(itemObj, &itemLen); + itemPtr = TclGetByteArrayFromObj(itemObj, &itemLen); Tcl_IncrRefCount(itemObj); zshPtr->currentInput = itemObj; zshPtr->stream.next_in = itemPtr; @@ -1500,11 +1503,11 @@ Tcl_ZlibStreamGet( } } else { Tcl_ListObjLength(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); - (void) Tcl_GetByteArrayFromObj(itemObj, &itemLen); + (void) TclGetByteArrayFromObj(itemObj, &itemLen); if (i == 0) { count += itemLen - zshPtr->outPos; } else { @@ -1529,8 +1532,8 @@ Tcl_ZlibStreamGet( */ Tcl_ListObjIndex(NULL, zshPtr->outData, 0, &itemObj); - itemPtr = Tcl_GetByteArrayFromObj(itemObj, &itemLen); - if (itemLen-zshPtr->outPos >= count-dataPos) { + itemPtr = TclGetByteArrayFromObj(itemObj, &itemLen); + if (itemLen-zshPtr->outPos + dataPos >= count) { size_t len = count - dataPos; memcpy(dataPtr + dataPos, itemPtr + zshPtr->outPos, len); @@ -1576,7 +1579,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; @@ -1642,7 +1646,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 +1731,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; @@ -1775,10 +1780,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 +1805,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 +1888,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 +1898,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 +1920,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 +1930,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 +1952,9 @@ ZlibCmd( int objc, Tcl_Obj *const objv[]) { - int command, dlen, i, option, level = -1; - unsigned start, buffersize = 0; + int command, i, option, level = -1; + size_t dlen = 0, start, buffersize = 0; + Tcl_WideInt wideLen; Byte *data; Tcl_Obj *headerDictObj; const char *extraInfoStr = NULL; @@ -2101,14 +2107,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 +2127,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 +2159,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]; @@ -2771,7 +2780,7 @@ ZlibStreamAddCmd( */ if (compDictObj != NULL) { - int len; + size_t len = 0; if (NULL == TclGetBytesFromObj(interp, compDictObj, &len)) { return TCL_ERROR; @@ -2878,7 +2887,7 @@ ZlibStreamPutCmd( */ if (compDictObj != NULL) { - int len; + size_t len = 0; if (NULL == TclGetBytesFromObj(interp, compDictObj, &len)) { return TCL_ERROR; @@ -2942,7 +2951,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 +3028,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 +3108,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 +3194,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 +3257,8 @@ ZlibTransformFlush( ZlibChannelData *cd, int flushType) { - int e, len; + int e; + size_t len; cd->outStream.avail_in = 0; do { @@ -3462,16 +3474,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 = TclGetStringFromObj(cd->compDictObj, &length); - Tcl_DStringAppend(dsPtr, str, len); + Tcl_DStringAppend(dsPtr, str, length); } return TCL_OK; } @@ -3490,7 +3502,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 +3685,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; @@ -3736,7 +3748,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 +3765,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 +3790,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,7 +3969,7 @@ TclZlibInit( * Formally provide the package as a Tcl built-in. */ - return Tcl_PkgProvide(interp, "zlib", TCL_ZLIB_VERSION); + return Tcl_PkgProvideEx(interp, "zlib", TCL_ZLIB_VERSION, NULL); } /* @@ -4032,7 +4044,7 @@ int Tcl_ZlibStreamGet( Tcl_ZlibStream zshandle, Tcl_Obj *data, - int count) + size_t count) { return TCL_OK; } @@ -4057,7 +4069,7 @@ Tcl_ZlibInflate( Tcl_Interp *interp, int format, Tcl_Obj *data, - int bufferSize, + size_t bufferSize, Tcl_Obj *gzipHeaderDictObj) { if (interp) { @@ -4070,8 +4082,8 @@ Tcl_ZlibInflate( unsigned int Tcl_ZlibCRC32( unsigned int crc, - const char *buf, - int len) + const unsigned char *buf, + size_t len) { return 0; } @@ -4079,8 +4091,8 @@ Tcl_ZlibCRC32( unsigned int Tcl_ZlibAdler32( unsigned int adler, - const char *buf, - int len) + const unsigned char *buf, + size_t len) { return 0; } diff --git a/library/auto.tcl b/library/auto.tcl index 32da97c..41ef1a0 100644 --- a/library/auto.tcl +++ b/library/auto.tcl @@ -265,7 +265,7 @@ proc auto_mkindex {dir args} { auto_mkindex_parser::cleanup set fid [open "tclIndex" w] - fconfigure $fid -translation lf + fconfigure $fid -encoding utf-8 -translation lf puts -nonewline $fid $index close $fid cd $oldDir @@ -292,7 +292,7 @@ proc auto_mkindex_old {dir args} { set f "" set error [catch { set f [open $file] - fconfigure $f -eofchar \032 + fconfigure $f -encoding utf-8 -eofchar \032 while {[gets $f line] >= 0} { if {[regexp {^proc[ ]+([^ ]*)} $line match procName]} { set procName [lindex [auto_qualify $procName "::"] 0] @@ -311,7 +311,7 @@ proc auto_mkindex_old {dir args} { set f "" set error [catch { set f [open tclIndex w] - fconfigure $f -translation lf + fconfigure $f -encoding utf-8 -translation lf puts -nonewline $f $index close $f cd $oldDir @@ -404,7 +404,7 @@ proc auto_mkindex_parser::mkindex {file} { set scriptFile $file set fid [open $file] - fconfigure $fid -eofchar \032 + fconfigure $fid -encoding utf-8 -eofchar \032 set contents [read $fid] close $fid diff --git a/library/cookiejar/cookiejar.tcl b/library/cookiejar/cookiejar.tcl index 6c8e82b..6e0d6c6 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 09dd6a4..f73d9e2 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.7a4 +package require -exact Tcl 9.0a2 # Compute the auto path to use in this interpreter. # The values on the path come from several locations: diff --git a/library/install.tcl b/library/install.tcl index 26e5e68..8d37d78 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 -eofchar \032 + fconfigure $fin -encoding utf-8 -eofchar \032 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 -eofchar \032 + fconfigure $fin -encoding utf-8 -eofchar \032 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 -eofchar \032 + fconfigure $fin -encoding utf-8 -eofchar \032 set dat [read $fin] close $fin set trace 0 diff --git a/library/package.tcl b/library/package.tcl index 64fac7b..ac9a3dc 100644 --- a/library/package.tcl +++ b/library/package.tcl @@ -409,7 +409,7 @@ proc pkg_mkIndex {args} { } set f [open [file join $dir pkgIndex.tcl] w] - fconfigure $f -translation lf + fconfigure $f -encoding utf-8 -translation lf puts $f $index close $f } diff --git a/library/safe.tcl b/library/safe.tcl index 4c0f3b1..7eea772 100644 --- a/library/safe.tcl +++ b/library/safe.tcl @@ -115,7 +115,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} { switch [llength $args] { 1 { 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 3035bc8..cd3071f 100644 --- a/macosx/README +++ b/macosx/README @@ -113,7 +113,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. @@ -134,9 +134,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 39301db..a2ab26e 100644 --- a/macosx/Tcl-Common.xcconfig +++ b/macosx/Tcl-Common.xcconfig @@ -34,4 +34,4 @@ 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.xcode/project.pbxproj b/macosx/Tcl.xcode/project.pbxproj index d7d23fb..8004ffe 100644 --- a/macosx/Tcl.xcode/project.pbxproj +++ b/macosx/Tcl.xcode/project.pbxproj @@ -1331,7 +1331,6 @@ F96D3F3B08F272A8004A47F5 /* dde */, F96D3F8C08F272A8004A47F5 /* history.tcl */, F96D3F8D08F272A8004A47F5 /* http */, - F96D3F9008F272A8004A47F5 /* http1.0 */, F96D3F9308F272A8004A47F5 /* init.tcl */, F96D3F9408F272A8004A47F5 /* msgcat */, F96D401708F272AA004A47F5 /* opt */, @@ -1365,15 +1364,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/Tcl.xcodeproj/project.pbxproj b/macosx/Tcl.xcodeproj/project.pbxproj index 1d200a0..6528616 100644 --- a/macosx/Tcl.xcodeproj/project.pbxproj +++ b/macosx/Tcl.xcodeproj/project.pbxproj @@ -1331,7 +1331,6 @@ F96D3F3B08F272A8004A47F5 /* dde */, F96D3F8C08F272A8004A47F5 /* history.tcl */, F96D3F8D08F272A8004A47F5 /* http */, - F96D3F9008F272A8004A47F5 /* http1.0 */, F96D3F9308F272A8004A47F5 /* init.tcl */, F96D3F9408F272A8004A47F5 /* msgcat */, F96D401708F272AA004A47F5 /* opt */, @@ -1365,15 +1364,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 af15287..09fc4b6 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 52c43e7..70e94b6 100644 --- a/macosx/tclMacOSXFCmd.c +++ b/macosx/tclMacOSXFCmd.c @@ -639,9 +639,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 = TclGetStringFromObj(objPtr, &length); + Tcl_UtfToExternalDString(encoding, string, length, &ds); if (Tcl_DStringLength(&ds) > 4) { if (interp) { @@ -692,7 +693,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 ee271e1..04f6025 100644 --- a/macosx/tclMacOSXNotify.c +++ b/macosx/tclMacOSXNotify.c @@ -1074,7 +1074,7 @@ Tcl_CreateFileHandler( } } if (filePtr == NULL) { - filePtr = (FileHandler *)ckalloc(sizeof(FileHandler)); + filePtr = (FileHandler *)Tcl_Alloc(sizeof(FileHandler)); filePtr->fd = fd; filePtr->readyMask = 0; filePtr->nextPtr = tsdPtr->firstFileHandlerPtr; @@ -1202,7 +1202,7 @@ Tcl_DeleteFileHandler( } else { prevPtr->nextPtr = filePtr->nextPtr; } - ckfree(filePtr); + Tcl_Free(filePtr); } /* @@ -1470,7 +1470,7 @@ QueueFileEvents( */ if (filePtr->readyMask == 0) { - FileHandlerEvent *fileEvPtr = (FileHandlerEvent *)ckalloc(sizeof(FileHandlerEvent)); + FileHandlerEvent *fileEvPtr = (FileHandlerEvent *)Tcl_Alloc(sizeof(FileHandlerEvent)); fileEvPtr->header.proc = FileHandlerEventProc; fileEvPtr->fd = filePtr->fd; diff --git a/tests/assemble.test b/tests/assemble.test index 5d86c47..d417d4b 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 {} { @@ -781,7 +769,7 @@ test assemble-7.43 {uplus} { } } -returnCodes error - -result {can't use non-numeric floating-point value as operand of "+"} + -result {can't use non-numeric floating-point value "NaN" as operand of "+"} } test assemble-7.43.1 {tryCvtToNumeric} { -body { diff --git a/tests/case.test b/tests/case.test deleted file mode 100644 index 87cb2c8..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 (c) 1991-1993 The Regents of the University of California. -# Copyright (c) 1994 Sun Microsystems, Inc. -# Copyright (c) 1998-1999 by Scriptics Corporation. -# -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. - -if {![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/cmdAH.test b/tests/cmdAH.test index 97b2e91..4c9d74d 100644 --- a/tests/cmdAH.test +++ b/tests/cmdAH.test @@ -21,10 +21,6 @@ catch [list package require -exact Tcltest [info patchlevel]] testConstraint testchmod [llength [info commands testchmod]] testConstraint testsetplatform [llength [info commands testsetplatform]] testConstraint testvolumetype [llength [info commands testvolumetype]] -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 @@ -64,8 +60,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?"} @@ -1296,14 +1290,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] diff --git a/tests/compExpr-old.test b/tests/compExpr-old.test index 7a9aa5c..6f43bc2 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 Tcltest [info patchlevel]] # Big test for correct ordering of data in [expr] @@ -280,10 +279,10 @@ test compExpr-old-6.8 {CompileBitXorExpr: error compiling bitxor arm} -body { } -returnCodes error -match glob -result * test compExpr-old-6.9 {CompileBitXorExpr: runtime error in bitxor arm} { list [catch {expr {24.0^3}} msg] $msg -} {1 {can't use floating-point value as operand of "^"}} +} {1 {can't use floating-point value "24.0" as operand of "^"}} test compExpr-old-6.10 {CompileBitXorExpr: runtime error in bitxor arm} { list [catch {expr {"a"^"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "^"}} +} {1 {can't use non-numeric string "a" as operand of "^"}} test compExpr-old-7.1 {CompileBitAndExpr: just equality expr} {expr 3==2} 0 test compExpr-old-7.2 {CompileBitAndExpr: just equality expr} {expr 2.0==2} 1 @@ -304,10 +303,10 @@ test compExpr-old-7.11 {CompileBitAndExpr: error compiling bitand arm} -body { } -returnCodes error -match glob -result * test compExpr-old-7.12 {CompileBitAndExpr: runtime error in bitand arm} { list [catch {expr {24.0&3}} msg] $msg -} {1 {can't use floating-point value as operand of "&"}} +} {1 {can't use floating-point value "24.0" as operand of "&"}} test compExpr-old-7.13 {CompileBitAndExpr: runtime error in bitand arm} { list [catch {expr {"a"&"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "&"}} +} {1 {can't use non-numeric string "a" as operand of "&"}} test compExpr-old-8.1 {CompileEqualityExpr: just relational expr} {expr 3>=2} 1 test compExpr-old-8.2 {CompileEqualityExpr: just relational expr} {expr 2<=2.1} 1 @@ -365,10 +364,10 @@ test compExpr-old-10.9 {CompileShiftExpr: error compiling shift arm} -body { } -returnCodes error -match glob -result * test compExpr-old-10.10 {CompileShiftExpr: runtime error} { list [catch {expr {24.0>>43}} msg] $msg -} {1 {can't use floating-point value as operand of ">>"}} +} {1 {can't use floating-point value "24.0" as operand of ">>"}} test compExpr-old-10.11 {CompileShiftExpr: runtime error} { list [catch {expr {"a"<<"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "<<"}} +} {1 {can't use non-numeric string "a" as operand of "<<"}} test compExpr-old-11.1 {CompileAddExpr: just multiply expr} {expr 4*-2} -8 test compExpr-old-11.2 {CompileAddExpr: just multiply expr} {expr 0xff%2} 1 @@ -387,10 +386,10 @@ test compExpr-old-11.9 {CompileAddExpr: error compiling add arm} -body { } -returnCodes error -match glob -result * test compExpr-old-11.10 {CompileAddExpr: runtime error} { list [catch {expr {24.0+"xx"}} msg] $msg -} {1 {can't use non-numeric string as operand of "+"}} +} {1 {can't use non-numeric string "xx" as operand of "+"}} test compExpr-old-11.11 {CompileAddExpr: runtime error} { list [catch {expr {"a"-"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "-"}} +} {1 {can't use non-numeric string "a" as operand of "-"}} test compExpr-old-11.12 {CompileAddExpr: runtime error} { list [catch {expr {3/0}} msg] $msg } {1 {divide by zero}} @@ -418,10 +417,10 @@ test compExpr-old-12.9 {CompileMultiplyExpr: error compiling multiply arm} -body } -returnCodes error -match glob -result * test compExpr-old-12.10 {CompileMultiplyExpr: runtime error} { list [catch {expr {24.0*"xx"}} msg] $msg -} {1 {can't use non-numeric string as operand of "*"}} +} {1 {can't use non-numeric string "xx" as operand of "*"}} test compExpr-old-12.11 {CompileMultiplyExpr: runtime error} { list [catch {expr {"a"/"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "/"}} +} {1 {can't use non-numeric string "a" as operand of "/"}} test compExpr-old-13.1 {CompileUnaryExpr: unary exprs} {expr -0xff} -255 test compExpr-old-13.2 {CompileUnaryExpr: unary exprs} {expr +0o00123} 83 @@ -439,10 +438,10 @@ test compExpr-old-13.9 {CompileUnaryExpr: error compiling unary expr} -body { } -returnCodes error -match glob -result * test compExpr-old-13.10 {CompileUnaryExpr: runtime error} { list [catch {expr {~"xx"}} msg] $msg -} {1 {can't use non-numeric string as operand of "~"}} +} {1 {can't use non-numeric string "xx" as operand of "~"}} test compExpr-old-13.11 {CompileUnaryExpr: runtime error} { list [catch {expr ~4.0} msg] $msg -} {1 {can't use floating-point value as operand of "~"}} +} {1 {can't use floating-point value "4.0" as operand of "~"}} test compExpr-old-13.12 {CompileUnaryExpr: just primary expr} {expr 0x123} 291 test compExpr-old-13.13 {CompileUnaryExpr: just primary expr} { set a 27 @@ -590,6 +589,7 @@ test compExpr-old-15.5 {CompileMathFuncCall: not enough arguments} -body { test compExpr-old-15.6 {CompileMathFuncCall: missing ')'} -body { expr sin(1 } -returnCodes error -match glob -result * + test compExpr-old-16.1 {GetToken: checks whether integer token starting with "0x" (e.g., "0x$") is invalid} { catch {unset a} set a(VALUE) ff15 diff --git a/tests/compExpr.test b/tests/compExpr.test index 35d7588..b1f69b2 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 Tcltest [info patchlevel]] # Constrain memory leak tests testConstraint memory [llength [info commands memory]] diff --git a/tests/compile.test b/tests/compile.test index ef6ab65..8d10e0a 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 d0ca114..d89d8a3 100644 --- a/tests/encoding.test +++ b/tests/encoding.test @@ -729,7 +729,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 $name $string # discard the cached internal representation of Tcl_Encoding @@ -737,7 +739,7 @@ test encoding-28.0 {all encodings load} -body { llength $name } return $count -} -result [expr {[info exists ::tcl_precision] ? 86 : 85}] +} -result 85 runtests diff --git a/tests/execute.test b/tests/execute.test index daaad16..c7c6e79 100644 --- a/tests/execute.test +++ b/tests/execute.test @@ -179,7 +179,7 @@ test execute-3.5 {TclExecuteByteCode, INST_ADD, op1 is string double} {testobj} test execute-3.6 {TclExecuteByteCode, INST_ADD, op1 is non-numeric} {testobj} { set x [teststringobj set 0 foo] list [catch {expr {$x + 1}} msg] $msg -} {1 {can't use non-numeric string as operand of "+"}} +} {1 {can't use non-numeric string "foo" as operand of "+"}} test execute-3.7 {TclExecuteByteCode, INST_ADD, op2 is int} {testobj} { set x [testintobj set 0 1] expr {1 + $x} @@ -204,7 +204,7 @@ test execute-3.11 {TclExecuteByteCode, INST_ADD, op2 is string double} {testobj} test execute-3.12 {TclExecuteByteCode, INST_ADD, op2 is non-numeric} {testobj} { set x [teststringobj set 0 foo] list [catch {expr {1 + $x}} msg] $msg -} {1 {can't use non-numeric string as operand of "+"}} +} {1 {can't use non-numeric string "foo" as operand of "+"}} # INST_SUB is partially tested: test execute-3.13 {TclExecuteByteCode, INST_SUB, op1 is int} {testobj} { @@ -231,7 +231,7 @@ test execute-3.17 {TclExecuteByteCode, INST_SUB, op1 is string double} {testobj} test execute-3.18 {TclExecuteByteCode, INST_SUB, op1 is non-numeric} {testobj} { set x [teststringobj set 0 foo] list [catch {expr {$x - 1}} msg] $msg -} {1 {can't use non-numeric string as operand of "-"}} +} {1 {can't use non-numeric string "foo" as operand of "-"}} test execute-3.19 {TclExecuteByteCode, INST_SUB, op2 is int} {testobj} { set x [testintobj set 0 1] expr {1 - $x} @@ -256,7 +256,7 @@ test execute-3.23 {TclExecuteByteCode, INST_SUB, op2 is string double} {testobj} test execute-3.24 {TclExecuteByteCode, INST_SUB, op2 is non-numeric} {testobj} { set x [teststringobj set 0 foo] list [catch {expr {1 - $x}} msg] $msg -} {1 {can't use non-numeric string as operand of "-"}} +} {1 {can't use non-numeric string "foo" as operand of "-"}} # INST_MULT is partially tested: test execute-3.25 {TclExecuteByteCode, INST_MULT, op1 is int} {testobj} { @@ -283,7 +283,7 @@ test execute-3.29 {TclExecuteByteCode, INST_MULT, op1 is string double} {testobj test execute-3.30 {TclExecuteByteCode, INST_MULT, op1 is non-numeric} {testobj} { set x [teststringobj set 1 foo] list [catch {expr {$x * 1}} msg] $msg -} {1 {can't use non-numeric string as operand of "*"}} +} {1 {can't use non-numeric string "foo" as operand of "*"}} test execute-3.31 {TclExecuteByteCode, INST_MULT, op2 is int} {testobj} { set x [testintobj set 1 1] expr {1 * $x} @@ -308,7 +308,7 @@ test execute-3.35 {TclExecuteByteCode, INST_MULT, op2 is string double} {testobj test execute-3.36 {TclExecuteByteCode, INST_MULT, op2 is non-numeric} {testobj} { set x [teststringobj set 1 foo] list [catch {expr {1 * $x}} msg] $msg -} {1 {can't use non-numeric string as operand of "*"}} +} {1 {can't use non-numeric string "foo" as operand of "*"}} # INST_DIV is partially tested: test execute-3.37 {TclExecuteByteCode, INST_DIV, op1 is int} {testobj} { @@ -335,7 +335,7 @@ test execute-3.41 {TclExecuteByteCode, INST_DIV, op1 is string double} {testobj} test execute-3.42 {TclExecuteByteCode, INST_DIV, op1 is non-numeric} {testobj} { set x [teststringobj set 1 foo] list [catch {expr {$x / 1}} msg] $msg -} {1 {can't use non-numeric string as operand of "/"}} +} {1 {can't use non-numeric string "foo" as operand of "/"}} test execute-3.43 {TclExecuteByteCode, INST_DIV, op2 is int} {testobj} { set x [testintobj set 1 1] expr {2 / $x} @@ -360,7 +360,7 @@ test execute-3.47 {TclExecuteByteCode, INST_DIV, op2 is string double} {testobj} test execute-3.48 {TclExecuteByteCode, INST_DIV, op2 is non-numeric} {testobj} { set x [teststringobj set 1 foo] list [catch {expr {1 / $x}} msg] $msg -} {1 {can't use non-numeric string as operand of "/"}} +} {1 {can't use non-numeric string "foo" as operand of "/"}} # INST_UPLUS is partially tested: test execute-3.49 {TclExecuteByteCode, INST_UPLUS, op is int} {testobj} { @@ -387,7 +387,7 @@ test execute-3.53 {TclExecuteByteCode, INST_UPLUS, op is string double} {testobj test execute-3.54 {TclExecuteByteCode, INST_UPLUS, op is non-numeric} {testobj} { set x [teststringobj set 1 foo] list [catch {expr {+ $x}} msg] $msg -} {1 {can't use non-numeric string as operand of "+"}} +} {1 {can't use non-numeric string "foo" as operand of "+"}} # INST_UMINUS is partially tested: test execute-3.55 {TclExecuteByteCode, INST_UMINUS, op is int} {testobj} { @@ -414,7 +414,7 @@ test execute-3.59 {TclExecuteByteCode, INST_UMINUS, op is string double} {testob test execute-3.60 {TclExecuteByteCode, INST_UMINUS, op is non-numeric} {testobj} { set x [teststringobj set 1 foo] list [catch {expr {- $x}} msg] $msg -} {1 {can't use non-numeric string as operand of "-"}} +} {1 {can't use non-numeric string "foo" as operand of "-"}} # INST_LNOT is partially tested: test execute-3.61 {TclExecuteByteCode, INST_LNOT, op is int} {testobj} { @@ -462,11 +462,7 @@ test execute-3.70 {TclExecuteByteCode, INST_LNOT, op is string double} {testobj} test execute-3.71 {TclExecuteByteCode, INST_LNOT, op is non-numeric} {testobj} { set x [teststringobj set 1 foo] list [catch {expr {! $x}} msg] $msg -} {1 {can't use non-numeric string as operand of "!"}} - -# INST_BITNOT not tested -# INST_CALL_BUILTIN_FUNC1 not tested -# INST_CALL_FUNC1 not tested +} {1 {can't use non-numeric string "foo" as operand of "!"}} # INST_TRY_CVT_TO_NUMERIC is partially tested: test execute-3.72 {TclExecuteByteCode, INST_TRY_CVT_TO_NUMERIC, op is int} {testobj} { diff --git a/tests/expr-old.test b/tests/expr-old.test index 914530e..7250ab9 100644 --- a/tests/expr-old.test +++ b/tests/expr-old.test @@ -194,34 +194,34 @@ test expr-old-2.38 {floating-point operators} { test expr-old-3.1 {illegal floating-point operations} { list [catch {expr ~4.0} msg] $msg -} {1 {can't use floating-point value as operand of "~"}} +} {1 {can't use floating-point value "4.0" as operand of "~"}} test expr-old-3.2 {illegal floating-point operations} { list [catch {expr 27%4.0} msg] $msg -} {1 {can't use floating-point value as operand of "%"}} +} {1 {can't use floating-point value "4.0" as operand of "%"}} test expr-old-3.3 {illegal floating-point operations} { list [catch {expr 27.0%4} msg] $msg -} {1 {can't use floating-point value as operand of "%"}} +} {1 {can't use floating-point value "27.0" as operand of "%"}} test expr-old-3.4 {illegal floating-point operations} { list [catch {expr 1.0<<3} msg] $msg -} {1 {can't use floating-point value as operand of "<<"}} +} {1 {can't use floating-point value "1.0" as operand of "<<"}} test expr-old-3.5 {illegal floating-point operations} { list [catch {expr 3<<1.0} msg] $msg -} {1 {can't use floating-point value as operand of "<<"}} +} {1 {can't use floating-point value "1.0" as operand of "<<"}} test expr-old-3.6 {illegal floating-point operations} { list [catch {expr 24.0>>3} msg] $msg -} {1 {can't use floating-point value as operand of ">>"}} +} {1 {can't use floating-point value "24.0" as operand of ">>"}} test expr-old-3.7 {illegal floating-point operations} { list [catch {expr 24>>3.0} msg] $msg -} {1 {can't use floating-point value as operand of ">>"}} +} {1 {can't use floating-point value "3.0" as operand of ">>"}} test expr-old-3.8 {illegal floating-point operations} { list [catch {expr 24&3.0} msg] $msg -} {1 {can't use floating-point value as operand of "&"}} +} {1 {can't use floating-point value "3.0" as operand of "&"}} test expr-old-3.9 {illegal floating-point operations} { list [catch {expr 24.0|3} msg] $msg -} {1 {can't use floating-point value as operand of "|"}} +} {1 {can't use floating-point value "24.0" as operand of "|"}} test expr-old-3.10 {illegal floating-point operations} { list [catch {expr 24.0^3} msg] $msg -} {1 {can't use floating-point value as operand of "^"}} +} {1 {can't use floating-point value "24.0" as operand of "^"}} # Check the string operators individually. @@ -262,46 +262,46 @@ test expr-old-4.32 {string operators} {expr {0?"foo":"bar"}} bar test expr-old-5.1 {illegal string operations} { list [catch {expr {-"a"}} msg] $msg -} {1 {can't use non-numeric string as operand of "-"}} +} {1 {can't use non-numeric string "a" as operand of "-"}} test expr-old-5.2 {illegal string operations} { list [catch {expr {+"a"}} msg] $msg -} {1 {can't use non-numeric string as operand of "+"}} +} {1 {can't use non-numeric string "a" as operand of "+"}} test expr-old-5.3 {illegal string operations} { list [catch {expr {~"a"}} msg] $msg -} {1 {can't use non-numeric string as operand of "~"}} +} {1 {can't use non-numeric string "a" as operand of "~"}} test expr-old-5.4 {illegal string operations} { list [catch {expr {!"a"}} msg] $msg -} {1 {can't use non-numeric string as operand of "!"}} +} {1 {can't use non-numeric string "a" as operand of "!"}} test expr-old-5.5 {illegal string operations} { list [catch {expr {"a"*"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "*"}} +} {1 {can't use non-numeric string "a" as operand of "*"}} test expr-old-5.6 {illegal string operations} { list [catch {expr {"a"/"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "/"}} +} {1 {can't use non-numeric string "a" as operand of "/"}} test expr-old-5.7 {illegal string operations} { list [catch {expr {"a"%"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "%"}} +} {1 {can't use non-numeric string "a" as operand of "%"}} test expr-old-5.8 {illegal string operations} { list [catch {expr {"a"+"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "+"}} +} {1 {can't use non-numeric string "a" as operand of "+"}} test expr-old-5.9 {illegal string operations} { list [catch {expr {"a"-"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "-"}} +} {1 {can't use non-numeric string "a" as operand of "-"}} test expr-old-5.10 {illegal string operations} { list [catch {expr {"a"<<"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "<<"}} +} {1 {can't use non-numeric string "a" as operand of "<<"}} test expr-old-5.11 {illegal string operations} { list [catch {expr {"a">>"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of ">>"}} +} {1 {can't use non-numeric string "a" as operand of ">>"}} test expr-old-5.12 {illegal string operations} { list [catch {expr {"a"&"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "&"}} +} {1 {can't use non-numeric string "a" as operand of "&"}} test expr-old-5.13 {illegal string operations} { list [catch {expr {"a"^"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "^"}} +} {1 {can't use non-numeric string "a" as operand of "^"}} test expr-old-5.14 {illegal string operations} { list [catch {expr {"a"|"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "|"}} +} {1 {can't use non-numeric string "a" as operand of "|"}} test expr-old-5.15 {illegal string operations} { list [catch {expr {"a"&&"b"}} msg] $msg } {1 {expected boolean value but got "a"}} @@ -490,7 +490,7 @@ test expr-old-25.20 {type conversions} {expr 10.0} 10.0 test expr-old-26.1 {error conditions} { list [catch {expr 2+"a"} msg] $msg -} {1 {can't use non-numeric string as operand of "+"}} +} {1 {can't use non-numeric string "a" as operand of "+"}} test expr-old-26.2 {error conditions} -body { expr 2+4* } -returnCodes error -match glob -result * @@ -504,10 +504,10 @@ test expr-old-26.4 {error conditions} { set a xx test expr-old-26.5 {error conditions} { list [catch {expr {2+$a}} msg] $msg -} {1 {can't use non-numeric string as operand of "+"}} +} {1 {can't use non-numeric string "xx" as operand of "+"}} test expr-old-26.6 {error conditions} { list [catch {expr {2+[set a]}} msg] $msg -} {1 {can't use non-numeric string as operand of "+"}} +} {1 {can't use non-numeric string "xx" as operand of "+"}} test expr-old-26.7 {error conditions} -body { expr {2+(4} } -returnCodes error -match glob -result * @@ -531,7 +531,7 @@ test expr-old-26.12 {error conditions} -body { } -returnCodes error -match glob -result * test expr-old-26.13 {error conditions} { list [catch {expr {"a"/"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "/"}} +} {1 {can't use non-numeric string "a" as operand of "/"}} test expr-old-26.14 {error conditions} -body { expr 2:3 } -returnCodes error -match glob -result * @@ -943,13 +943,14 @@ test expr-old-34.15 {errors in math functions} { test expr-old-34.16 {errors in math functions} { expr round(-1.0e30) } -1000000000000000019884624838656 + test expr-old-36.1 {ExprLooksLikeInt procedure} -body { expr 0o289 } -returnCodes error -match glob -result {*invalid octal number*} test expr-old-36.2 {ExprLooksLikeInt procedure} { set x 0o289 list [catch {expr {$x+1}} msg] $msg -} {1 {can't use invalid octal number as operand of "+"}} +} {1 {can't use non-numeric string "0o289" as operand of "+"}} test expr-old-36.3 {ExprLooksLikeInt procedure} { list [catch {expr 0289.1} msg] $msg } {0 289.1} @@ -989,11 +990,11 @@ test expr-old-36.11 {ExprLooksLikeInt procedure} { test expr-old-36.12 {ExprLooksLikeInt procedure} { set x "10;" list [catch {expr {$x+1}} msg] $msg -} {1 {can't use non-numeric string as operand of "+"}} +} {1 {can't use non-numeric string "10;" as operand of "+"}} test expr-old-36.13 {ExprLooksLikeInt procedure} { set x " +" list [catch {expr {$x+1}} msg] $msg -} {1 {can't use non-numeric string as operand of "+"}} +} {1 {can't use non-numeric string " +" as operand of "+"}} test expr-old-36.14 {ExprLooksLikeInt procedure} { set x "123456789012345678901234567890 " expr {$x+1} @@ -1001,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 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 5e00841..e8116d6 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 Tcltest [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. @@ -252,7 +251,7 @@ test expr-4.9 {CompileLorExpr: long lor arm} { } 1 test expr-4.10 {CompileLorExpr: error compiling ! operand} { list [catch {expr {!"a"}} msg] $msg -} {1 {can't use non-numeric string as operand of "!"}} +} {1 {can't use non-numeric string "a" as operand of "!"}} test expr-4.11 {CompileLorExpr: error compiling land arms} { list [catch {expr {"a"||0}} msg] $msg } {1 {expected boolean value but got "a"}} @@ -299,10 +298,10 @@ test expr-6.8 {CompileBitXorExpr: error compiling bitxor arm} -body { } -returnCodes error -match glob -result * test expr-6.9 {CompileBitXorExpr: runtime error in bitxor arm} { list [catch {expr {24.0^3}} msg] $msg -} {1 {can't use floating-point value as operand of "^"}} +} {1 {can't use floating-point value "24.0" as operand of "^"}} test expr-6.10 {CompileBitXorExpr: runtime error in bitxor arm} { list [catch {expr {"a"^"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "^"}} +} {1 {can't use non-numeric string "a" as operand of "^"}} test expr-7.1 {CompileBitAndExpr: just equality expr} {expr 3==2} 0 test expr-7.2 {CompileBitAndExpr: just equality expr} {expr 2.0==2} 1 @@ -323,10 +322,10 @@ test expr-7.11 {CompileBitAndExpr: error compiling bitand arm} -body { } -returnCodes error -match glob -result * test expr-7.12 {CompileBitAndExpr: runtime error in bitand arm} { list [catch {expr {24.0&3}} msg] $msg -} {1 {can't use floating-point value as operand of "&"}} +} {1 {can't use floating-point value "24.0" as operand of "&"}} test expr-7.13 {CompileBitAndExpr: runtime error in bitand arm} { list [catch {expr {"a"&"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "&"}} +} {1 {can't use non-numeric string "a" as operand of "&"}} test expr-7.14 {CompileBitAndExpr: equality expr} {expr 3eq2} 0 test expr-7.18 {CompileBitAndExpr: equality expr} {expr {"abc" eq "abd"}} 0 test expr-7.20 {CompileBitAndExpr: error in equality expr} -body { @@ -468,10 +467,10 @@ test expr-10.9 {CompileShiftExpr: error compiling shift arm} -body { } -returnCodes error -match glob -result * test expr-10.10 {CompileShiftExpr: runtime error} { list [catch {expr {24.0>>43}} msg] $msg -} {1 {can't use floating-point value as operand of ">>"}} +} {1 {can't use floating-point value "24.0" as operand of ">>"}} test expr-10.11 {CompileShiftExpr: runtime error} { list [catch {expr {"a"<<"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "<<"}} +} {1 {can't use non-numeric string "a" as operand of "<<"}} test expr-11.1 {CompileAddExpr: just multiply expr} {expr 4*-2} -8 test expr-11.2 {CompileAddExpr: just multiply expr} {expr 0xff%2} 1 @@ -490,10 +489,10 @@ test expr-11.9 {CompileAddExpr: error compiling add arm} -body { } -returnCodes error -match glob -result * test expr-11.10 {CompileAddExpr: runtime error} { list [catch {expr {24.0+"xx"}} msg] $msg -} {1 {can't use non-numeric string as operand of "+"}} +} {1 {can't use non-numeric string "xx" as operand of "+"}} test expr-11.11 {CompileAddExpr: runtime error} { list [catch {expr {"a"-"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "-"}} +} {1 {can't use non-numeric string "a" as operand of "-"}} test expr-11.12 {CompileAddExpr: runtime error} { list [catch {expr {3/0}} msg] $msg } {1 {divide by zero}} @@ -521,10 +520,10 @@ test expr-12.9 {CompileMultiplyExpr: error compiling multiply arm} -body { } -returnCodes error -match glob -result * test expr-12.10 {CompileMultiplyExpr: runtime error} { list [catch {expr {24.0*"xx"}} msg] $msg -} {1 {can't use non-numeric string as operand of "*"}} +} {1 {can't use non-numeric string "xx" as operand of "*"}} test expr-12.11 {CompileMultiplyExpr: runtime error} { list [catch {expr {"a"/"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "/"}} +} {1 {can't use non-numeric string "a" as operand of "/"}} test expr-13.1 {CompileUnaryExpr: unary exprs} {expr -0xff} -255 test expr-13.2 {CompileUnaryExpr: unary exprs} {expr +0o00123} 83 @@ -541,10 +540,10 @@ test expr-13.9 {CompileUnaryExpr: error compiling unary expr} -body { } -returnCodes error -match glob -result * test expr-13.10 {CompileUnaryExpr: runtime error} { list [catch {expr {~"xx"}} msg] $msg -} {1 {can't use non-numeric string as operand of "~"}} +} {1 {can't use non-numeric string "xx" as operand of "~"}} test expr-13.11 {CompileUnaryExpr: runtime error} { list [catch {expr ~4.0} msg] $msg -} {1 {can't use floating-point value as operand of "~"}} +} {1 {can't use floating-point value "4.0" as operand of "~"}} test expr-13.12 {CompileUnaryExpr: just primary expr} {expr 0x123} 291 test expr-13.13 {CompileUnaryExpr: just primary expr} { set a 27 @@ -821,15 +820,15 @@ test expr-21.13 {non-numeric boolean literals} -body { } -returnCodes error -match glob -result * test expr-21.14 {non-numeric boolean literals} { list [catch {expr !"truef"} err] $err -} {1 {can't use non-numeric string as operand of "!"}} +} {1 {can't use non-numeric string "truef" as operand of "!"}} test expr-21.15 {non-numeric boolean variables} { set v truef list [catch {expr {!$v}} err] $err -} {1 {can't use non-numeric string as operand of "!"}} +} {1 {can't use non-numeric string "truef" as operand of "!"}} test expr-21.16 {non-numeric boolean variables} { set v "true " list [catch {expr {!$v}} err] $err -} {1 {can't use non-numeric string as operand of "!"}} +} {1 {can't use non-numeric string "true " as operand of "!"}} test expr-21.17 {non-numeric boolean variables} { set v "tru" list [catch {expr {!$v}} err] $err @@ -849,23 +848,23 @@ test expr-21.20 {non-numeric boolean variables} { test expr-21.21 {non-numeric boolean variables} { set v "o" list [catch {expr {!$v}} err] $err -} {1 {can't use non-numeric string as operand of "!"}} +} {1 {can't use non-numeric string "o" as operand of "!"}} test expr-21.22 {non-numeric boolean variables} { set v "" list [catch {expr {!$v}} err] $err -} {1 {can't use empty string as operand of "!"}} +} {1 {can't use non-numeric string "" as operand of "!"}} # Test for non-numeric float handling. test expr-22.1 {non-numeric floats} { list [catch {expr {NaN + 1}} msg] $msg -} {1 {can't use non-numeric floating-point value as operand of "+"}} +} {1 {can't use non-numeric floating-point value "NaN" as operand of "+"}} test expr-22.2 {non-numeric floats} !ieeeFloatingPoint { list [catch {expr {Inf + 1}} msg] $msg } {1 {can't use infinite floating-point value as operand of "+"}} test expr-22.3 {non-numeric floats} { set nan NaN list [catch {expr {$nan + 1}} msg] $msg -} {1 {can't use non-numeric floating-point value as operand of "+"}} +} {1 {can't use non-numeric floating-point value "NaN" as operand of "+"}} test expr-22.4 {non-numeric floats} !ieeeFloatingPoint { set inf Inf list [catch {expr {$inf + 1}} msg] $msg @@ -878,7 +877,7 @@ test expr-22.6 {non-numeric floats} !ieeeFloatingPoint { } {1 {floating-point value too large to represent}} test expr-22.7 {non-numeric floats} { list [catch {expr {1 / NaN}} msg] $msg -} {1 {can't use non-numeric floating-point value as operand of "/"}} +} {1 {can't use non-numeric floating-point value "NaN" as operand of "/"}} test expr-22.8 {non-numeric floats} !ieeeFloatingPoint { list [catch {expr {1 / Inf}} msg] $msg } {1 {can't use infinite floating-point value as operand of "/"}} @@ -914,10 +913,10 @@ test expr-23.8 {CompileExponentialExpr: error compiling expo arm} -body { } -returnCodes error -match glob -result * test expr-23.9 {CompileExponentialExpr: runtime error} { list [catch {expr {24.0**"xx"}} msg] $msg -} {1 {can't use non-numeric string as operand of "**"}} +} {1 {can't use non-numeric string "xx" as operand of "**"}} test expr-23.10 {CompileExponentialExpr: runtime error} { list [catch {expr {"a"**2}} msg] $msg -} {1 {can't use non-numeric string as operand of "**"}} +} {1 {can't use non-numeric string "a" as operand of "**"}} test expr-23.11 {CompileExponentialExpr: runtime error} { list [catch {expr {0**-1}} msg] $msg } {1 {exponentiation of zero by negative power}} diff --git a/tests/format.test b/tests/format.test index 8d6fd82..a90f10d 100644 --- a/tests/format.test +++ b/tests/format.test @@ -80,13 +80,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 9e7728a..54169c2 100644 --- a/tests/get.test +++ b/tests/get.test @@ -98,17 +98,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 " " 0_07 " " 0o_1_0 " " 0_b1_0 " _33 42_ 0_x15 0_o17 0_d19 } { catch {testgetint $x} x diff --git a/tests/lindex.test b/tests/lindex.test index f9397d2..32a30b2 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/mathop.test b/tests/mathop.test index ae0fdd5..3393247 100644 --- a/tests/mathop.test +++ b/tests/mathop.test @@ -114,22 +114,22 @@ namespace eval ::testmathop { test mathop-1.10 {compiled +} { + 1 2 3000000000000000000000 } 3000000000000000000003 test mathop-1.11 {compiled +: errors} -returnCodes error -body { + x 0 - } -result {can't use non-numeric string as operand of "+"} + } -result {can't use non-numeric string "x" as operand of "+"} test mathop-1.12 {compiled +: errors} -returnCodes error -body { + nan 0 - } -result {can't use non-numeric floating-point value as operand of "+"} + } -result {can't use non-numeric floating-point value "nan" as operand of "+"} test mathop-1.13 {compiled +: errors} -returnCodes error -body { + 0 x - } -result {can't use non-numeric string as operand of "+"} + } -result {can't use non-numeric string "x" as operand of "+"} test mathop-1.14 {compiled +: errors} -returnCodes error -body { + 0 nan - } -result {can't use non-numeric floating-point value as operand of "+"} + } -result {can't use non-numeric floating-point value "nan" as operand of "+"} test mathop-1.15 {compiled +: errors} -returnCodes error -body { + 0o8 0 - } -result {can't use invalid octal number as operand of "+"} + } -result {can't use non-numeric string "0o8" as operand of "+"} test mathop-1.16 {compiled +: errors} -returnCodes error -body { + 0 0o8 - } -result {can't use invalid octal number as operand of "+"} + } -result {can't use non-numeric string "0o8" as operand of "+"} test mathop-1.17 {compiled +: errors} -returnCodes error -body { + 0 [error expectedError] } -result expectedError @@ -152,22 +152,22 @@ namespace eval ::testmathop { test mathop-1.28 {interpreted +} { $op 1 2 3000000000000000000000 } 3000000000000000000003 test mathop-1.29 {interpreted +: errors} -returnCodes error -body { $op x 0 - } -result {can't use non-numeric string as operand of "+"} + } -result {can't use non-numeric string "x" as operand of "+"} test mathop-1.30 {interpreted +: errors} -returnCodes error -body { $op nan 0 - } -result {can't use non-numeric floating-point value as operand of "+"} + } -result {can't use non-numeric floating-point value "nan" as operand of "+"} test mathop-1.31 {interpreted +: errors} -returnCodes error -body { $op 0 x - } -result {can't use non-numeric string as operand of "+"} + } -result {can't use non-numeric string "x" as operand of "+"} test mathop-1.32 {interpreted +: errors} -returnCodes error -body { $op 0 nan - } -result {can't use non-numeric floating-point value as operand of "+"} + } -result {can't use non-numeric floating-point value "nan" as operand of "+"} test mathop-1.33 {interpreted +: errors} -returnCodes error -body { $op 0o8 0 - } -result {can't use invalid octal number as operand of "+"} + } -result {can't use non-numeric string "0o8" as operand of "+"} test mathop-1.34 {interpreted +: errors} -returnCodes error -body { $op 0 0o8 - } -result {can't use invalid octal number as operand of "+"} + } -result {can't use non-numeric string "0o8" as operand of "+"} test mathop-1.35 {interpreted +: errors} -returnCodes error -body { $op 0 [error expectedError] } -result expectedError @@ -189,22 +189,22 @@ namespace eval ::testmathop { test mathop-2.10 {compiled *} { * 1 2 3000000000000000000000 } 6000000000000000000000 test mathop-2.11 {compiled *: errors} -returnCodes error -body { * x 0 - } -result {can't use non-numeric string as operand of "*"} + } -result {can't use non-numeric string "x" as operand of "*"} test mathop-2.12 {compiled *: errors} -returnCodes error -body { * nan 0 - } -result {can't use non-numeric floating-point value as operand of "*"} + } -result {can't use non-numeric floating-point value "nan" as operand of "*"} test mathop-2.13 {compiled *: errors} -returnCodes error -body { * 0 x - } -result {can't use non-numeric string as operand of "*"} + } -result {can't use non-numeric string "x" as operand of "*"} test mathop-2.14 {compiled *: errors} -returnCodes error -body { * 0 nan - } -result {can't use non-numeric floating-point value as operand of "*"} + } -result {can't use non-numeric floating-point value "nan" as operand of "*"} test mathop-2.15 {compiled *: errors} -returnCodes error -body { * 0o8 0 - } -result {can't use invalid octal number as operand of "*"} + } -result {can't use non-numeric string "0o8" as operand of "*"} test mathop-2.16 {compiled *: errors} -returnCodes error -body { * 0 0o8 - } -result {can't use invalid octal number as operand of "*"} + } -result {can't use non-numeric string "0o8" as operand of "*"} test mathop-2.17 {compiled *: errors} -returnCodes error -body { * 0 [error expectedError] } -result expectedError @@ -227,22 +227,22 @@ namespace eval ::testmathop { test mathop-2.28 {interpreted *} { $op 1 2 3000000000000000000000 } 6000000000000000000000 test mathop-2.29 {interpreted *: errors} -returnCodes error -body { $op x 0 - } -result {can't use non-numeric string as operand of "*"} + } -result {can't use non-numeric string "x" as operand of "*"} test mathop-2.30 {interpreted *: errors} -returnCodes error -body { $op nan 0 - } -result {can't use non-numeric floating-point value as operand of "*"} + } -result {can't use non-numeric floating-point value "nan" as operand of "*"} test mathop-2.31 {interpreted *: errors} -returnCodes error -body { $op 0 x - } -result {can't use non-numeric string as operand of "*"} + } -result {can't use non-numeric string "x" as operand of "*"} test mathop-2.32 {interpreted *: errors} -returnCodes error -body { $op 0 nan - } -result {can't use non-numeric floating-point value as operand of "*"} + } -result {can't use non-numeric floating-point value "nan" as operand of "*"} test mathop-2.33 {interpreted *: errors} -returnCodes error -body { $op 0o8 0 - } -result {can't use invalid octal number as operand of "*"} + } -result {can't use non-numeric string "0o8" as operand of "*"} test mathop-2.34 {interpreted *: errors} -returnCodes error -body { $op 0 0o8 - } -result {can't use invalid octal number as operand of "*"} + } -result {can't use non-numeric string "0o8" as operand of "*"} test mathop-2.35 {interpreted *: errors} -returnCodes error -body { $op 0 [error expectedError] } -result expectedError @@ -261,7 +261,7 @@ namespace eval ::testmathop { test mathop-3.7 {compiled !} {! 10000000000000000000000000} 0 test mathop-3.8 {compiled !: errors} -body { ! foobar - } -returnCodes error -result {can't use non-numeric string as operand of "!"} + } -returnCodes error -result {can't use non-numeric string "foobar" as operand of "!"} test mathop-3.9 {compiled !: errors} -body { ! 0 0 } -returnCodes error -result "wrong # args: should be \"! boolean\"" @@ -278,7 +278,7 @@ namespace eval ::testmathop { test mathop-3.17 {interpreted !} {$op 10000000000000000000000000} 0 test mathop-3.18 {interpreted !: errors} -body { $op foobar - } -returnCodes error -result {can't use non-numeric string as operand of "!"} + } -returnCodes error -result {can't use non-numeric string "foobar" as operand of "!"} test mathop-3.19 {interpreted !: errors} -body { $op 0 0 } -returnCodes error -result "wrong # args: should be \"! boolean\"" @@ -287,10 +287,10 @@ namespace eval ::testmathop { } -returnCodes error -result "wrong # args: should be \"! boolean\"" test mathop-3.21 {compiled !: error} -returnCodes error -body { ! NaN - } -result {can't use non-numeric floating-point value as operand of "!"} + } -result {can't use non-numeric floating-point value "NaN" as operand of "!"} test mathop-3.22 {interpreted !: error} -returnCodes error -body { $op NaN - } -result {can't use non-numeric floating-point value as operand of "!"} + } -result {can't use non-numeric floating-point value "NaN" as operand of "!"} test mathop-4.1 {compiled ~} {~ 0} -1 test mathop-4.2 {compiled ~} {~ 1} -2 @@ -301,7 +301,7 @@ namespace eval ::testmathop { test mathop-4.7 {compiled ~} {~ 10000000000000000000000000} -10000000000000000000000001 test mathop-4.8 {compiled ~: errors} -body { ~ foobar - } -returnCodes error -result {can't use non-numeric string as operand of "~"} + } -returnCodes error -result {can't use non-numeric string "foobar" as operand of "~"} test mathop-4.9 {compiled ~: errors} -body { ~ 0 0 } -returnCodes error -result "wrong # args: should be \"~ integer\"" @@ -310,10 +310,10 @@ namespace eval ::testmathop { } -returnCodes error -result "wrong # args: should be \"~ integer\"" test mathop-4.11 {compiled ~: errors} -returnCodes error -body { ~ 0.0 - } -result {can't use floating-point value as operand of "~"} + } -result {can't use floating-point value "0.0" as operand of "~"} test mathop-4.12 {compiled ~: errors} -returnCodes error -body { ~ NaN - } -result {can't use non-numeric floating-point value as operand of "~"} + } -result {can't use non-numeric floating-point value "NaN" as operand of "~"} set op ~ test mathop-4.13 {interpreted ~} {$op 0} -1 test mathop-4.14 {interpreted ~} {$op 1} -2 @@ -324,7 +324,7 @@ namespace eval ::testmathop { test mathop-4.19 {interpreted ~} {$op 10000000000000000000000000} -10000000000000000000000001 test mathop-4.20 {interpreted ~: errors} -body { $op foobar - } -returnCodes error -result {can't use non-numeric string as operand of "~"} + } -returnCodes error -result {can't use non-numeric string "foobar" as operand of "~"} test mathop-4.21 {interpreted ~: errors} -body { $op 0 0 } -returnCodes error -result "wrong # args: should be \"~ integer\"" @@ -333,10 +333,10 @@ namespace eval ::testmathop { } -returnCodes error -result "wrong # args: should be \"~ integer\"" test mathop-4.23 {interpreted ~: errors} -returnCodes error -body { $op 0.0 - } -result {can't use floating-point value as operand of "~"} + } -result {can't use floating-point value "0.0" as operand of "~"} test mathop-4.24 {interpreted ~: errors} -returnCodes error -body { $op NaN - } -result {can't use non-numeric floating-point value as operand of "~"} + } -result {can't use non-numeric floating-point value "NaN" as operand of "~"} test mathop-5.1 {compiled eq} {eq {} a} 0 test mathop-5.2 {compiled eq} {eq a a} 1 @@ -377,32 +377,32 @@ namespace eval ::testmathop { test mathop-6.4 {compiled &} { & 3 7 6 } 2 test mathop-6.5 {compiled &} -returnCodes error -body { & 1.0 2 3 - } -result {can't use floating-point value as operand of "&"} + } -result {can't use floating-point value "1.0" as operand of "&"} test mathop-6.6 {compiled &} -returnCodes error -body { & 1 2 3.0 - } -result {can't use floating-point value as operand of "&"} + } -result {can't use floating-point value "3.0" as operand of "&"} test mathop-6.7 {compiled &} { & 100000000002 18 -126 } 2 test mathop-6.8 {compiled &} { & 0xff 0o377 333333333333 } 85 test mathop-6.9 {compiled &} { & 1000000000000000000002 18 -126 } 2 test mathop-6.10 {compiled &} { & 0xff 0o377 3333333333333333333333 } 85 test mathop-6.11 {compiled &: errors} -returnCodes error -body { & x 0 - } -result {can't use non-numeric string as operand of "&"} + } -result {can't use non-numeric string "x" as operand of "&"} test mathop-6.12 {compiled &: errors} -returnCodes error -body { & nan 0 - } -result {can't use non-numeric floating-point value as operand of "&"} + } -result {can't use non-numeric floating-point value "nan" as operand of "&"} test mathop-6.13 {compiled &: errors} -returnCodes error -body { & 0 x - } -result {can't use non-numeric string as operand of "&"} + } -result {can't use non-numeric string "x" as operand of "&"} test mathop-6.14 {compiled &: errors} -returnCodes error -body { & 0 nan - } -result {can't use non-numeric floating-point value as operand of "&"} + } -result {can't use non-numeric floating-point value "nan" as operand of "&"} test mathop-6.15 {compiled &: errors} -returnCodes error -body { & 0o8 0 - } -result {can't use invalid octal number as operand of "&"} + } -result {can't use non-numeric string "0o8" as operand of "&"} test mathop-6.16 {compiled &: errors} -returnCodes error -body { & 0 0o8 - } -result {can't use invalid octal number as operand of "&"} + } -result {can't use non-numeric string "0o8" as operand of "&"} test mathop-6.17 {compiled &: errors} -returnCodes error -body { & 0 [error expectedError] } -result expectedError @@ -419,32 +419,32 @@ namespace eval ::testmathop { test mathop-6.22 {interpreted &} { $op 3 7 6 } 2 test mathop-6.23 {interpreted &} -returnCodes error -body { $op 1.0 2 3 - } -result {can't use floating-point value as operand of "&"} + } -result {can't use floating-point value "1.0" as operand of "&"} test mathop-6.24 {interpreted &} -returnCodes error -body { $op 1 2 3.0 - } -result {can't use floating-point value as operand of "&"} + } -result {can't use floating-point value "3.0" as operand of "&"} test mathop-6.25 {interpreted &} { $op 100000000002 18 -126 } 2 test mathop-6.26 {interpreted &} { $op 0xff 0o377 333333333333 } 85 test mathop-6.27 {interpreted &} { $op 1000000000000000000002 18 -126 } 2 test mathop-6.28 {interpreted &} { $op 0xff 0o377 3333333333333333333333 } 85 test mathop-6.29 {interpreted &: errors} -returnCodes error -body { $op x 0 - } -result {can't use non-numeric string as operand of "&"} + } -result {can't use non-numeric string "x" as operand of "&"} test mathop-6.30 {interpreted &: errors} -returnCodes error -body { $op nan 0 - } -result {can't use non-numeric floating-point value as operand of "&"} + } -result {can't use non-numeric floating-point value "nan" as operand of "&"} test mathop-6.31 {interpreted &: errors} -returnCodes error -body { $op 0 x - } -result {can't use non-numeric string as operand of "&"} + } -result {can't use non-numeric string "x" as operand of "&"} test mathop-6.32 {interpreted &: errors} -returnCodes error -body { $op 0 nan - } -result {can't use non-numeric floating-point value as operand of "&"} + } -result {can't use non-numeric floating-point value "nan" as operand of "&"} test mathop-6.33 {interpreted &: errors} -returnCodes error -body { $op 0o8 0 - } -result {can't use invalid octal number as operand of "&"} + } -result {can't use non-numeric string "0o8" as operand of "&"} test mathop-6.34 {interpreted &: errors} -returnCodes error -body { $op 0 0o8 - } -result {can't use invalid octal number as operand of "&"} + } -result {can't use non-numeric string "0o8" as operand of "&"} test mathop-6.35 {interpreted &: errors} -returnCodes error -body { $op 0 [error expectedError] } -result expectedError @@ -487,32 +487,32 @@ namespace eval ::testmathop { test mathop-7.4 {compiled |} { | 3 7 6 } 7 test mathop-7.5 {compiled |} -returnCodes error -body { | 1.0 2 3 - } -result {can't use floating-point value as operand of "|"} + } -result {can't use floating-point value "1.0" as operand of "|"} test mathop-7.6 {compiled |} -returnCodes error -body { | 1 2 3.0 - } -result {can't use floating-point value as operand of "|"} + } -result {can't use floating-point value "3.0" as operand of "|"} test mathop-7.7 {compiled |} { | 100000000002 18 -126 } -110 test mathop-7.8 {compiled |} { | 0xff 0o377 333333333333 } 333333333503 test mathop-7.9 {compiled |} { | 1000000000000000000002 18 -126 } -110 test mathop-7.10 {compiled |} { | 0xff 0o377 3333333333333333333333 } 3333333333333333333503 test mathop-7.11 {compiled |: errors} -returnCodes error -body { | x 0 - } -result {can't use non-numeric string as operand of "|"} + } -result {can't use non-numeric string "x" as operand of "|"} test mathop-7.12 {compiled |: errors} -returnCodes error -body { | nan 0 - } -result {can't use non-numeric floating-point value as operand of "|"} + } -result {can't use non-numeric floating-point value "nan" as operand of "|"} test mathop-7.13 {compiled |: errors} -returnCodes error -body { | 0 x - } -result {can't use non-numeric string as operand of "|"} + } -result {can't use non-numeric string "x" as operand of "|"} test mathop-7.14 {compiled |: errors} -returnCodes error -body { | 0 nan - } -result {can't use non-numeric floating-point value as operand of "|"} + } -result {can't use non-numeric floating-point value "nan" as operand of "|"} test mathop-7.15 {compiled |: errors} -returnCodes error -body { | 0o8 0 - } -result {can't use invalid octal number as operand of "|"} + } -result {can't use non-numeric string "0o8" as operand of "|"} test mathop-7.16 {compiled |: errors} -returnCodes error -body { | 0 0o8 - } -result {can't use invalid octal number as operand of "|"} + } -result {can't use non-numeric string "0o8" as operand of "|"} test mathop-7.17 {compiled |: errors} -returnCodes error -body { | 0 [error expectedError] } -result expectedError @@ -529,32 +529,32 @@ namespace eval ::testmathop { test mathop-7.22 {interpreted |} { $op 3 7 6 } 7 test mathop-7.23 {interpreted |} -returnCodes error -body { $op 1.0 2 3 - } -result {can't use floating-point value as operand of "|"} + } -result {can't use floating-point value "1.0" as operand of "|"} test mathop-7.24 {interpreted |} -returnCodes error -body { $op 1 2 3.0 - } -result {can't use floating-point value as operand of "|"} + } -result {can't use floating-point value "3.0" as operand of "|"} test mathop-7.25 {interpreted |} { $op 100000000002 18 -126 } -110 test mathop-7.26 {interpreted |} { $op 0xff 0o377 333333333333 } 333333333503 test mathop-7.27 {interpreted |} { $op 1000000000000000000002 18 -126 } -110 test mathop-7.28 {interpreted |} { $op 0xff 0o377 3333333333333333333333 } 3333333333333333333503 test mathop-7.29 {interpreted |: errors} -returnCodes error -body { $op x 0 - } -result {can't use non-numeric string as operand of "|"} + } -result {can't use non-numeric string "x" as operand of "|"} test mathop-7.30 {interpreted |: errors} -returnCodes error -body { $op nan 0 - } -result {can't use non-numeric floating-point value as operand of "|"} + } -result {can't use non-numeric floating-point value "nan" as operand of "|"} test mathop-7.31 {interpreted |: errors} -returnCodes error -body { $op 0 x - } -result {can't use non-numeric string as operand of "|"} + } -result {can't use non-numeric string "x" as operand of "|"} test mathop-7.32 {interpreted |: errors} -returnCodes error -body { $op 0 nan - } -result {can't use non-numeric floating-point value as operand of "|"} + } -result {can't use non-numeric floating-point value "nan" as operand of "|"} test mathop-7.33 {interpreted |: errors} -returnCodes error -body { $op 0o8 0 - } -result {can't use invalid octal number as operand of "|"} + } -result {can't use non-numeric string "0o8" as operand of "|"} test mathop-7.34 {interpreted |: errors} -returnCodes error -body { $op 0 0o8 - } -result {can't use invalid octal number as operand of "|"} + } -result {can't use non-numeric string "0o8" as operand of "|"} test mathop-7.35 {interpreted |: errors} -returnCodes error -body { $op 0 [error expectedError] } -result expectedError @@ -597,32 +597,32 @@ namespace eval ::testmathop { test mathop-8.4 {compiled ^} { ^ 3 7 6 } 2 test mathop-8.5 {compiled ^} -returnCodes error -body { ^ 1.0 2 3 - } -result {can't use floating-point value as operand of "^"} + } -result {can't use floating-point value "1.0" as operand of "^"} test mathop-8.6 {compiled ^} -returnCodes error -body { ^ 1 2 3.0 - } -result {can't use floating-point value as operand of "^"} + } -result {can't use floating-point value "3.0" as operand of "^"} test mathop-8.7 {compiled ^} { ^ 100000000002 18 -126 } -100000000110 test mathop-8.8 {compiled ^} { ^ 0xff 0o377 333333333333 } 333333333333 test mathop-8.9 {compiled ^} { ^ 1000000000000000000002 18 -126 } -1000000000000000000110 test mathop-8.10 {compiled ^} { ^ 0xff 0o377 3333333333333333333333 } 3333333333333333333333 test mathop-8.11 {compiled ^: errors} -returnCodes error -body { ^ x 0 - } -result {can't use non-numeric string as operand of "^"} + } -result {can't use non-numeric string "x" as operand of "^"} test mathop-8.12 {compiled ^: errors} -returnCodes error -body { ^ nan 0 - } -result {can't use non-numeric floating-point value as operand of "^"} + } -result {can't use non-numeric floating-point value "nan" as operand of "^"} test mathop-8.13 {compiled ^: errors} -returnCodes error -body { ^ 0 x - } -result {can't use non-numeric string as operand of "^"} + } -result {can't use non-numeric string "x" as operand of "^"} test mathop-8.14 {compiled ^: errors} -returnCodes error -body { ^ 0 nan - } -result {can't use non-numeric floating-point value as operand of "^"} + } -result {can't use non-numeric floating-point value "nan" as operand of "^"} test mathop-8.15 {compiled ^: errors} -returnCodes error -body { ^ 0o8 0 - } -result {can't use invalid octal number as operand of "^"} + } -result {can't use non-numeric string "0o8" as operand of "^"} test mathop-8.16 {compiled ^: errors} -returnCodes error -body { ^ 0 0o8 - } -result {can't use invalid octal number as operand of "^"} + } -result {can't use non-numeric string "0o8" as operand of "^"} test mathop-8.17 {compiled ^: errors} -returnCodes error -body { ^ 0 [error expectedError] } -result expectedError @@ -639,32 +639,32 @@ namespace eval ::testmathop { test mathop-8.22 {interpreted ^} { $op 3 7 6 } 2 test mathop-8.23 {interpreted ^} -returnCodes error -body { $op 1.0 2 3 - } -result {can't use floating-point value as operand of "^"} + } -result {can't use floating-point value "1.0" as operand of "^"} test mathop-8.24 {interpreted ^} -returnCodes error -body { $op 1 2 3.0 - } -result {can't use floating-point value as operand of "^"} + } -result {can't use floating-point value "3.0" as operand of "^"} test mathop-8.25 {interpreted ^} { $op 100000000002 18 -126 } -100000000110 test mathop-8.26 {interpreted ^} { $op 0xff 0o377 333333333333 } 333333333333 test mathop-8.27 {interpreted ^} { $op 1000000000000000000002 18 -126 } -1000000000000000000110 test mathop-8.28 {interpreted ^} { $op 0xff 0o377 3333333333333333333333 } 3333333333333333333333 test mathop-8.29 {interpreted ^: errors} -returnCodes error -body { $op x 0 - } -result {can't use non-numeric string as operand of "^"} + } -result {can't use non-numeric string "x" as operand of "^"} test mathop-8.30 {interpreted ^: errors} -returnCodes error -body { $op nan 0 - } -result {can't use non-numeric floating-point value as operand of "^"} + } -result {can't use non-numeric floating-point value "nan" as operand of "^"} test mathop-8.31 {interpreted ^: errors} -returnCodes error -body { $op 0 x - } -result {can't use non-numeric string as operand of "^"} + } -result {can't use non-numeric string "x" as operand of "^"} test mathop-8.32 {interpreted ^: errors} -returnCodes error -body { $op 0 nan - } -result {can't use non-numeric floating-point value as operand of "^"} + } -result {can't use non-numeric floating-point value "nan" as operand of "^"} test mathop-8.33 {interpreted ^: errors} -returnCodes error -body { $op 0o8 0 - } -result {can't use invalid octal number as operand of "^"} + } -result {can't use non-numeric string "0o8" as operand of "^"} test mathop-8.34 {interpreted ^: errors} -returnCodes error -body { $op 0 0o8 - } -result {can't use invalid octal number as operand of "^"} + } -result {can't use non-numeric string "0o8" as operand of "^"} test mathop-8.35 {interpreted ^: errors} -returnCodes error -body { $op 0 [error expectedError] } -result expectedError @@ -775,13 +775,13 @@ test mathop-20.6 { one arg, error } { # skipping - for now, knownbug... foreach op {+ * / & | ^ **} { lappend res [TestOp $op {*}$vals] - lappend exp "can't use non-numeric string as operand of \"$op\"\ + lappend exp "can't use non-numeric string \"x\" as operand of \"$op\"\ ARITH DOMAIN {non-numeric string}" } } foreach op {+ * / & | ^ **} { lappend res [TestOp $op NaN 1] - lappend exp "can't use non-numeric floating-point value as operand of \"$op\"\ + lappend exp "can't use non-numeric floating-point value \"NaN\" as operand of \"$op\"\ ARITH DOMAIN {non-numeric floating-point value}" } expr {$res eq $exp ? 0 : $res} @@ -850,15 +850,15 @@ test mathop-21.5 { unary ops, bad values } { set res {} set exp {} lappend res [TestOp / x] - lappend exp "can't use non-numeric string as operand of \"/\" ARITH DOMAIN {non-numeric string}" + lappend exp "can't use non-numeric string \"x\" as operand of \"/\" ARITH DOMAIN {non-numeric string}" lappend res [TestOp - x] - lappend exp "can't use non-numeric string as operand of \"-\" ARITH DOMAIN {non-numeric string}" + lappend exp "can't use non-numeric string \"x\" as operand of \"-\" ARITH DOMAIN {non-numeric string}" lappend res [TestOp ~ x] - lappend exp "can't use non-numeric string as operand of \"~\" ARITH DOMAIN {non-numeric string}" + lappend exp "can't use non-numeric string \"x\" as operand of \"~\" ARITH DOMAIN {non-numeric string}" lappend res [TestOp ! x] - lappend exp "can't use non-numeric string as operand of \"!\" ARITH DOMAIN {non-numeric string}" + lappend exp "can't use non-numeric string \"x\" as operand of \"!\" ARITH DOMAIN {non-numeric string}" lappend res [TestOp ~ 5.0] - lappend exp "can't use floating-point value as operand of \"~\" ARITH DOMAIN {floating-point value}" + lappend exp "can't use floating-point value \"5.0\" as operand of \"~\" ARITH DOMAIN {floating-point value}" expr {$res eq $exp ? 0 : $res} } 0 test mathop-21.6 { unary ops, too many } { @@ -965,9 +965,9 @@ test mathop-22.4 { unary ops, bad values } { set exp {} foreach op {& | ^} { lappend res [TestOp $op x 5] - lappend exp "can't use non-numeric string as operand of \"$op\" ARITH DOMAIN {non-numeric string}" + lappend exp "can't use non-numeric string \"x\" as operand of \"$op\" ARITH DOMAIN {non-numeric string}" lappend res [TestOp $op 5 x] - lappend exp "can't use non-numeric string as operand of \"$op\" ARITH DOMAIN {non-numeric string}" + lappend exp "can't use non-numeric string \"x\" as operand of \"$op\" ARITH DOMAIN {non-numeric string}" } expr {$res eq $exp ? 0 : $res} } 0 @@ -1080,15 +1080,15 @@ test mathop-24.3 { binary ops, bad values } { set exp {} foreach op {% << >>} { lappend res [TestOp $op x 1] - lappend exp "can't use non-numeric string as operand of \"$op\" ARITH DOMAIN {non-numeric string}" + lappend exp "can't use non-numeric string \"x\" as operand of \"$op\" ARITH DOMAIN {non-numeric string}" lappend res [TestOp $op 1 x] - lappend exp "can't use non-numeric string as operand of \"$op\" ARITH DOMAIN {non-numeric string}" + lappend exp "can't use non-numeric string \"x\" as operand of \"$op\" ARITH DOMAIN {non-numeric string}" } foreach op {% << >>} { lappend res [TestOp $op 5.0 1] - lappend exp "can't use floating-point value as operand of \"$op\" ARITH DOMAIN {floating-point value}" + lappend exp "can't use floating-point value \"5.0\" as operand of \"$op\" ARITH DOMAIN {floating-point value}" lappend res [TestOp $op 1 5.0] - lappend exp "can't use floating-point value as operand of \"$op\" ARITH DOMAIN {floating-point value}" + lappend exp "can't use floating-point value \"5.0\" as operand of \"$op\" ARITH DOMAIN {floating-point value}" } foreach op {in ni} { lappend res [TestOp $op 5 "a b \{ c"] @@ -1266,9 +1266,9 @@ test mathop-25.41 { exp operator errors } { lappend res [TestOp ** $huge 2.1] lappend exp "Inf" lappend res [TestOp ** 2 foo] - lappend exp "can't use non-numeric string as operand of \"**\" ARITH DOMAIN {non-numeric string}" + lappend exp "can't use non-numeric string \"foo\" as operand of \"**\" ARITH DOMAIN {non-numeric string}" lappend res [TestOp ** foo 2] - lappend exp "can't use non-numeric string as operand of \"**\" ARITH DOMAIN {non-numeric string}" + lappend exp "can't use non-numeric string \"foo\" as operand of \"**\" ARITH DOMAIN {non-numeric string}" expr {$res eq $exp ? 0 : $res} } 0 diff --git a/tests/namespace-old.test b/tests/namespace-old.test index 636f953..760ae6e 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 8209cf3..23e6095 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] @@ -648,6 +648,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 @@ -659,9 +661,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 {} @@ -722,15 +726,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 { @@ -903,13 +909,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 @@ -921,6 +929,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 { @@ -934,7 +944,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} @@ -1555,6 +1565,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 { @@ -1574,12 +1586,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/parse.test b/tests/parse.test index 0786478..8f6ec49 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 diff --git a/tests/result.test b/tests/result.test index f1f5fb7..b4662a0 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/source.test b/tests/source.test index c6cccd6..378d62e 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 \u20ac {} {return foo}" close $f } -body { - source -encoding utf-8 $sourcefile + source $sourcefile \u20ac } -cleanup { removeFile source.file diff --git a/tests/string.test b/tests/string.test index 4817bec..9c314b9 100644 --- a/tests/string.test +++ b/tests/string.test @@ -31,7 +31,7 @@ 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 fullutf [expr {[string length \U010000] == 1}] testConstraint testbytestring [llength [info commands testbytestring]] # Used for constraining memory leak tests @@ -496,19 +496,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*}} -test string-5.19.$noComp {string index, bytearray object out of bounds} { +} -match glob -result {1 {*}} +test string-5.19.$noComp {string index, bytearray object out of bounds} -body { run {string index [binary format I* {0x50515253 0x52}] -1} -} {} +} -result {} 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 fullutf -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 {}] proc largest_int {} { @@ -1503,9 +1503,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]} fullutf { 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 { @@ -1761,10 +1761,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]} fullutf { 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 @@ -1905,9 +1905,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 fullutf -body { run {string wordend "\U1D7CA\U1D7CA abc" 10} -} -result 8 +} -result 6 test string-22.1.$noComp {string wordstart} -body { list [catch {run {string word a}} msg] $msg @@ -1956,9 +1956,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 fullutf -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 diff --git a/tests/stringObj.test b/tests/stringObj.test index ca6c323..e1b6c03 100644 --- a/tests/stringObj.test +++ b/tests/stringObj.test @@ -23,8 +23,7 @@ catch [list package require -exact Tcltest [info patchlevel]] 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 nodep [info exists tcl_precision] +testConstraint fullutf [expr {[string length \U010000] == 1}] test stringObj-1.1 {string type registration} testobj { set t [testobj types] @@ -466,19 +465,19 @@ 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 nodep} { +test stringObj-15.5 {Tcl_Append*ToObj: self appends} {testobj fullutf} { teststringobj set 1 foo teststringobj appendself2 1 0 } foofoo -test stringObj-15.6 {Tcl_Append*ToObj: self appends} {testobj tip389 nodep} { +test stringObj-15.6 {Tcl_Append*ToObj: self appends} {testobj fullutf} { teststringobj set 1 foo teststringobj appendself2 1 1 } foooo -test stringObj-15.7 {Tcl_Append*ToObj: self appends} {testobj tip389 nodep} { +test stringObj-15.7 {Tcl_Append*ToObj: self appends} {testobj fullutf} { teststringobj set 1 foo teststringobj appendself2 1 2 } fooo -test stringObj-15.8 {Tcl_Append*ToObj: self appends} {testobj tip389 nodep} { +test stringObj-15.8 {Tcl_Append*ToObj: self appends} {testobj fullutf} { teststringobj set 1 foo teststringobj appendself2 1 3 } foo diff --git a/tests/tcltest.test b/tests/tcltest.test index ac2185b..412a88e 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 00333 diff --git a/tests/utf.test b/tests/utf.test index 935830c..e7a9d76 100644 --- a/tests/utf.test +++ b/tests/utf.test @@ -901,10 +901,10 @@ test utf-9.3.2 {Tcl_UtfAtIndex: index = 0, Emoji} utf16 { string range \uD83D\uDE00G 0 0 } \U1F600 test utf-9.4.0 {Tcl_UtfAtIndex: index > 0, Emoji} ucs2 { - string range \uD83D\uDE00G 1 1 + string range \U1F600G 1 1 } \uDE00 test utf-9.4.1 {Tcl_UtfAtIndex: index > 0, Emoji} ucs4 { - string range \uD83D\uDE00G 1 1 + string range \U1F600G 1 1 } G test utf-9.4.2 {Tcl_UtfAtIndex: index > 0, Emoji} utf16 { string range \uD83D\uDE00G 1 1 diff --git a/tests/util.test b/tests/util.test index d8e5507..d303bb4 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 {} { @@ -282,7 +279,7 @@ test util-5.17 {Tcl_StringMatch: UTF-8} { test util-5.18 {Tcl_StringMatch: UTF-8} testbytestring { # pattern += Tcl_UtfToUniChar(pattern, &endChar); # proper advance: wrong answer would match on UTF trail byte of \u4e4f - Wrapper_Tcl_StringMatch {a[a\u4e4fc]c} [testbytestring a\x8fc] + Wrapper_Tcl_StringMatch {a[a\u4e4fc]c} [testbytestring a\x8Fc] } 0 test util-5.19 {Tcl_StringMatch: UTF-8} { # pattern += Tcl_UtfToUniChar(pattern, &endChar); @@ -392,38 +389,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} @@ -431,50 +396,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 @@ -2230,1874 +2151,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} { @@ -4175,10 +2228,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 19b7703..dcd0148 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/while-old.test b/tests/while-old.test index f5315fb..5c943d6 100644 --- a/tests/while-old.test +++ b/tests/while-old.test @@ -92,7 +92,7 @@ test while-old-4.3 {errors in while loops} { test while-old-4.4 {errors in while loops} { set err [catch {while {"a"+"b"} {error "loop aborted"}} msg] list $err $msg -} {1 {can't use non-numeric string as operand of "+"}} +} {1 {can't use non-numeric string "a" as operand of "+"}} test while-old-4.5 {errors in while loops} { catch {unset x} set x 1 diff --git a/tests/while.test b/tests/while.test index b804aa5..3c53bea 100644 --- a/tests/while.test +++ b/tests/while.test @@ -32,7 +32,7 @@ test while-1.2 {TclCompileWhileCmd: error in test expression} -body { } -match glob -result {*"while {$i<} break"} test while-1.3 {TclCompileWhileCmd: error in test expression} -body { while {"a"+"b"} {error "loop aborted"} -} -returnCodes error -result {can't use non-numeric string as operand of "+"} +} -returnCodes error -result {can't use non-numeric string "a" as operand of "+"} test while-1.4 {TclCompileWhileCmd: multiline test expr} -body { set value 1 while {($tcl_platform(platform) != "foobar1") && \ @@ -343,7 +343,7 @@ test while-4.3 {while (not compiled): error in test expression} -body { test while-4.4 {while (not compiled): error in test expression} -body { set z while $z {"a"+"b"} {error "loop aborted"} -} -returnCodes error -result {can't use non-numeric string as operand of "+"} +} -returnCodes error -result {can't use non-numeric string "a" as operand of "+"} test while-4.5 {while (not compiled): multiline test expr} -body { set value 1 set z while diff --git a/tools/README b/tools/README index f4bf627..87a9af4 100644 --- a/tools/README +++ b/tools/README @@ -12,7 +12,7 @@ Generating HTML files. The tcl-tk-man-html.tcl script from Robert Critchlow generates a nice set of HTML with good cross references. Use it like - tclsh tcl-tk-man-html.tcl --htmldir=/tmp/tcl8.2 + tclsh tcl-tk-man-html.tcl --htmldir=/tmp/tcl9.0 This script is very picky about the organization of man pages, effectively acting as a style enforcer. diff --git a/tools/checkLibraryDoc.tcl b/tools/checkLibraryDoc.tcl index 8dba5b4..d4e6081 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. @@ -50,8 +50,6 @@ set StructList { Tcl_TimerToken \ Tcl_Token \ Tcl_Trace \ - Tcl_Value \ - Tcl_ValueType \ Tcl_Var \ Tk_3DBorder \ Tk_ArgvInfo \ diff --git a/tools/configure b/tools/configure index 5903cc8..e125786 100755 --- a/tools/configure +++ b/tools/configure @@ -1681,7 +1681,7 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu # not, assume that its top-level directory is a sibling of ours. #-------------------------------------------------------------------- -DEF_VER=8.7 +DEF_VER=9.0 # Check whether --with-tcl was given. diff --git a/tools/configure.ac b/tools/configure.ac index 3caa141..7950578 100644 --- a/tools/configure.ac +++ b/tools/configure.ac @@ -11,7 +11,7 @@ AC_PREREQ(2.69) # not, assume that its top-level directory is a sibling of ours. #-------------------------------------------------------------------- -DEF_VER=8.7 +DEF_VER=9.0 AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl $DEF_VER binaries from DIR], TCL_BIN_DIR=$withval, TCL_BIN_DIR=`cd ../../tcl$DEF_VER$TCL_PATCH_LEVEL/unix; pwd`) if test ! -d $TCL_BIN_DIR; then diff --git a/tools/tcl.hpj.in b/tools/tcl.hpj.in index 08d411d..a3d1a49 100644 --- a/tools/tcl.hpj.in +++ b/tools/tcl.hpj.in @@ -5,9 +5,9 @@ HCW=0 LCID=0x409 0x0 0x0 ;English (United States)
REPORT=Yes
TITLE=Tcl/Tk Reference Manual
-CNT=tcl87.cnt
+CNT=tcl90.cnt
COPYRIGHT=Copyright © 2000 Ajuba Solutions
-HLP=tcl87.hlp
+HLP=tcl90.hlp
[FILES]
tcl.rtf
diff --git a/tools/tcltk-man2html.tcl b/tools/tcltk-man2html.tcl index c81acce..aa3ecce 100755 --- a/tools/tcltk-man2html.tcl +++ b/tools/tcltk-man2html.tcl @@ -4,7 +4,7 @@ if {[catch {package require Tcl 8.6-} msg]} { puts stderr "ERROR: $msg" puts stderr "If running this script from 'make html', set the\ NATIVE_TCLSH environment\nvariable to point to an installed\ - tclsh8.7 (or the equivalent tclsh87.exe\non Windows)." + tclsh9.0 (or the equivalent tclsh90.exe\non Windows)." exit 1 } @@ -22,7 +22,7 @@ if {[catch {package require Tcl 8.6-} msg]} { # Copyright (c) 1995-1997 Roger E. Critchlow Jr # Copyright (c) 2004-2010 Donal K. Fellows -set ::Version "50/8.7" +set ::Version "50/9.0" set ::CSSFILE "docs.css" ## diff --git a/unix/Makefile.in b/unix/Makefile.in index 96ace8c..032c40b 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@ @@ -1021,7 +1021,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"; \ @@ -1042,23 +1042,23 @@ install-libraries: libraries done @echo "Installing package http 2.10.0a1 as a Tcl Module" @$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl \ - "$(MODULE_INSTALL_DIR)/8.6/http-2.10.0a1.tm" + "$(MODULE_INSTALL_DIR)/9.0/http-2.10.0a1.tm" @echo "Installing package opt 0.4.7" @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.3 as a Tcl Module" @$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl \ - "$(MODULE_INSTALL_DIR)/8.5/tcltest-2.5.3.tm" + "$(MODULE_INSTALL_DIR)/9.0/tcltest-2.5.3.tm" @echo "Installing package platform 1.0.14 as a Tcl Module" @$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl \ - "$(MODULE_INSTALL_DIR)/8.4/platform-1.0.14.tm" + "$(MODULE_INSTALL_DIR)/9.0/platform-1.0.14.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"; \ @@ -2218,6 +2218,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 reg dde tcltest platform $(UNIX_DIR)/configure: $(UNIX_DIR)/configure.ac $(UNIX_DIR)/tcl.m4 \ @@ -2235,104 +2237,109 @@ $(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 $(UNIX_DIR)/Makefile.in $(DISTDIR)/unix - chmod 664 $(DISTDIR)/unix/Makefile.in - cp $(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 $(DISTDIR)/unix/configure.ac - 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/*.txt.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/*.txt.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)/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 \ $(DISTDIR)/tests - @mkdir $(DISTDIR)/win - cp $(TOP_DIR)/win/Makefile.in $(DISTDIR)/win - cp $(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 \ $(DISTDIR)/win - 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.hpj.in $(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.hpj.in $(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.xcode - cp -p $(MAC_OSX_DIR)/Tcl.xcode/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.xcode + $(DIST_INSTALL_DATA) $(MAC_OSX_DIR)/Tcl.xcode/project.pbxproj \ $(MAC_OSX_DIR)/Tcl.xcode/default.pbxuser \ $(DISTDIR)/macosx/Tcl.xcode - @mkdir $(DISTDIR)/macosx/Tcl.xcodeproj - cp -p $(MAC_OSX_DIR)/Tcl.xcodeproj/project.pbxproj \ + $(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)/Makefile.in $(TOOL_DIR)/README \ + $(INSTALL_DATA_DIR) $(DISTDIR)/tools + $(DIST_INSTALL_DATA) $(TOOL_DIR)/Makefile.in $(TOOL_DIR)/README \ $(TOOL_DIR)/configure $(TOOL_DIR)/configure.ac \ $(TOOL_DIR)/*.tcl $(TOOL_DIR)/man2tcl.c \ $(TOOL_DIR)/*.bmp $(TOOL_DIR)/tcl.hpj.in \ $(DISTDIR)/tools - @mkdir $(DISTDIR)/libtommath - cp -p $(TOMMATH_SRCS) $(TOMMATH_DIR)/*.h $(DISTDIR)/libtommath - @mkdir $(DISTDIR)/pkgs - cp $(TOP_DIR)/pkgs/README $(DISTDIR)/pkgs - cp $(TOP_DIR)/pkgs/package.list.txt $(DISTDIR)/pkgs + chmod 755 $(DISTDIR)/tools/checkLibraryDoc.tcl \ + $(DISTDIR)/tools/configure $(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)/libtommath + $(DIST_INSTALL_DATA) $(TOMMATH_SRCS) $(TOMMATH_DIR)/*.h $(DISTDIR)/libtommath + $(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 @@ -2347,7 +2354,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/config.status.lineno b/unix/config.status.lineno deleted file mode 100755 index 12d4f40..0000000 --- a/unix/config.status.lineno +++ /dev/null @@ -1,920 +0,0 @@ -#! /bin/bash -# Generated by configure. -# Run this file to recreate the current configuration. -# Compiler output produced by configure, useful for debugging -# configure, is in config.log if it exists. - -debug=false -ac_cs_recheck=false -ac_cs_silent=false -SHELL=${CONFIG_SHELL-/bin/bash} -## --------------------- ## -## M4sh Initialization. ## -## --------------------- ## - -# Be Bourne compatible -if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then - emulate sh - NULLCMD=: - # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which - # is contrary to our usage. Disable this feature. - alias -g '${1+"$@"}'='"$@"' -elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then - set -o posix -fi -DUALCASE=1; export DUALCASE # for MKS sh - -# Support unset when possible. -if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then - as_unset=unset -else - as_unset=false -fi - - -# Work around bugs in pre-3.0 UWIN ksh. -$as_unset ENV MAIL MAILPATH -PS1='$ ' -PS2='> ' -PS4='+ ' - -# NLS nuisances. -for as_var in \ - LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \ - LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \ - LC_TELEPHONE LC_TIME -do - if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then - eval $as_var=C; export $as_var - else - $as_unset $as_var - fi -done - -# Required to use basename. -if expr a : '\(a\)' >/dev/null 2>&1; then - as_expr=expr -else - as_expr=false -fi - -if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then - as_basename=basename -else - as_basename=false -fi - - -# Name of the executable. -as_me=`$as_basename "$0" || -$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ - X"$0" : 'X\(//\)$' \| \ - X"$0" : 'X\(/\)$' \| \ - . : '\(.\)' 2>/dev/null || -echo X/"$0" | - sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; } - /^X\/\(\/\/\)$/{ s//\1/; q; } - /^X\/\(\/\).*/{ s//\1/; q; } - s/.*/./; q'` - - -# PATH needs CR, and LINENO needs CR and PATH. -# Avoid depending upon Character Ranges. -as_cr_letters='abcdefghijklmnopqrstuvwxyz' -as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' -as_cr_Letters=$as_cr_letters$as_cr_LETTERS -as_cr_digits='0123456789' -as_cr_alnum=$as_cr_Letters$as_cr_digits - -# The user is always right. -if test "${PATH_SEPARATOR+set}" != set; then - echo "#! /bin/sh" >conf$$.sh - echo "exit 0" >>conf$$.sh - chmod +x conf$$.sh - if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then - PATH_SEPARATOR=';' - else - PATH_SEPARATOR=: - fi - rm -f conf$$.sh -fi - - - as_lineno_1=103 - as_lineno_2=104 - as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` - test "x$as_lineno_1" != "x$as_lineno_2" && - test "x$as_lineno_3" = "x$as_lineno_2" || { - # Find who we are. Look in the path if we contain no path at all - # relative or not. - case $0 in - *[\\/]* ) as_myself=$0 ;; - *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break -done - - ;; - esac - # We did not find ourselves, most probably we were run as `sh COMMAND' - # in which case we are not to be found in the path. - if test "x$as_myself" = x; then - as_myself=$0 - fi - if test ! -f "$as_myself"; then - { { echo "$as_me:128: error: cannot find myself; rerun with an absolute path" >&5 -echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2;} - { (exit 1); exit 1; }; } - fi - case $CONFIG_SHELL in - '') - as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for as_base in sh bash ksh sh5; do - case $as_dir in - /*) - if ("$as_dir/$as_base" -c ' - as_lineno_1=143 - as_lineno_2=144 - as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` - test "x$as_lineno_1" != "x$as_lineno_2" && - test "x$as_lineno_3" = "x$as_lineno_2" ') 2>/dev/null; then - $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; } - $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; } - CONFIG_SHELL=$as_dir/$as_base - export CONFIG_SHELL - exec "$CONFIG_SHELL" "$0" ${1+"$@"} - fi;; - esac - done -done -;; - esac - - # Create $as_me.lineno as a copy of $as_myself, but with 160 - # uniformly replaced by the line number. The first 'sed' inserts a - # line-number line before each line; the second 'sed' does the real - # work. The second script uses 'N' to pair each line-number line - # with the numbered line, and appends trailing '-' during - # substitution so that 165 is not a special case at line end. - # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the - # second 'sed' script. Blame Lee E. McMahon for sed's syntax. :-) - sed '=' <$as_myself | - sed ' - N - s,$,-, - : loop - s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3, - t loop - s,-$,, - s,^['$as_cr_digits']*\n,, - ' >$as_me.lineno && - chmod +x $as_me.lineno || - { { echo "$as_me:179: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&5 -echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2;} - { (exit 1); exit 1; }; } - - # Don't try to exec as it changes $[0], causing all sort of problems - # (the dirname of $[0] is not the place where we might find the - # original and so on. Autoconf is especially sensible to this). - . ./$as_me.lineno - # Exit status is that of the last command. - exit -} - - -case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in - *c*,-n*) ECHO_N= ECHO_C=' -' ECHO_T=' ' ;; - *c*,* ) ECHO_N=-n ECHO_C= ECHO_T= ;; - *) ECHO_N= ECHO_C='\c' ECHO_T= ;; -esac - -if expr a : '\(a\)' >/dev/null 2>&1; then - as_expr=expr -else - as_expr=false -fi - -rm -f conf$$ conf$$.exe conf$$.file -echo >conf$$.file -if ln -s conf$$.file conf$$ 2>/dev/null; then - # We could just check for DJGPP; but this test a) works b) is more generic - # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04). - if test -f conf$$.exe; then - # Don't use ln at all; we don't have any links - as_ln_s='cp -p' - else - as_ln_s='ln -s' - fi -elif ln conf$$.file conf$$ 2>/dev/null; then - as_ln_s=ln -else - as_ln_s='cp -p' -fi -rm -f conf$$ conf$$.exe conf$$.file - -if mkdir -p . 2>/dev/null; then - as_mkdir_p=: -else - test -d ./-p && rmdir ./-p - as_mkdir_p=false -fi - -as_executable_p="test -f" - -# Sed expression to map a string onto a valid CPP name. -as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" - -# Sed expression to map a string onto a valid variable name. -as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" - - -# IFS -# We need space, tab and new line, in precisely that order. -as_nl=' -' -IFS=" $as_nl" - -# CDPATH. -$as_unset CDPATH - -exec 6>&1 - -# Open the log real soon, to keep \$[0] and so on meaningful, and to -# report actual input values of CONFIG_FILES etc. instead of their -# values after options handling. Logging --version etc. is OK. -exec 5>>config.log -{ - echo - sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX -## Running $as_me. ## -_ASBOX -} >&5 -cat >&5 <<_CSEOF - -This file was extended by tcl $as_me 8.6, which was -generated by GNU Autoconf 2.59. Invocation command line was - - CONFIG_FILES = $CONFIG_FILES - CONFIG_HEADERS = $CONFIG_HEADERS - CONFIG_LINKS = $CONFIG_LINKS - CONFIG_COMMANDS = $CONFIG_COMMANDS - $ $0 $@ - -_CSEOF -echo "on `(hostname || uname -n) 2>/dev/null | sed 1q`" >&5 -echo >&5 -config_files=" Makefile:../unix/Makefile.in dltest/Makefile:../unix/dltest/Makefile.in tclConfig.sh:../unix/tclConfig.sh.in tcl.pc:../unix/tcl.pc.in" - -ac_cs_usage="\ -\`$as_me' instantiates files from templates according to the -current configuration. - -Usage: $0 [OPTIONS] [FILE]... - - -h, --help print this help, then exit - -V, --version print version number, then exit - -q, --quiet do not print progress messages - -d, --debug don't remove temporary files - --recheck update $as_me by reconfiguring in the same conditions - --file=FILE[:TEMPLATE] - instantiate the configuration file FILE - -Configuration files: -$config_files - -Configuration commands: -$config_commands - -Report bugs to <bug-autoconf@gnu.org>." -ac_cs_version="\ -tcl config.status 8.6 -configured by ./configure, generated by GNU Autoconf 2.59, - with options \"'--prefix=/home/jima/space/ins/lin64/dynamic/main'\" - -Copyright (C) 2003 Free Software Foundation, Inc. -This config.status script is free software; the Free Software Foundation -gives unlimited permission to copy, distribute and modify it." -srcdir=/home/jima/space/bui/lin64/dynamic/main/tcl/unix -# If no file are specified by the user, then we need to provide default -# value. By we need to know if files were specified by the user. -ac_need_defaults=: -while test $# != 0 -do - case $1 in - --*=*) - ac_option=`expr "x$1" : 'x\([^=]*\)='` - ac_optarg=`expr "x$1" : 'x[^=]*=\(.*\)'` - ac_shift=: - ;; - -*) - ac_option=$1 - ac_optarg=$2 - ac_shift=shift - ;; - *) # This is not an option, so the user has probably given explicit - # arguments. - ac_option=$1 - ac_need_defaults=false;; - esac - - case $ac_option in - # Handling of the options. - -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) - ac_cs_recheck=: ;; - --version | --vers* | -V ) - echo "$ac_cs_version"; exit 0 ;; - --he | --h) - # Conflict between --help and --header - { { echo "$as_me:336: error: ambiguous option: $1 -Try \`$0 --help' for more information." >&5 -echo "$as_me: error: ambiguous option: $1 -Try \`$0 --help' for more information." >&2;} - { (exit 1); exit 1; }; };; - --help | --hel | -h ) - echo "$ac_cs_usage"; exit 0 ;; - --debug | --d* | -d ) - debug=: ;; - --file | --fil | --fi | --f ) - $ac_shift - CONFIG_FILES="$CONFIG_FILES $ac_optarg" - ac_need_defaults=false;; - --header | --heade | --head | --hea ) - $ac_shift - CONFIG_HEADERS="$CONFIG_HEADERS $ac_optarg" - ac_need_defaults=false;; - -q | -quiet | --quiet | --quie | --qui | --qu | --q \ - | -silent | --silent | --silen | --sile | --sil | --si | --s) - ac_cs_silent=: ;; - - # This is an error. - -*) { { echo "$as_me:358: error: unrecognized option: $1 -Try \`$0 --help' for more information." >&5 -echo "$as_me: error: unrecognized option: $1 -Try \`$0 --help' for more information." >&2;} - { (exit 1); exit 1; }; } ;; - - *) ac_config_targets="$ac_config_targets $1" ;; - - esac - shift -done - -ac_configure_extra_args= - -if $ac_cs_silent; then - exec 6>/dev/null - ac_configure_extra_args="$ac_configure_extra_args --silent" -fi - -if $ac_cs_recheck; then - echo "running /bin/bash ./configure " '--prefix=/home/jima/space/ins/lin64/dynamic/main' $ac_configure_extra_args " --no-create --no-recursion" >&6 - exec /bin/bash ./configure '--prefix=/home/jima/space/ins/lin64/dynamic/main' $ac_configure_extra_args --no-create --no-recursion -fi - -# -# INIT-COMMANDS section. -# - -VERSION=8.6 - -for ac_config_target in $ac_config_targets -do - case "$ac_config_target" in - # Handling of arguments. - "Tcl-Info.plist" ) CONFIG_FILES="$CONFIG_FILES Tcl-Info.plist:../macosx/Tcl-Info.plist.in" ;; - "Tclsh-Info.plist" ) CONFIG_FILES="$CONFIG_FILES Tclsh-Info.plist:../macosx/Tclsh-Info.plist.in" ;; - "Makefile" ) CONFIG_FILES="$CONFIG_FILES Makefile:../unix/Makefile.in" ;; - "dltest/Makefile" ) CONFIG_FILES="$CONFIG_FILES dltest/Makefile:../unix/dltest/Makefile.in" ;; - "tclConfig.sh" ) CONFIG_FILES="$CONFIG_FILES tclConfig.sh:../unix/tclConfig.sh.in" ;; - "tcl.pc" ) CONFIG_FILES="$CONFIG_FILES tcl.pc:../unix/tcl.pc.in" ;; - "Tcl.framework" ) CONFIG_COMMANDS="$CONFIG_COMMANDS Tcl.framework" ;; - *) { { echo "$as_me:399: error: invalid argument: $ac_config_target" >&5 -echo "$as_me: error: invalid argument: $ac_config_target" >&2;} - { (exit 1); exit 1; }; };; - esac -done - -# If the user did not use the arguments to specify the items to instantiate, -# then the envvar interface is used. Set only those that are not. -# We use the long form for the default assignment because of an extremely -# bizarre bug on SunOS 4.1.3. -if $ac_need_defaults; then - test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files - test "${CONFIG_COMMANDS+set}" = set || CONFIG_COMMANDS=$config_commands -fi - -# Have a temporary directory for convenience. Make it in the build tree -# simply because there is no reason to put it here, and in addition, -# creating and moving files from /tmp can sometimes cause problems. -# Create a temporary directory, and hook for its removal unless debugging. -$debug || -{ - trap 'exit_status=$?; rm -rf $tmp && exit $exit_status' 0 - trap '{ (exit 1); exit 1; }' 1 2 13 15 -} - -# Create a (secure) tmp directory for tmp files. - -{ - tmp=`(umask 077 && mktemp -d -q "./confstatXXXXXX") 2>/dev/null` && - test -n "$tmp" && test -d "$tmp" -} || -{ - tmp=./confstat$$-$RANDOM - (umask 077 && mkdir $tmp) -} || -{ - echo "$me: cannot create a temporary directory in ." >&2 - { (exit 1); exit 1; } -} - - -# -# CONFIG_FILES section. -# - -# No need to generate the scripts if there are no CONFIG_FILES. -# This happens for instance when ./config.status config.h -if test -n "$CONFIG_FILES"; then - # Protect against being on the right side of a sed subst in config.status. - sed 's/,@/@@/; s/@,/@@/; s/,;t t$/@;t t/; /@;t t$/s/[\\&,]/\\&/g; - s/@@/,@/; s/@@/@,/; s/@;t t$/,;t t/' >$tmp/subs.sed <<\CEOF -s,@SHELL@,/bin/bash,;t t -s,@PATH_SEPARATOR@,:,;t t -s,@PACKAGE_NAME@,tcl,;t t -s,@PACKAGE_TARNAME@,tcl,;t t -s,@PACKAGE_VERSION@,8.6,;t t -s,@PACKAGE_STRING@,tcl 8.6,;t t -s,@PACKAGE_BUGREPORT@,,;t t -s,@exec_prefix@,/home/jima/space/ins/lin64/dynamic/main,;t t -s,@prefix@,/home/jima/space/ins/lin64/dynamic/main,;t t -s,@program_transform_name@,s,x,x,,;t t -s,@bindir@,${exec_prefix}/bin,;t t -s,@sbindir@,${exec_prefix}/sbin,;t t -s,@libexecdir@,${exec_prefix}/libexec,;t t -s,@datadir@,${prefix}/share,;t t -s,@sysconfdir@,${prefix}/etc,;t t -s,@sharedstatedir@,${prefix}/com,;t t -s,@localstatedir@,${prefix}/var,;t t -s,@libdir@,/home/jima/space/ins/lin64/dynamic/main/lib,;t t -s,@includedir@,${prefix}/include,;t t -s,@oldincludedir@,/usr/include,;t t -s,@infodir@,${prefix}/info,;t t -s,@mandir@,${prefix}/man,;t t -s,@build_alias@,,;t t -s,@host_alias@,,;t t -s,@target_alias@,,;t t -s,@DEFS@,-DPACKAGE_NAME=\"tcl\" -DPACKAGE_TARNAME=\"tcl\" -DPACKAGE_VERSION=\"8.6\" -DPACKAGE_STRING=\"tcl\ 8.6\" -DPACKAGE_BUGREPORT=\"\" -DSTDC_HEADERS=1 -DHAVE_SYS_TYPES_H=1 -DHAVE_SYS_STAT_H=1 -DHAVE_STDLIB_H=1 -DHAVE_STRING_H=1 -DHAVE_MEMORY_H=1 -DHAVE_STRINGS_H=1 -DHAVE_INTTYPES_H=1 -DHAVE_STDINT_H=1 -DHAVE_UNISTD_H=1 -DHAVE_SYS_PARAM_H=1 -DUSE_THREAD_ALLOC=1 -D_REENTRANT=1 -D_THREAD_SAFE=1 -DHAVE_PTHREAD_ATTR_SETSTACKSIZE=1 -DHAVE_PTHREAD_ATFORK=1 -DTCL_THREADS=1 -DTCL_CFGVAL_ENCODING=\"iso8859-1\" -DHAVE_ZLIB=1 -DMODULE_SCOPE=extern\ __attribute__\(\(__visibility__\(\"hidden\"\)\)\) -DHAVE_HIDDEN=1 -DHAVE_CAST_TO_UNION=1 -DTCL_SHLIB_EXT=\".so\" -DNDEBUG=1 -DTCL_CFG_OPTIMIZED=1 -DTCL_TOMMATH=1 -DMP_PREC=4 -D_LARGEFILE64_SOURCE=1 -DTCL_WIDE_INT_IS_LONG=1 -DHAVE_GETCWD=1 -DHAVE_MKSTEMP=1 -DHAVE_OPENDIR=1 -DHAVE_STRTOL=1 -DHAVE_WAITPID=1 -DHAVE_GETNAMEINFO=1 -DHAVE_GETADDRINFO=1 -DHAVE_FREEADDRINFO=1 -DHAVE_GAI_STRERROR=1 -DHAVE_STRUCT_ADDRINFO=1 -DHAVE_STRUCT_IN6_ADDR=1 -DHAVE_STRUCT_SOCKADDR_IN6=1 -DHAVE_STRUCT_SOCKADDR_STORAGE=1 -DHAVE_GETPWUID_R_5=1 -DHAVE_GETPWUID_R=1 -DHAVE_GETPWNAM_R_5=1 -DHAVE_GETPWNAM_R=1 -DHAVE_GETGRGID_R_5=1 -DHAVE_GETGRGID_R=1 -DHAVE_GETGRNAM_R_5=1 -DHAVE_GETGRNAM_R=1 -DHAVE_GETHOSTBYNAME_R_6=1 -DHAVE_GETHOSTBYNAME_R=1 -DHAVE_GETHOSTBYADDR_R_8=1 -DHAVE_GETHOSTBYADDR_R=1 -DHAVE_TERMIOS_H=1 -DHAVE_SYS_IOCTL_H=1 -DHAVE_SYS_TIME_H=1 -DTIME_WITH_SYS_TIME=1 -DHAVE_GMTIME_R=1 -DHAVE_LOCALTIME_R=1 -DHAVE_MKTIME=1 -DHAVE_TM_GMTOFF=1 -DHAVE_TIMEZONE_VAR=1 -DHAVE_STRUCT_STAT_ST_BLOCKS=1 -DHAVE_STRUCT_STAT_ST_BLKSIZE=1 -DHAVE_BLKCNT_T=1 -DHAVE_INTPTR_T=1 -DHAVE_UINTPTR_T=1 -DNO_UNION_WAIT=1 -DHAVE_SIGNED_CHAR=1 -DHAVE_LANGINFO=1 -DHAVE_MKSTEMPS=1 -DHAVE_FTS=1 -DHAVE_SYS_IOCTL_H=1 -DTCL_UNLOAD_DLLS=1 -DHAVE_CPUID=1 ,;t t -s,@ECHO_C@,,;t t -s,@ECHO_N@,-n,;t t -s,@ECHO_T@,,;t t -s,@LIBS@,-lz -lpthread,;t t -s,@MAN_FLAGS@,,;t t -s,@CC@,gcc,;t t -s,@CFLAGS@, -pipe ,;t t -s,@LDFLAGS@, -Wl,--export-dynamic ,;t t -s,@CPPFLAGS@,,;t t -s,@ac_ct_CC@,gcc,;t t -s,@EXEEXT@,,;t t -s,@OBJEXT@,o,;t t -s,@CPP@,gcc -E,;t t -s,@EGREP@,grep -E,;t t -s,@TCL_THREADS@,1,;t t -s,@TCLSH_PROG@,/home/jima/space/ins/lin64/dynamic/main/bin/tclsh8.6,;t t -s,@ZLIB_OBJS@,,;t t -s,@ZLIB_SRCS@,,;t t -s,@ZLIB_INCLUDE@,,;t t -s,@RANLIB@,ranlib,;t t -s,@ac_ct_RANLIB@,ranlib,;t t -s,@AR@,ar,;t t -s,@ac_ct_AR@,ar,;t t -s,@LIBOBJS@,,;t t -s,@TCL_LIBS@,-ldl -lz -lpthread -lieee -lm,;t t -s,@DL_LIBS@,-ldl,;t t -s,@DL_OBJS@,tclLoadDl.o,;t t -s,@PLAT_OBJS@,,;t t -s,@PLAT_SRCS@,,;t t -s,@LDAIX_SRC@,,;t t -s,@CFLAGS_DEBUG@,-g,;t t -s,@CFLAGS_OPTIMIZE@,-O2,;t t -s,@CFLAGS_WARNING@,-Wall,;t t -s,@LDFLAGS_DEBUG@,,;t t -s,@LDFLAGS_OPTIMIZE@,,;t t -s,@CC_SEARCH_FLAGS@,-Wl,-rpath,${LIB_RUNTIME_DIR},;t t -s,@LD_SEARCH_FLAGS@,-Wl,-rpath,${LIB_RUNTIME_DIR},;t t -s,@STLIB_LD@,${AR} cr,;t t -s,@SHLIB_LD@,${CC} ${CFLAGS} ${LDFLAGS} -shared,;t t -s,@TCL_SHLIB_LD_EXTRAS@,,;t t -s,@TK_SHLIB_LD_EXTRAS@,,;t t -s,@SHLIB_LD_LIBS@,${LIBS},;t t -s,@SHLIB_CFLAGS@,-fPIC,;t t -s,@SHLIB_SUFFIX@,.so,;t t -s,@MAKE_LIB@,${SHLIB_LD} -o $@ ${OBJS} ${SHLIB_LD_LIBS} ${TCL_SHLIB_LD_EXTRAS} ${TK_SHLIB_LD_EXTRAS} ${LD_SEARCH_FLAGS},;t t -s,@MAKE_STUB_LIB@,${STLIB_LD} $@ ${STUB_LIB_OBJS} ; ${RANLIB} $@,;t t -s,@INSTALL_LIB@,$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)",;t t -s,@DLL_INSTALL_DIR@,$(LIB_INSTALL_DIR),;t t -s,@INSTALL_STUB_LIB@,$(INSTALL_LIBRARY) $(STUB_LIB_FILE) "$(LIB_INSTALL_DIR)/$(STUB_LIB_FILE)",;t t -s,@CFLAGS_DEFAULT@,$(CFLAGS_OPTIMIZE),;t t -s,@LDFLAGS_DEFAULT@,$(LDFLAGS_OPTIMIZE),;t t -s,@DTRACE@,,;t t -s,@TCL_VERSION@,8.6,;t t -s,@TCL_MAJOR_VERSION@,8,;t t -s,@TCL_MINOR_VERSION@,6,;t t -s,@TCL_PATCH_LEVEL@,.8,;t t -s,@TCL_YEAR@,,;t t -s,@PKG_CFG_ARGS@,'--prefix=/home/jima/space/ins/lin64/dynamic/main' ,;t t -s,@TCL_LIB_FILE@,libtcl8.6.so,;t t -s,@TCL_LIB_FLAG@,-ltcl8.6,;t t -s,@TCL_LIB_SPEC@,-L/home/jima/space/ins/lin64/dynamic/main/lib -ltcl8.6,;t t -s,@TCL_STUB_LIB_FILE@,libtclstub8.6.a,;t t -s,@TCL_STUB_LIB_FLAG@,-ltclstub8.6,;t t -s,@TCL_STUB_LIB_SPEC@,-L/home/jima/space/ins/lin64/dynamic/main/lib -ltclstub8.6,;t t -s,@TCL_STUB_LIB_PATH@,/home/jima/space/ins/lin64/dynamic/main/lib/libtclstub8.6.a,;t t -s,@TCL_INCLUDE_SPEC@,-I/home/jima/space/ins/lin64/dynamic/main/include,;t t -s,@TCL_BUILD_STUB_LIB_SPEC@,-L/home/jima/space/bui/lin64/dynamic/main/tcl/unix -ltclstub8.6,;t t -s,@TCL_BUILD_STUB_LIB_PATH@,/home/jima/space/bui/lin64/dynamic/main/tcl/unix/libtclstub8.6.a,;t t -s,@TCL_SRC_DIR@,/home/jima/space/bui/lin64/dynamic/main/tcl,;t t -s,@CFG_TCL_SHARED_LIB_SUFFIX@,${VERSION}.so,;t t -s,@CFG_TCL_UNSHARED_LIB_SUFFIX@,${VERSION}.a,;t t -s,@TCL_SHARED_BUILD@,1,;t t -s,@LD_LIBRARY_PATH_VAR@,LD_LIBRARY_PATH,;t t -s,@TCL_BUILD_LIB_SPEC@,-L/home/jima/space/bui/lin64/dynamic/main/tcl/unix -ltcl8.6,;t t -s,@TCL_LIB_VERSIONS_OK@,ok,;t t -s,@TCL_SHARED_LIB_SUFFIX@,${VERSION}${SHLIB_SUFFIX},;t t -s,@TCL_UNSHARED_LIB_SUFFIX@,${VERSION}.a,;t t -s,@TCL_HAS_LONGLONG@,,;t t -s,@INSTALL_TZDATA@,,;t t -s,@DTRACE_SRC@,,;t t -s,@DTRACE_HDR@,,;t t -s,@DTRACE_OBJ@,,;t t -s,@MAKEFILE_SHELL@,/bin/sh,;t t -s,@BUILD_DLTEST@,$(DLTEST_TARGETS),;t t -s,@TCL_PACKAGE_PATH@,/home/jima/space/ins/lin64/dynamic/main/lib ,;t t -s,@TCL_MODULE_PATH@,,;t t -s,@TCL_LIBRARY@,$(prefix)/lib/tcl$(VERSION),;t t -s,@PRIVATE_INCLUDE_DIR@,$(includedir),;t t -s,@HTML_DIR@,$(DISTDIR)/html,;t t -s,@PACKAGE_DIR@,/home/jima/space/ins/lin64/dynamic/main/lib,;t t -s,@EXTRA_CC_SWITCHES@,,;t t -s,@EXTRA_APP_CC_SWITCHES@,,;t t -s,@EXTRA_INSTALL@,,;t t -s,@EXTRA_INSTALL_BINARIES@,@:,;t t -s,@EXTRA_BUILD_HTML@,@:,;t t -s,@EXTRA_TCLSH_LIBS@,,;t t -s,@DLTEST_LD@,${SHLIB_LD},;t t -s,@DLTEST_SUFFIX@,,;t t -CEOF - - # Split the substitutions into bite-sized pieces for seds with - # small command number limits, like on Digital OSF/1 and HP-UX. - ac_max_sed_lines=48 - ac_sed_frag=1 # Number of current file. - ac_beg=1 # First line for current file. - ac_end=$ac_max_sed_lines # Line after last line for current file. - ac_more_lines=: - ac_sed_cmds= - while $ac_more_lines; do - if test $ac_beg -gt 1; then - sed "1,${ac_beg}d; ${ac_end}q" $tmp/subs.sed >$tmp/subs.frag - else - sed "${ac_end}q" $tmp/subs.sed >$tmp/subs.frag - fi - if test ! -s $tmp/subs.frag; then - ac_more_lines=false - else - # The purpose of the label and of the branching condition is to - # speed up the sed processing (if there are no `@' at all, there - # is no need to browse any of the substitutions). - # These are the two extra sed commands mentioned above. - (echo ':t - /@[a-zA-Z_][a-zA-Z_0-9]*@/!b' && cat $tmp/subs.frag) >$tmp/subs-$ac_sed_frag.sed - if test -z "$ac_sed_cmds"; then - ac_sed_cmds="sed -f $tmp/subs-$ac_sed_frag.sed" - else - ac_sed_cmds="$ac_sed_cmds | sed -f $tmp/subs-$ac_sed_frag.sed" - fi - ac_sed_frag=`expr $ac_sed_frag + 1` - ac_beg=$ac_end - ac_end=`expr $ac_end + $ac_max_sed_lines` - fi - done - if test -z "$ac_sed_cmds"; then - ac_sed_cmds=cat - fi -fi # test -n "$CONFIG_FILES" - -for ac_file in : $CONFIG_FILES; do test "x$ac_file" = x: && continue - # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in". - case $ac_file in - - | *:- | *:-:* ) # input from stdin - cat >$tmp/stdin - ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'` - ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;; - *:* ) ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'` - ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;; - * ) ac_file_in=$ac_file.in ;; - esac - - # Compute @srcdir@, @top_srcdir@, and @INSTALL@ for subdirectories. - ac_dir=`(dirname "$ac_file") 2>/dev/null || -$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ - X"$ac_file" : 'X\(//\)[^/]' \| \ - X"$ac_file" : 'X\(//\)$' \| \ - X"$ac_file" : 'X\(/\)' \| \ - . : '\(.\)' 2>/dev/null || -echo X"$ac_file" | - sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } - /^X\(\/\/\)[^/].*/{ s//\1/; q; } - /^X\(\/\/\)$/{ s//\1/; q; } - /^X\(\/\).*/{ s//\1/; q; } - s/.*/./; q'` - { if $as_mkdir_p; then - mkdir -p "$ac_dir" - else - as_dir="$ac_dir" - as_dirs= - while test ! -d "$as_dir"; do - as_dirs="$as_dir $as_dirs" - as_dir=`(dirname "$as_dir") 2>/dev/null || -$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ - X"$as_dir" : 'X\(//\)[^/]' \| \ - X"$as_dir" : 'X\(//\)$' \| \ - X"$as_dir" : 'X\(/\)' \| \ - . : '\(.\)' 2>/dev/null || -echo X"$as_dir" | - sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } - /^X\(\/\/\)[^/].*/{ s//\1/; q; } - /^X\(\/\/\)$/{ s//\1/; q; } - /^X\(\/\).*/{ s//\1/; q; } - s/.*/./; q'` - done - test ! -n "$as_dirs" || mkdir $as_dirs - fi || { { echo "$as_me:660: error: cannot create directory \"$ac_dir\"" >&5 -echo "$as_me: error: cannot create directory \"$ac_dir\"" >&2;} - { (exit 1); exit 1; }; }; } - - ac_builddir=. - -if test "$ac_dir" != .; then - ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` - # A "../" for each directory in $ac_dir_suffix. - ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'` -else - ac_dir_suffix= ac_top_builddir= -fi - -case $srcdir in - .) # No --srcdir option. We are building in place. - ac_srcdir=. - if test -z "$ac_top_builddir"; then - ac_top_srcdir=. - else - ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'` - fi ;; - [\\/]* | ?:[\\/]* ) # Absolute path. - ac_srcdir=$srcdir$ac_dir_suffix; - ac_top_srcdir=$srcdir ;; - *) # Relative path. - ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix - ac_top_srcdir=$ac_top_builddir$srcdir ;; -esac - -# Do not use `cd foo && pwd` to compute absolute paths, because -# the directories may not exist. -case `pwd` in -.) ac_abs_builddir="$ac_dir";; -*) - case "$ac_dir" in - .) ac_abs_builddir=`pwd`;; - [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";; - *) ac_abs_builddir=`pwd`/"$ac_dir";; - esac;; -esac -case $ac_abs_builddir in -.) ac_abs_top_builddir=${ac_top_builddir}.;; -*) - case ${ac_top_builddir}. in - .) ac_abs_top_builddir=$ac_abs_builddir;; - [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;; - *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;; - esac;; -esac -case $ac_abs_builddir in -.) ac_abs_srcdir=$ac_srcdir;; -*) - case $ac_srcdir in - .) ac_abs_srcdir=$ac_abs_builddir;; - [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;; - *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;; - esac;; -esac -case $ac_abs_builddir in -.) ac_abs_top_srcdir=$ac_top_srcdir;; -*) - case $ac_top_srcdir in - .) ac_abs_top_srcdir=$ac_abs_builddir;; - [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;; - *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;; - esac;; -esac - - - - if test x"$ac_file" != x-; then - { echo "$as_me:732: creating $ac_file" >&5 -echo "$as_me: creating $ac_file" >&6;} - rm -f "$ac_file" - fi - # Let's still pretend it is `configure' which instantiates (i.e., don't - # use $as_me), people would be surprised to read: - # /* config.h. Generated by config.status. */ - if test x"$ac_file" = x-; then - configure_input= - else - configure_input="$ac_file. " - fi - configure_input=$configure_input"Generated from `echo $ac_file_in | - sed 's,.*/,,'` by configure." - - # First look for the input files in the build tree, otherwise in the - # src tree. - ac_file_inputs=`IFS=: - for f in $ac_file_in; do - case $f in - -) echo $tmp/stdin ;; - [\\/$]*) - # Absolute (can't be DOS-style, as IFS=:) - test -f "$f" || { { echo "$as_me:755: error: cannot find input file: $f" >&5 -echo "$as_me: error: cannot find input file: $f" >&2;} - { (exit 1); exit 1; }; } - echo "$f";; - *) # Relative - if test -f "$f"; then - # Build tree - echo "$f" - elif test -f "$srcdir/$f"; then - # Source tree - echo "$srcdir/$f" - else - # /dev/null tree - { { echo "$as_me:768: error: cannot find input file: $f" >&5 -echo "$as_me: error: cannot find input file: $f" >&2;} - { (exit 1); exit 1; }; } - fi;; - esac - done` || { (exit 1); exit 1; } - sed " - -:t -/@[a-zA-Z_][a-zA-Z_0-9]*@/!b -s,@configure_input@,$configure_input,;t t -s,@srcdir@,$ac_srcdir,;t t -s,@abs_srcdir@,$ac_abs_srcdir,;t t -s,@top_srcdir@,$ac_top_srcdir,;t t -s,@abs_top_srcdir@,$ac_abs_top_srcdir,;t t -s,@builddir@,$ac_builddir,;t t -s,@abs_builddir@,$ac_abs_builddir,;t t -s,@top_builddir@,$ac_top_builddir,;t t -s,@abs_top_builddir@,$ac_abs_top_builddir,;t t -" $ac_file_inputs | (eval "$ac_sed_cmds") >$tmp/out - rm -f $tmp/stdin - if test x"$ac_file" != x-; then - mv $tmp/out $ac_file - else - cat $tmp/out - rm -f $tmp/out - fi - -done - -# -# CONFIG_COMMANDS section. -# -for ac_file in : $CONFIG_COMMANDS; do test "x$ac_file" = x: && continue - ac_dest=`echo "$ac_file" | sed 's,:.*,,'` - ac_source=`echo "$ac_file" | sed 's,[^:]*:,,'` - ac_dir=`(dirname "$ac_dest") 2>/dev/null || -$as_expr X"$ac_dest" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ - X"$ac_dest" : 'X\(//\)[^/]' \| \ - X"$ac_dest" : 'X\(//\)$' \| \ - X"$ac_dest" : 'X\(/\)' \| \ - . : '\(.\)' 2>/dev/null || -echo X"$ac_dest" | - sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } - /^X\(\/\/\)[^/].*/{ s//\1/; q; } - /^X\(\/\/\)$/{ s//\1/; q; } - /^X\(\/\).*/{ s//\1/; q; } - s/.*/./; q'` - { if $as_mkdir_p; then - mkdir -p "$ac_dir" - else - as_dir="$ac_dir" - as_dirs= - while test ! -d "$as_dir"; do - as_dirs="$as_dir $as_dirs" - as_dir=`(dirname "$as_dir") 2>/dev/null || -$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ - X"$as_dir" : 'X\(//\)[^/]' \| \ - X"$as_dir" : 'X\(//\)$' \| \ - X"$as_dir" : 'X\(/\)' \| \ - . : '\(.\)' 2>/dev/null || -echo X"$as_dir" | - sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } - /^X\(\/\/\)[^/].*/{ s//\1/; q; } - /^X\(\/\/\)$/{ s//\1/; q; } - /^X\(\/\).*/{ s//\1/; q; } - s/.*/./; q'` - done - test ! -n "$as_dirs" || mkdir $as_dirs - fi || { { echo "$as_me:837: error: cannot create directory \"$ac_dir\"" >&5 -echo "$as_me: error: cannot create directory \"$ac_dir\"" >&2;} - { (exit 1); exit 1; }; }; } - - ac_builddir=. - -if test "$ac_dir" != .; then - ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` - # A "../" for each directory in $ac_dir_suffix. - ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'` -else - ac_dir_suffix= ac_top_builddir= -fi - -case $srcdir in - .) # No --srcdir option. We are building in place. - ac_srcdir=. - if test -z "$ac_top_builddir"; then - ac_top_srcdir=. - else - ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'` - fi ;; - [\\/]* | ?:[\\/]* ) # Absolute path. - ac_srcdir=$srcdir$ac_dir_suffix; - ac_top_srcdir=$srcdir ;; - *) # Relative path. - ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix - ac_top_srcdir=$ac_top_builddir$srcdir ;; -esac - -# Do not use `cd foo && pwd` to compute absolute paths, because -# the directories may not exist. -case `pwd` in -.) ac_abs_builddir="$ac_dir";; -*) - case "$ac_dir" in - .) ac_abs_builddir=`pwd`;; - [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";; - *) ac_abs_builddir=`pwd`/"$ac_dir";; - esac;; -esac -case $ac_abs_builddir in -.) ac_abs_top_builddir=${ac_top_builddir}.;; -*) - case ${ac_top_builddir}. in - .) ac_abs_top_builddir=$ac_abs_builddir;; - [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;; - *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;; - esac;; -esac -case $ac_abs_builddir in -.) ac_abs_srcdir=$ac_srcdir;; -*) - case $ac_srcdir in - .) ac_abs_srcdir=$ac_abs_builddir;; - [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;; - *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;; - esac;; -esac -case $ac_abs_builddir in -.) ac_abs_top_srcdir=$ac_top_srcdir;; -*) - case $ac_top_srcdir in - .) ac_abs_top_srcdir=$ac_abs_builddir;; - [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;; - *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;; - esac;; -esac - - - { echo "$as_me:907: executing $ac_dest commands" >&5 -echo "$as_me: executing $ac_dest commands" >&6;} - case $ac_dest in - Tcl.framework ) n=Tcl && - f=$n.framework && v=Versions/$VERSION && - rm -rf $f && mkdir -p $f/$v/Resources && - ln -s $v/$n $v/Resources $f && ln -s ../../../$n $f/$v && - ln -s ../../../../$n-Info.plist $f/$v/Resources/Info.plist && - unset n f v - ;; - esac -done - -{ (exit 0); exit 0; } diff --git a/unix/configure b/unix/configure index 62b1257..427e9fb 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.69 for tcl 8.7. +# Generated by GNU Autoconf 2.69 for tcl 9.0. # # # Copyright (C) 1992-1996, 1998-2012 Free Software Foundation, Inc. @@ -577,8 +577,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='' @@ -1334,7 +1334,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]... @@ -1395,7 +1395,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 @@ -1512,7 +1512,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.69 Copyright (C) 2012 Free Software Foundation, Inc. @@ -2034,7 +2034,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.69. Invocation command line was $ $0 $@ @@ -2386,10 +2386,10 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu -TCL_VERSION=8.7 -TCL_MAJOR_VERSION=8 -TCL_MINOR_VERSION=7 -TCL_PATCH_LEVEL="a4" +TCL_VERSION=9.0 +TCL_MAJOR_VERSION=9 +TCL_MINOR_VERSION=0 +TCL_PATCH_LEVEL="a2" VERSION=${TCL_VERSION} EXTRA_INSTALL_BINARIES=${EXTRA_INSTALL_BINARIES:-"@:"} @@ -9739,9 +9739,6 @@ done $as_echo "#define USE_VFORK 1" >>confdefs.h -$as_echo "#define TCL_DEFAULT_ENCODING \"utf-8\"" >>confdefs.h - - $as_echo "#define TCL_LOAD_FROM_MEMORY 1" >>confdefs.h @@ -11134,7 +11131,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.69. Invocation command line was CONFIG_FILES = $CONFIG_FILES @@ -11191,7 +11188,7 @@ _ACEOF cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`" ac_cs_version="\\ -tcl config.status 8.7 +tcl config.status 9.0 configured by $0, generated by GNU Autoconf 2.69, with options \\"\$ac_cs_config\\" diff --git a/unix/configure.ac b/unix/configure.ac index d480fb7..4f90ce7 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 @@ -22,10 +22,10 @@ m4_ifdef([SC_USE_CONFIG_HEADERS], [ #endif /* _TCLCONFIG */]) ]) -TCL_VERSION=8.7 -TCL_MAJOR_VERSION=8 -TCL_MINOR_VERSION=7 -TCL_PATCH_LEVEL="a4" +TCL_VERSION=9.0 +TCL_MAJOR_VERSION=9 +TCL_MINOR_VERSION=0 +TCL_PATCH_LEVEL="a2" VERSION=${TCL_VERSION} EXTRA_INSTALL_BINARIES=${EXTRA_INSTALL_BINARIES:-"@:"} @@ -606,8 +606,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, diff --git a/unix/tcl.m4 b/unix/tcl.m4 index 9f68967..0473692 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 e148f36..e703e27 100644 --- a/unix/tcl.spec +++ b/unix/tcl.spec @@ -4,7 +4,7 @@ Name: tcl Summary: Tcl scripting language development environment -Version: 8.7a3 +Version: 9.0a1 Release: 2 License: BSD Group: Development/Languages diff --git a/unix/tclConfig.h.in b/unix/tclConfig.h.in index 1328d51..731ed95 100644 --- a/unix/tclConfig.h.in +++ b/unix/tclConfig.h.in @@ -415,9 +415,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 406b7ca..f6ad8ce 100644 --- a/unix/tclEpollNotfy.c +++ b/unix/tclEpollNotfy.c @@ -240,7 +240,7 @@ PlatformEventsControl( newEvent.events |= EPOLLOUT; } if (isNew) { - newPedPtr = (struct PlatformEventData *)ckalloc(sizeof(struct PlatformEventData)); + newPedPtr = (struct PlatformEventData *)Tcl_Alloc(sizeof(struct PlatformEventData)); newPedPtr->filePtr = filePtr; newPedPtr->tsdPtr = tsdPtr; filePtr->pedPtr = newPedPtr; @@ -320,14 +320,14 @@ PlatformEventsFinalize( 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); @@ -372,7 +372,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) { @@ -393,7 +393,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); @@ -552,7 +552,7 @@ Tcl_CreateFileHandler( } } if (filePtr == NULL) { - filePtr = (FileHandler *)ckalloc(sizeof(FileHandler)); + filePtr = (FileHandler *)Tcl_Alloc(sizeof(FileHandler)); filePtr->fd = fd; filePtr->readyMask = 0; filePtr->nextPtr = tsdPtr->firstFileHandlerPtr; @@ -622,7 +622,7 @@ Tcl_DeleteFileHandler( PlatformEventsControl(filePtr, tsdPtr, EPOLL_CTL_DEL, 0); if (filePtr->pedPtr) { - ckfree(filePtr->pedPtr); + Tcl_Free(filePtr->pedPtr); } /* @@ -634,7 +634,7 @@ Tcl_DeleteFileHandler( } else { prevPtr->nextPtr = filePtr->nextPtr; } - ckfree(filePtr); + Tcl_Free(filePtr); } } @@ -736,7 +736,7 @@ Tcl_WaitForEvent( if (filePtr->readyMask == 0) { FileHandlerEvent *fileEvPtr = (FileHandlerEvent *) - ckalloc(sizeof(FileHandlerEvent)); + Tcl_Alloc(sizeof(FileHandlerEvent)); fileEvPtr->header.proc = FileHandlerEventProc; fileEvPtr->fd = filePtr->fd; @@ -813,7 +813,7 @@ Tcl_WaitForEvent( if (filePtr->readyMask == 0) { FileHandlerEvent *fileEvPtr = (FileHandlerEvent *) - ckalloc(sizeof(FileHandlerEvent)); + Tcl_Alloc(sizeof(FileHandlerEvent)); fileEvPtr->header.proc = FileHandlerEventProc; fileEvPtr->fd = filePtr->fd; diff --git a/unix/tclKqueueNotfy.c b/unix/tclKqueueNotfy.c index 4daab7c..184fb2b 100644 --- a/unix/tclKqueueNotfy.c +++ b/unix/tclKqueueNotfy.c @@ -222,7 +222,7 @@ PlatformEventsControl( struct stat fdStat; if (isNew) { - newPedPtr = (struct PlatformEventData *)ckalloc(sizeof(struct PlatformEventData)); + newPedPtr = (struct PlatformEventData *)Tcl_Alloc(sizeof(struct PlatformEventData)); newPedPtr->filePtr = filePtr; newPedPtr->tsdPtr = tsdPtr; filePtr->pedPtr = newPedPtr; @@ -344,7 +344,7 @@ PlatformEventsFinalize( tsdPtr->eventsFd = 0; } if (tsdPtr->readyEvents) { - ckfree(tsdPtr->readyEvents); + Tcl_Free(tsdPtr->readyEvents); tsdPtr->maxReadyEvents = 0; } pthread_mutex_unlock(&tsdPtr->notifierMutex); @@ -409,13 +409,13 @@ PlatformEventsInit(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); @@ -580,7 +580,7 @@ Tcl_CreateFileHandler( } } if (filePtr == NULL) { - filePtr = (FileHandler *)ckalloc(sizeof(FileHandler)); + filePtr = (FileHandler *)Tcl_Alloc(sizeof(FileHandler)); filePtr->fd = fd; filePtr->readyMask = 0; filePtr->nextPtr = tsdPtr->firstFileHandlerPtr; @@ -649,7 +649,7 @@ Tcl_DeleteFileHandler( PlatformEventsControl(filePtr, tsdPtr, EV_DELETE, 0); if (filePtr->pedPtr) { - ckfree(filePtr->pedPtr); + Tcl_Free(filePtr->pedPtr); } /* @@ -661,7 +661,7 @@ Tcl_DeleteFileHandler( } else { prevPtr->nextPtr = filePtr->nextPtr; } - ckfree(filePtr); + Tcl_Free(filePtr); } } @@ -769,7 +769,7 @@ Tcl_WaitForEvent( if (filePtr->readyMask == 0) { FileHandlerEvent *fileEvPtr = (FileHandlerEvent *) - ckalloc(sizeof(FileHandlerEvent)); + Tcl_Alloc(sizeof(FileHandlerEvent)); fileEvPtr->header.proc = FileHandlerEventProc; fileEvPtr->fd = filePtr->fd; @@ -829,7 +829,7 @@ Tcl_WaitForEvent( if (filePtr->readyMask == 0) { FileHandlerEvent *fileEvPtr = (FileHandlerEvent *) - ckalloc(sizeof(FileHandlerEvent)); + Tcl_Alloc(sizeof(FileHandlerEvent)); fileEvPtr->header.proc = FileHandlerEventProc; fileEvPtr->fd = filePtr->fd; diff --git a/unix/tclLoadDl.c b/unix/tclLoadDl.c index 2a09037..c7ce0a2 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, -1, &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, -1); @@ -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 de738e9..2a45758 100644 --- a/unix/tclLoadDyld.c +++ b/unix/tclLoadDyld.c @@ -184,7 +184,7 @@ TclpDlopen( */ nativePath = (const char *)Tcl_FSGetNativePath(pathPtr); - nativeFileName = Tcl_UtfToExternalDString(NULL, Tcl_GetString(pathPtr), + nativeFileName = Tcl_UtfToExternalDString(NULL, TclGetString(pathPtr), -1, &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 3f59998..b9ad9fc 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 b8423dd..6940f18 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 876896a..3dcf2c7 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 5f30857..8b19578 100644 --- a/unix/tclSelectNotfy.c +++ b/unix/tclSelectNotfy.c @@ -474,7 +474,7 @@ Tcl_CreateFileHandler( } } if (filePtr == NULL) { - filePtr = (FileHandler *)ckalloc(sizeof(FileHandler)); + filePtr = (FileHandler *)Tcl_Alloc(sizeof(FileHandler)); filePtr->fd = fd; filePtr->readyMask = 0; filePtr->nextPtr = tsdPtr->firstFileHandlerPtr; @@ -593,7 +593,7 @@ Tcl_DeleteFileHandler( } else { prevPtr->nextPtr = filePtr->nextPtr; } - ckfree(filePtr); + Tcl_Free(filePtr); } } @@ -887,7 +887,7 @@ Tcl_WaitForEvent( if (filePtr->readyMask == 0) { FileHandlerEvent *fileEvPtr = - (FileHandlerEvent *)ckalloc(sizeof(FileHandlerEvent)); + (FileHandlerEvent *)Tcl_Alloc(sizeof(FileHandlerEvent)); fileEvPtr->header.proc = FileHandlerEventProc; fileEvPtr->fd = filePtr->fd; diff --git a/unix/tclUnixChan.c b/unix/tclUnixChan.c index 9273b8e..b515e37 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, Tcl_WideInt length); static Tcl_WideInt 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. */ @@ -282,7 +274,7 @@ FileInputProc( * nonblocking, the read will never block. */ - bytesRead = read(fsPtr->fd, buf, (size_t) toRead); + bytesRead = read(fsPtr->fd, buf, toRead); if (bytesRead >= 0) { return bytesRead; } @@ -329,7 +321,7 @@ FileOutputProc( return 0; } - written = write(fsPtr->fd, buf, (size_t) toWrite); + written = write(fsPtr->fd, buf, toWrite); if (written >= 0) { return written; } @@ -380,7 +372,7 @@ FileCloseProc( errorCode = errno; } } - ckfree(fsPtr); + Tcl_Free(fsPtr); return errorCode; } @@ -431,67 +423,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; - Tcl_WideInt 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 @@ -660,7 +591,7 @@ TtySetOptionProc( const char *value) /* New value for option. */ { TtyState *fsPtr = (TtyState *)instanceData; - unsigned int len, vlen; + size_t len, vlen; TtyAttrs tty; int argc; const char **argv; @@ -745,7 +676,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; } @@ -768,7 +699,7 @@ TtySetOptionProc( } iostate.c_cc[VSTOP] = character; } - ckfree(argv); + Tcl_Free(argv); tcsetattr(fsPtr->fileState.fd, TCSADRAIN, &iostate); return TCL_OK; @@ -810,14 +741,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) { @@ -841,7 +772,7 @@ TtySetOptionProc( } #else /* TIOCSBRK & TIOCCBRK */ UNSUPPORTED_OPTION("-ttycontrol BREAK"); - ckfree(argv); + Tcl_Free(argv); return TCL_ERROR; #endif /* TIOCSBRK & TIOCCBRK */ } else { @@ -852,13 +783,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"); @@ -999,7 +930,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; @@ -1727,7 +1658,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 @@ -1752,7 +1683,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; } } @@ -1786,32 +1717,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 55c5fa9..a088857 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> @@ -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); @@ -340,7 +338,7 @@ FreePwBuf( { 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); @@ -523,7 +521,7 @@ FreeGrBuf( { 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 eee47d7..23dd01a 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; } @@ -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; @@ -1501,10 +1504,11 @@ SetGroupAttribute( Tcl_DString ds; struct group *groupPtr = NULL; const char *string; + size_t length; - string = TclGetString(attributePtr); + string = TclGetStringFromObj(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 = TclGetStringFromObj(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 = TclGetStringFromObj(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_ExternalToUtfDString(NULL, normPath, newNormLen, &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 = TclGetStringFromObj(dirObj, &length); + Tcl_UtfToExternalDString(NULL, string, length, &templ); } else { Tcl_DStringInit(&templ); Tcl_DStringAppend(&templ, DefaultTempDir(), -1); /* INTL: native */ @@ -2182,8 +2188,8 @@ TclUnixOpenTemporaryFile( TclDStringAppendLiteral(&templ, "/"); if (basenameObj) { - string = TclGetString(basenameObj); - Tcl_UtfToExternalDString(NULL, string, basenameObj->length, &tmp); + string = TclGetStringFromObj(basenameObj, &length); + Tcl_UtfToExternalDString(NULL, string, length, &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 = TclGetStringFromObj(extensionObj, &length); + Tcl_UtfToExternalDString(NULL, string, length, &tmp); TclDStringAppendDString(&templ, &tmp); fd = mkstemps(Tcl_DStringValue(&templ), Tcl_DStringLength(&tmp)); Tcl_DStringFree(&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 fdf7904..e64e182 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]; char name[PATH_MAX * 3 + 1]; @@ -729,7 +729,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; @@ -949,6 +949,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 +961,8 @@ TclpObjLink( if (transPtr == NULL) { return NULL; } - target = TclGetString(transPtr); - target = Tcl_UtfToExternalDString(NULL, target, transPtr->length, &ds); + target = TclGetStringFromObj(transPtr, &length); + target = Tcl_UtfToExternalDString(NULL, target, length, &ds); Tcl_DecrRefCount(transPtr); if (symlink(target, src) != 0) { @@ -1114,8 +1115,7 @@ TclNativeCreateNativeRep( Tcl_IncrRefCount(validPathPtr); } - str = TclGetString(validPathPtr); - len = validPathPtr->length; + str = TclGetStringFromObj(validPathPtr, &len); Tcl_UtfToExternalDString(NULL, str, len, &ds); len = Tcl_DStringLength(&ds) + sizeof(char); if (strlen(Tcl_DStringValue(&ds)) < len - sizeof(char)) { @@ -1125,7 +1125,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 +1166,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 12cbd2c..0332803 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 @@ -512,7 +512,7 @@ TclpInitLibraryPath( str = Tcl_JoinPath(pathc, pathv, &ds); Tcl_ListObjAppendElement(NULL, pathPtr, TclDStringToObj(&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 = TclGetStringFromObj(pathPtr, lengthPtr); + *valuePtr = (char *)Tcl_Alloc(*lengthPtr + 1); memcpy(*valuePtr, str, *lengthPtr + 1); Tcl_DecrRefCount(pathPtr); } @@ -989,7 +988,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). * @@ -999,16 +998,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 5d02486..b923851 100644 --- a/unix/tclUnixPipe.c +++ b/unix/tclUnixPipe.c @@ -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. */ @@ -524,7 +524,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; @@ -744,7 +744,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; @@ -878,7 +878,7 @@ TclGetAndDetachPids( } Tcl_SetObjResult(interp, pidsObj); if (pipePtr->numPids > 0) { - ckfree(pipePtr->pidPtr); + Tcl_Free(pipePtr->pidPtr); pipePtr->numPids = 0; } } @@ -1008,9 +1008,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 +1058,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 +1104,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) { @@ -1272,7 +1272,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; } diff --git a/unix/tclUnixPort.h b/unix/tclUnixPort.h index bb944e4..77426c8 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 SOCKET unsigned int # define WSAEWOULDBLOCK 10035 typedef unsigned short WCHAR; @@ -679,9 +676,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 8c9386c..b1e61ef 100644 --- a/unix/tclUnixSock.c +++ b/unix/tclUnixSock.c @@ -159,11 +159,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. */ @@ -223,7 +219,7 @@ printaddrinfo( static void InitializeHostName( char **valuePtr, - unsigned int *lengthPtr, + size_t *lengthPtr, Tcl_Encoding *encodingPtr) { const char *native = NULL; @@ -245,12 +241,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) { @@ -289,11 +285,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'; } } @@ -319,7 +315,8 @@ InitializeHostName( const char * Tcl_GetHostName(void) { - return Tcl_GetString(TclGetProcessGlobalValue(&hostName)); + Tcl_Obj *tclObj = TclGetProcessGlobalValue(&hostName); + return TclGetString(tclObj); } /* @@ -544,7 +541,7 @@ TcpInputProc( if (WaitForConnect(statePtr, errorCodePtr) != 0) { return -1; } - bytesRead = recv(statePtr->fds.fd, buf, (size_t) bufSize, 0); + bytesRead = recv(statePtr->fds.fd, buf, bufSize, 0); if (bytesRead >= 0) { return bytesRead; } @@ -594,7 +591,7 @@ TcpOutputProc( if (WaitForConnect(statePtr, errorCodePtr) != 0) { return -1; } - written = send(statePtr->fds.fd, buf, (size_t) toWrite, 0); + written = send(statePtr->fds.fd, buf, toWrite, 0); if (written >= 0) { return written; @@ -652,7 +649,7 @@ TcpCloseProc( while (fds != NULL) { TcpFdList *next = fds->next; - ckfree(fds); + Tcl_Free(fds); fds = next; } if (statePtr->addrlist != NULL) { @@ -661,7 +658,7 @@ TcpCloseProc( if (statePtr->myaddrlist != NULL) { freeaddrinfo(statePtr->myaddrlist); } - ckfree(statePtr); + Tcl_Free(statePtr); return errorCode; } @@ -1434,7 +1431,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; @@ -1457,7 +1454,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; @@ -1513,7 +1510,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; @@ -1524,7 +1521,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; @@ -1736,14 +1733,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, (long) 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; } @@ -1827,7 +1824,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/tclUnixThrd.c b/unix/tclUnixThrd.c index 92399f4..bb8f517 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. */ { @@ -577,7 +569,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); @@ -641,7 +633,7 @@ TclpFinalizeMutex( if (pmutexPtr != NULL) { PMutexDestroy(pmutexPtr); - ckfree(pmutexPtr); + Tcl_Free(pmutexPtr); *mutexPtr = NULL; } } @@ -687,7 +679,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); @@ -775,59 +767,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. */ @@ -917,7 +861,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 07b3065..d66b9c0 100644 --- a/unix/tclUnixTime.c +++ b/unix/tclUnixTime.c @@ -16,37 +16,9 @@ #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); static void NativeGetTime(Tcl_Time *timebuf, @@ -77,7 +49,7 @@ void *tclTimeClientData = NULL; *---------------------------------------------------------------------- */ -unsigned long +Tcl_WideUInt TclpGetSeconds(void) { return time(NULL); @@ -128,30 +100,30 @@ TclpGetMicroseconds(void) *---------------------------------------------------------------------- */ -unsigned long +Tcl_WideUInt TclpGetClicks(void) { - unsigned long now; + Tcl_WideUInt now; #ifdef NO_GETTOD if (tclGetTimeProcPtr != NativeGetTime) { Tcl_Time time; tclGetTimeProcPtr(&time, tclTimeClientData); - now = time.sec*1000000 + time.usec; + now = (Tcl_WideUInt)time.sec*1000000 + time.usec; } else { /* * A semi-NativeGetTime, specialized to clicks. */ struct tms dummy; - now = (unsigned long) times(&dummy); + now = (Tcl_WideUInt) times(&dummy); } #else Tcl_Time time; tclGetTimeProcPtr(&time, tclTimeClientData); - now = time.sec*1000000 + time.usec; + now = (Tcl_WideUInt)time.sec*1000000 + time.usec; #endif return now; @@ -164,7 +136,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. * @@ -321,116 +293,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 @@ -542,72 +404,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 cf99fb2..f31503d 100644 --- a/unix/tclXtNotify.c +++ b/unix/tclXtNotify.c @@ -268,7 +268,7 @@ static void SetTimer( const Tcl_Time *timePtr) /* Timeout value, may be NULL. */ { - long timeout; + unsigned long timeout; if (!initialized) { InitNotifier(); @@ -281,7 +281,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; } @@ -359,7 +359,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; @@ -470,7 +470,7 @@ DeleteFileHandler( if (filePtr->mask & TCL_EXCEPTION) { XtRemoveInput(filePtr->except); } - ckfree(filePtr); + Tcl_Free(filePtr); } /* @@ -525,7 +525,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/win/Makefile.in b/win/Makefile.in index ccdf00b..ae5abac 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_ATL_XP_TARGETING=1 -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 @@ -857,7 +857,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"; \ @@ -876,20 +876,20 @@ install-libraries: libraries install-tzdata install-msgs $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/cookiejar0.2"; \ done; @echo "Installing package http 2.10.0a1 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/http/http.tcl "$(MODULE_INSTALL_DIR)/8.6/http-2.10.0a1.tm"; + @$(COPY) $(ROOT_DIR)/library/http/http.tcl "$(MODULE_INSTALL_DIR)/9.0/http-2.10.0a1.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.3 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl "$(MODULE_INSTALL_DIR)/8.5/tcltest-2.5.3.tm"; + @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl "$(MODULE_INSTALL_DIR)/9.0/tcltest-2.5.3.tm"; @echo "Installing package platform 1.0.14 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/platform/platform.tcl "$(MODULE_INSTALL_DIR)/8.4/platform-1.0.14.tm"; + @$(COPY) $(ROOT_DIR)/library/platform/platform.tcl "$(MODULE_INSTALL_DIR)/9.0/platform-1.0.14.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"; \ @@ -1096,7 +1096,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 @@ -79,9 +79,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 is +Note that in order to run tclsh90.exe, you must ensure that tcl90.dll is on your path, in the system directory, or in the directory containing -tclsh87.exe. +tclsh90.exe. Note: Tcl no longer provides support for Win32s. diff --git a/win/configure b/win/configure index 34f163d..ca6a9da 100755 --- a/win/configure +++ b/win/configure @@ -780,7 +780,6 @@ ac_user_opts=' enable_option_checking with_encoding enable_shared -enable_time64bit enable_64bit enable_zipfs enable_symbols @@ -1403,7 +1402,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) @@ -2152,10 +2150,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="a4" +TCL_VERSION=9.0 +TCL_MAJOR_VERSION=9 +TCL_MINOR_VERSION=0 +TCL_PATCH_LEVEL="a2" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION TCL_DDE_VERSION=1.4 @@ -3793,25 +3791,6 @@ $as_echo "#define STATIC_BUILD 1" >>confdefs.h #-------------------------------------------------------------------- -# Check whether --enable-time64bit was given. -#-------------------------------------------------------------------- - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking force of 64-bit time_t" >&5 -$as_echo_n "checking force of 64-bit time_t... " >&6; } -# Check whether --enable-time64bit was given. -if test "${enable_time64bit+set}" = set; then : - enableval=$enable_time64bit; tcl_ok=$enableval -else - tcl_ok=no -fi - -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: \"$tcl_ok\"" >&5 -$as_echo "\"$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. diff --git a/win/configure.ac b/win/configure.ac index ce0a0ce..ba8487a 100644 --- a/win/configure.ac +++ b/win/configure.ac @@ -11,10 +11,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="a4" +TCL_VERSION=9.0 +TCL_MAJOR_VERSION=9 +TCL_MINOR_VERSION=0 +TCL_PATCH_LEVEL="a2" 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, - AC_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. diff --git a/win/makefile.vc b/win/makefile.vc index a28d6bf..05fb6ad 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,nothreads,pdbs,profile,static,staticpkg,symbols,thrdalloc,time64bit,unchecked,utfmax,none
+# OPTS=msvcrt,nothreads,pdbs,profile,static,staticpkg,symbols,thrdalloc,unchecked,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.
@@ -71,13 +71,9 @@ # inside it.
# 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).
-# utfmax = Forces a build allowing 4-byte UTF-8 sequences
-# internally.
#
# STATS=compdbg,memdbg,none
# Sets optional memory and bytecode compiler debugging code added
@@ -898,24 +894,16 @@ install-binaries: install-libraries: tclConfig tcl-nmake install-msgs install-tzdata
@if not exist "$(SCRIPT_INSTALL_DIR)" \
$(MKDIR) "$(SCRIPT_INSTALL_DIR)"
- @if not exist "$(SCRIPT_INSTALL_DIR)\opt0.4" \
+ @if not exist "$(SCRIPT_INSTALL_DIR)\opt0.4$(NULL)" \
$(MKDIR) "$(SCRIPT_INSTALL_DIR)\opt0.4"
- @if not exist "$(SCRIPT_INSTALL_DIR)\cookiejar0.2" \
+ @if not exist "$(SCRIPT_INSTALL_DIR)\cookiejar0.2$(NULL)" \
$(MKDIR) "$(SCRIPT_INSTALL_DIR)\cookiejar0.2"
- @if not exist "$(MODULE_INSTALL_DIR)" \
+ @if not exist "$(MODULE_INSTALL_DIR)$(NULL)" \
$(MKDIR) "$(MODULE_INSTALL_DIR)"
- @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)\8.5" \
- $(MKDIR) "$(MODULE_INSTALL_DIR)\8.5"
- @if not exist "$(MODULE_INSTALL_DIR)\8.6" \
- $(MKDIR) "$(MODULE_INSTALL_DIR)\8.6"
- @if not exist "$(MODULE_INSTALL_DIR)\8.7" \
- $(MKDIR) "$(MODULE_INSTALL_DIR)\8.7"
- @if not exist "$(LIB_INSTALL_DIR)\nmake" \
- $(MKDIR) "$(LIB_INSTALL_DIR)\nmake"
+ @if not exist "$(MODULE_INSTALL_DIR)\9.0$(NULL)" \
+ $(MKDIR) "$(MODULE_INSTALL_DIR)\9.0"
+ @if not exist "$(MODULE_INSTALL_DIR)\9.0\platform$(NULL)" \
+ $(MKDIR) "$(MODULE_INSTALL_DIR)\9.0\platform"
@echo Installing header files
@$(CPY) "$(GENERICDIR)\tcl.h" "$(INCLUDE_INSTALL_DIR)\"
@$(CPY) "$(GENERICDIR)\tclDecls.h" "$(INCLUDE_INSTALL_DIR)\"
@@ -952,19 +940,19 @@ install-libraries: tclConfig tcl-nmake install-msgs install-tzdata "$(SCRIPT_INSTALL_DIR)\opt0.4\"
@echo Installing package http $(PKG_HTTP_VER) as a Tcl Module
@$(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
@$(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
@$(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
@$(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"
@echo Installing $(TCLDDELIBNAME)
!if $(STATIC_BUILD)
!if !$(TCL_USE_STATIC_PACKAGES)
diff --git a/win/tcl.dsp b/win/tcl.dsp index 7ab2a38..8b20d66 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 OPTS=none 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 OPTS=threads 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 ""
diff --git a/win/tcl.hpj.in b/win/tcl.hpj.in index 08d411d..a3d1a49 100644 --- a/win/tcl.hpj.in +++ b/win/tcl.hpj.in @@ -5,9 +5,9 @@ HCW=0 LCID=0x409 0x0 0x0 ;English (United States)
REPORT=Yes
TITLE=Tcl/Tk Reference Manual
-CNT=tcl87.cnt
+CNT=tcl90.cnt
COPYRIGHT=Copyright © 2000 Ajuba Solutions
-HLP=tcl87.hlp
+HLP=tcl90.hlp
[FILES]
tcl.rtf
@@ -970,13 +970,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 3ab9fc8..a9fb3bd 100644 --- a/win/tclAppInit.c +++ b/win/tclAppInit.c @@ -269,11 +269,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 f667b05..6a9d96d 100644 --- a/win/tclWin32Dll.c +++ b/win/tclWin32Dll.c @@ -152,7 +152,7 @@ DllMain( *---------------------------------------------------------------------- */ -HINSTANCE +void * TclWinGetTclInstance(void) { return hInstance; @@ -255,8 +255,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); @@ -349,8 +349,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 @@ -385,7 +385,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; @@ -411,7 +411,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; @@ -421,76 +421,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 544c000..74dbb38 100644 --- a/win/tclWinChan.c +++ b/win/tclWinChan.c @@ -85,10 +85,6 @@ static int FileInputProc(ClientData instanceData, char *buf, int toRead, int *errorCode); static int FileOutputProc(ClientData 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 Tcl_WideInt FileWideSeekProc(ClientData instanceData, Tcl_WideInt offset, int mode, int *errorCode); static void FileSetupProc(ClientData clientData, int flags); @@ -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. */ @@ -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); @@ -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) { - TclWinConvertError(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) { - TclWinConvertError(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. @@ -1327,7 +1240,7 @@ TclpGetDefaultStdChannel( if (Tcl_SetChannelOption(NULL,channel,"-translation","auto")!=TCL_OK || Tcl_SetChannelOption(NULL,channel,"-eofchar","\032 {}")!=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 +1290,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 diff --git a/win/tclWinConsole.c b/win/tclWinConsole.c index 3b8753b..7e20ee9 100644 --- a/win/tclWinConsole.c +++ b/win/tclWinConsole.c @@ -180,7 +180,7 @@ static BOOL WriteConsoleBytes(HANDLE hConsole, 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. */ @@ -462,7 +462,7 @@ ConsoleCheckProc( } if (needEvent) { - ConsoleEvent *evPtr = (ConsoleEvent *)ckalloc(sizeof(ConsoleEvent)); + ConsoleEvent *evPtr = (ConsoleEvent *)Tcl_Alloc(sizeof(ConsoleEvent)); infoPtr->flags |= CONSOLE_PENDING; evPtr->header.proc = ConsoleEventProc; @@ -622,10 +622,10 @@ ConsoleCloseProc( } } if (consolePtr->writeBuf != NULL) { - ckfree(consolePtr->writeBuf); + Tcl_Free(consolePtr->writeBuf); consolePtr->writeBuf = 0; } - ckfree(consolePtr); + Tcl_Free(consolePtr); return errorCode; } @@ -789,10 +789,10 @@ ConsoleOutputProc( */ 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; @@ -1326,7 +1326,7 @@ TclWinOpenConsoleChannel( * See if a channel with this handle already exists. */ - infoPtr = (ConsoleInfo *)ckalloc(sizeof(ConsoleInfo)); + infoPtr = (ConsoleInfo *)Tcl_Alloc(sizeof(ConsoleInfo)); memset(infoPtr, 0, sizeof(ConsoleInfo)); infoPtr->validMask = permissions; diff --git a/win/tclWinError.c b/win/tclWinError.c index 18f290f..f93f000 100644 --- a/win/tclWinError.c +++ b/win/tclWinError.c @@ -349,11 +349,11 @@ static const unsigned char wsaErrorTable[] = { void TclWinConvertError( - DWORD errCode) /* Win32 error code. */ + int 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 @@ TclWinConvertError( *---------------------------------------------------------------------- */ -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 ad4bae1..5d2fdbe 100644 --- a/win/tclWinFCmd.c +++ b/win/tclWinFCmd.c @@ -378,8 +378,8 @@ DoRenameFile( Tcl_SetErrno(EXDEV); } - ckfree(srcArgv); - ckfree(dstArgv); + Tcl_Free((void *)srcArgv); + Tcl_Free((void *)dstArgv); } /* @@ -915,8 +915,8 @@ TclpObjCopyDirectory( Tcl_DStringInit(&srcString); Tcl_DStringInit(&dstString); - Tcl_UtfToWCharDString(Tcl_GetString(normSrcPtr), -1, &srcString); - Tcl_UtfToWCharDString(Tcl_GetString(normDestPtr), -1, &dstString); + Tcl_UtfToWCharDString(TclGetString(normSrcPtr), -1, &srcString); + Tcl_UtfToWCharDString(TclGetString(normDestPtr), -1, &dstString); ret = TraverseWinTree(TraversalCopy, &srcString, &dstString, &ds); @@ -989,7 +989,7 @@ TclpObjRemoveDirectory( return TCL_ERROR; } Tcl_DStringInit(&native); - Tcl_UtfToWCharDString(Tcl_GetString(normPtr), -1, &native); + Tcl_UtfToWCharDString(TclGetString(normPtr), -1, &native); ret = DoRemoveDirectory(&native, recursive, &ds); Tcl_DStringFree(&native); } else { @@ -1535,7 +1535,7 @@ GetWinFileAttributes( * We test for, and fix that case, here. */ - int len; + size_t len; const char *str = TclGetStringFromObj(fileName, &len); if (len < 4) { @@ -1597,6 +1597,7 @@ ConvertFileNameFormat( { int 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,7 +1622,6 @@ ConvertFileNameFormat( for (i = 0; i < pathc; i++) { Tcl_Obj *elt; char *pathv; - int length; Tcl_ListObjIndex(NULL, splitPath, i, &elt); @@ -1896,7 +1896,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 89f485a..a35c6eb 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, ...); /* *-------------------------------------------------------------------- @@ -803,7 +803,7 @@ NativeWriteReparse( *---------------------------------------------------------------------- */ -TCL_NORETURN void +void tclWinDebugPanic( const char *format, ...) { @@ -833,16 +833,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(); } /* @@ -869,16 +859,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, MAX_PATH); WideCharToMultiByte(CP_UTF8, 0, wName, -1, name, sizeof(name), NULL, NULL); @@ -933,10 +914,10 @@ TclpMatchInDirectory( * Match a single file directly. */ - int len; DWORD attr; WIN32_FILE_ATTRIBUTE_DATA data; - const char *str = TclGetStringFromObj(norm, &len); + size_t length = 0; + const char *str = TclGetStringFromObj(norm, &length); native = (const WCHAR *)Tcl_FSGetNativePath(pathPtr); @@ -946,7 +927,7 @@ TclpMatchInDirectory( } attr = data.dwFileAttributes; - if (NativeMatchType(WinIsDrive(str,len), attr, native, types)) { + if (NativeMatchType(WinIsDrive(str, length), attr, native, types)) { Tcl_ListObjAppendElement(interp, resultPtr, pathPtr); } } @@ -957,7 +938,7 @@ TclpMatchInDirectory( WIN32_FIND_DATAW data; const char *dirName; /* UTF-8 dir name, later with pattern * appended. */ - int dirLength; + size_t dirLength; int matchSpecialDots; Tcl_DString ds; /* Native encoding of dir, also used * temporarily for other things. */ @@ -2290,7 +2271,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. @@ -2298,7 +2279,7 @@ NativeStatMode( *------------------------------------------------------------------------ */ -static time_t +static __time64_t ToCTime( FILETIME fileTime) /* UTC time */ { @@ -2307,7 +2288,7 @@ ToCTime( convertedTime.LowPart = fileTime.dwLowDateTime; convertedTime.HighPart = (LONG) fileTime.dwHighDateTime; - return (time_t) ((convertedTime.QuadPart - + return (__time64_t) ((convertedTime.QuadPart - (Tcl_WideInt) POSIX_EPOCH_AS_FILETIME) / (Tcl_WideInt) 10000000); } @@ -2316,7 +2297,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. @@ -2326,7 +2307,7 @@ ToCTime( static void FromCTime( - time_t posixTime, + __time64_t posixTime, FILETIME *fileTime) /* UTC Time */ { LARGE_INTEGER convertedTime; @@ -2473,7 +2454,7 @@ TclpFilesystemPathType( if (normPath == NULL) { return NULL; } - path = Tcl_GetString(normPath); + path = TclGetString(normPath); if (path == NULL) { return NULL; } @@ -2553,7 +2534,7 @@ TclpObjNormalizePath( Tcl_DString ds; /* Some workspace. */ Tcl_DStringInit(&dsNorm); - path = Tcl_GetString(pathPtr); + path = TclGetString(pathPtr); currentPathEndPosition = path + nextCheckpoint; if (*currentPathEndPosition == '/') { @@ -2651,12 +2632,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); @@ -2816,14 +2797,14 @@ TclpObjNormalizePath( * Not the end of the string. */ - int len; Tcl_Obj *tmpPathPtr; + size_t length; tmpPathPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), nextCheckpoint); Tcl_AppendToObj(tmpPathPtr, lastValidPathEnd, -1); - path = TclGetStringFromObj(tmpPathPtr, &len); - Tcl_SetStringObj(pathPtr, path, len); + path = TclGetStringFromObj(tmpPathPtr, &length); + Tcl_SetStringObj(pathPtr, path, length); Tcl_DecrRefCount(tmpPathPtr); } else { /* @@ -2891,7 +2872,7 @@ TclWinVolumeRelativeNormalize( * current volume. */ - const char *drive = Tcl_GetString(useThisCwd); + const char *drive = TclGetString(useThisCwd); absolutePath = Tcl_NewStringObj(drive,2); Tcl_AppendToObj(absolutePath, path, -1); @@ -2906,7 +2887,7 @@ TclWinVolumeRelativeNormalize( * also on drive C. */ - int cwdLen; + size_t cwdLen; const char *drive = TclGetStringFromObj(useThisCwd, &cwdLen); char drive_cur = path[0]; @@ -2980,7 +2961,7 @@ TclpNativeToNormalized( { Tcl_DString ds; Tcl_Obj *objPtr; - int len; + size_t len; char *copy, *p; Tcl_DStringInit(&ds); @@ -3080,8 +3061,7 @@ TclNativeCreateNativeRep( Tcl_IncrRefCount(validPathPtr); } - str = Tcl_GetString(validPathPtr); - len = validPathPtr->length; + str = TclGetStringFromObj(validPathPtr, &len); if (strlen(str) != len) { /* @@ -3112,7 +3092,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; } @@ -3210,7 +3190,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; } @@ -3326,7 +3306,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); } @@ -3342,7 +3322,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 5c3901b..5c0f976 100644 --- a/win/tclWinInit.c +++ b/win/tclWinInit.c @@ -180,14 +180,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); @@ -225,7 +225,7 @@ TclpInitLibraryPath( *encodingPtr = NULL; bytes = TclGetStringFromObj(pathPtr, &length); *lengthPtr = length++; - *valuePtr = (char *)ckalloc(length); + *valuePtr = (char *)Tcl_Alloc(length); memcpy(*valuePtr, bytes, length); Tcl_DecrRefCount(pathPtr); } @@ -316,7 +316,7 @@ AppendEnvironment( objPtr = Tcl_NewStringObj(buf, -1); } Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); - ckfree(pathv); + Tcl_Free((void *)pathv); } } @@ -340,10 +340,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; @@ -362,7 +362,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); } @@ -388,10 +388,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; @@ -410,7 +410,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); } @@ -614,9 +614,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. @@ -627,16 +628,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; @@ -647,7 +648,7 @@ TclpFindVariable( */ length = strlen(name); - nameUpper = (char *)ckalloc(length + 1); + nameUpper = (char *)Tcl_Alloc(length + 1); memcpy(nameUpper, name, length+1); Tcl_UtfToUpper(nameUpper); @@ -667,7 +668,7 @@ TclpFindVariable( if (p1 == NULL) { continue; } - length = (int) (p1 - envUpper); + length = p1 - envUpper; Tcl_DStringSetLength(&envString, length+1); Tcl_UtfToUpper(envUpper); @@ -689,7 +690,7 @@ TclpFindVariable( done: Tcl_DStringFree(&envString); - ckfree(nameUpper); + Tcl_Free(nameUpper); return result; } diff --git a/win/tclWinInt.h b/win/tclWinInt.h index 3b31d8a..841442f 100644 --- a/win/tclWinInt.h +++ b/win/tclWinInt.h @@ -85,12 +85,12 @@ typedef struct TclPipeThreadInfo { * to do read/write operation. Additionally * used as signal to stop (state set to -1) */ volatile LONG state; /* Indicates current state of the thread */ - ClientData clientData; /* Referenced data of the main thread */ + void *clientData; /* Referenced data of the main thread */ HANDLE evWakeUp; /* Optional wake-up event worker set by shutdown */ } 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 @@ -112,7 +112,7 @@ typedef struct TclPipeThreadInfo { MODULE_SCOPE TclPipeThreadInfo * TclPipeThreadCreateTI(TclPipeThreadInfo **pipeTIPtr, - ClientData clientData, HANDLE wakeEvent); + void *clientData, HANDLE wakeEvent); MODULE_SCOPE int TclPipeThreadWaitForSignal(TclPipeThreadInfo **pipeTIPtr); static inline void diff --git a/win/tclWinLoad.c b/win/tclWinLoad.c index caaca42..b08f06e 100644 --- a/win/tclWinLoad.c +++ b/win/tclWinLoad.c @@ -96,7 +96,7 @@ TclpDlopen( ERROR_MOD_NOT_FOUND : GetLastError(); Tcl_DStringInit(&ds); - nativeName = Tcl_UtfToWCharDString(Tcl_GetString(pathPtr), -1, &ds); + nativeName = Tcl_UtfToWCharDString(TclGetString(pathPtr), -1, &ds); hInstance = LoadLibraryExW(nativeName, NULL, LOAD_WITH_ALTERED_SEARCH_PATH); Tcl_DStringFree(&ds); @@ -118,7 +118,7 @@ TclpDlopen( lastError = firstError; errMsg = Tcl_ObjPrintf("couldn't load library \"%s\": ", - Tcl_GetString(pathPtr)); + TclGetString(pathPtr)); /* * Check for possible DLL errors. This doesn't work quite right, @@ -171,7 +171,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; @@ -256,7 +256,7 @@ UnloadFile( HINSTANCE hInstance = (HINSTANCE) loadHandle->clientData; FreeLibrary(hInstance); - ckfree(loadHandle); + Tcl_Free(loadHandle); } /* @@ -387,7 +387,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 7d5249d..6a61591 100644 --- a/win/tclWinNotify.c +++ b/win/tclWinNotify.c @@ -103,7 +103,7 @@ Tcl_InitNotifier(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; @@ -195,7 +195,7 @@ Tcl_FinalizeNotifier( if (notifierCount) { notifierCount--; if (notifierCount == 0) { - UnregisterClassW(className, TclWinGetTclInstance()); + UnregisterClassW(className, (HINSTANCE)TclWinGetTclInstance()); } } LeaveCriticalSection(¬ifierMutex); @@ -360,7 +360,7 @@ Tcl_ServiceModeHook( if (mode == TCL_SERVICE_ALL && !tsdPtr->hwnd) { tsdPtr->hwnd = CreateWindowW(className, className, - WS_TILED, 0, 0, 0, 0, NULL, NULL, TclWinGetTclInstance(), + WS_TILED, 0, 0, 0, 0, NULL, NULL, (HINSTANCE)TclWinGetTclInstance(), NULL); /* diff --git a/win/tclWinPanic.c b/win/tclWinPanic.c index fbd3e46..85945e3 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 a93688d..b15dbf5 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(ClientData 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) { TclWinConvertError(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; } @@ -851,7 +851,7 @@ TclpCloseFile( * Results: * Returns the process id for the child process. If the pid was not known * by Tcl, either because the pid was not created by Tcl or the child - * process has already been reaped, -1 is returned. + * process has already been reaped, TCL_INDEX_NONE is returned. * * Side effects: * None. @@ -859,7 +859,7 @@ TclpCloseFile( *-------------------------------------------------------------------------- */ -int +size_t TclpGetPid( Tcl_Pid pid) /* The HANDLE of the child process. */ { @@ -869,13 +869,13 @@ 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; } } Tcl_MutexUnlock(&pipeMutex); - return (unsigned long) -1; + return TCL_INDEX_NONE; } /* @@ -1763,7 +1763,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(); @@ -1921,13 +1921,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; } } @@ -2114,7 +2114,7 @@ PipeClose2Proc( errChan = Tcl_MakeFileChannel((ClientData) filePtr->handle, TCL_READABLE); - ckfree(filePtr); + Tcl_Free(filePtr); } else { errChan = NULL; } @@ -2124,14 +2124,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; @@ -2300,10 +2300,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; @@ -2565,7 +2565,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; } @@ -2683,7 +2683,7 @@ Tcl_WaitPid( */ CloseHandle(infoPtr->hProcess); - ckfree(infoPtr); + Tcl_Free(infoPtr); return result; } @@ -2709,9 +2709,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(); @@ -2760,7 +2760,7 @@ Tcl_PidObjCmd( if (objc == 1) { Tcl_SetObjResult(interp, Tcl_NewWideIntObj((unsigned) 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; @@ -3197,7 +3197,8 @@ TclpOpenTemporaryFile( char *namePtr; HANDLE handle; DWORD flags = FILE_ATTRIBUTE_TEMPORARY; - int length, counter, counter2; + size_t length; + int counter, counter2; Tcl_DString buf; if (!resultingNameObj) { @@ -3287,7 +3288,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 +3651,7 @@ TclPipeThreadStop( #ifndef _PTI_USE_CKALLOC free(pipeTI); #else - ckfree(pipeTI); + Tcl_Free(pipeTI); #endif /* !_PTI_USE_CKALLOC */ } } @@ -3700,7 +3701,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 94c8e87..78559f5 100644 --- a/win/tclWinPort.h +++ b/win/tclWinPort.h @@ -488,6 +488,9 @@ typedef DWORD_PTR * PDWORD_PTR; #if defined(_MSC_VER) # pragma warning(disable:4146) # pragma warning(disable:4244) +#if !defined(_WIN64) +# pragma warning(disable:4305) +#endif # if _MSC_VER >= 1400 # pragma warning(disable:4267) # pragma warning(disable:4996) @@ -543,7 +546,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)) @@ -559,7 +562,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 @@ -576,7 +579,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/tclWinSerial.c b/win/tclWinSerial.c index f0035b9..aa87354 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. */ @@ -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; @@ -1782,7 +1782,7 @@ SerialSetOptionProc( " two elements with each a single 8-bit character", -1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "XCHAR", NULL); } - ckfree(argv); + Tcl_Free((void *)argv); return TCL_ERROR; } @@ -1813,7 +1813,7 @@ SerialSetOptionProc( } dcb.XoffChar = (char) character; } - ckfree(argv); + Tcl_Free((void *)argv); if (!SetCommState(infoPtr->handle, &dcb)) { goto setStateFailed; @@ -1838,7 +1838,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 +1896,7 @@ SerialSetOptionProc( } } - ckfree(argv); + Tcl_Free((void *)argv); return res; } @@ -1922,7 +1922,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 48b3cee..9e543dd 100644 --- a/win/tclWinSock.c +++ b/win/tclWinSock.c @@ -258,12 +258,12 @@ static int FindFDInList(TcpState *statePtr, SOCKET socket); static DWORD WINAPI SocketThread(LPVOID arg); static void TcpThreadActionProc(ClientData 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; @@ -280,11 +280,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. */ @@ -364,7 +360,7 @@ printaddrinfolist( void InitializeHostName( char **valuePtr, - unsigned int *lengthPtr, + size_t *lengthPtr, Tcl_Encoding *encodingPtr) { WCHAR wbuf[256]; @@ -401,7 +397,7 @@ InitializeHostName( *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); } @@ -1067,7 +1063,7 @@ TcpCloseProc( TclWinConvertError((DWORD) WSAGetLastError()); errorCode = Tcl_GetErrno(); } - ckfree(thisfd); + Tcl_Free(thisfd); } } @@ -1109,7 +1105,7 @@ TcpCloseProc( * fear of damaging the list. */ - ckfree(statePtr); + Tcl_Free(statePtr); return errorCode; } @@ -2105,11 +2101,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; @@ -2357,7 +2353,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; @@ -2429,12 +2425,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; } @@ -2489,7 +2485,7 @@ InitSockets(void) windowClass.style = 0; windowClass.cbClsExtra = 0; windowClass.cbWndExtra = 0; - windowClass.hInstance = TclWinGetTclInstance(); + windowClass.hInstance = (HINSTANCE)TclWinGetTclInstance(); windowClass.hbrBackground = NULL; windowClass.lpszMenuName = NULL; windowClass.lpszClassName = className; @@ -2620,7 +2616,7 @@ SocketExitHandler( */ TclpFinalizeSockets(); - UnregisterClassW(className, TclWinGetTclInstance()); + UnregisterClassW(className, (HINSTANCE)TclWinGetTclInstance()); initialized = 0; Tcl_MutexUnlock(&socketMutex); } @@ -2713,7 +2709,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); @@ -2988,7 +2984,7 @@ AddSocketInfoFd( * Add the first FD. */ - statePtr->sockets = (TcpFdList *)ckalloc(sizeof(TcpFdList)); + statePtr->sockets = (TcpFdList *)Tcl_Alloc(sizeof(TcpFdList)); fds = statePtr->sockets; } else { /* @@ -2999,7 +2995,7 @@ AddSocketInfoFd( fds = fds->next; } - fds->next = (TcpFdList *)ckalloc(sizeof(TcpFdList)); + fds->next = (TcpFdList *)Tcl_Alloc(sizeof(TcpFdList)); fds = fds->next; } @@ -3032,7 +3028,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)); @@ -3395,68 +3391,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 91a3010..dd95a06 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; } @@ -311,32 +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]), "time_t") == 0) { - Tcl_SetObjResult(interp, Tcl_NewWideIntObj(sizeof(time_t))); - return TCL_OK; - } - 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, "time_t|st_mtime"); - return TCL_ERROR; -} - /* *---------------------------------------------------------------------- * @@ -491,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)) { @@ -503,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; @@ -529,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. @@ -606,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) { diff --git a/win/tclWinThrd.c b/win/tclWinThrd.c index abd4f84..d3c5ca1 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 ef2b9d2..fd81b0a 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. */ @@ -131,9 +106,6 @@ 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 DWORD WINAPI CalibrationThread(LPVOID arg); static void UpdateTimeEachSecond(void); @@ -172,7 +144,7 @@ ClientData tclTimeClientData = NULL; *---------------------------------------------------------------------- */ -unsigned long +Tcl_WideUInt TclpGetSeconds(void) { Tcl_WideInt usecSincePosixEpoch; @@ -209,7 +181,7 @@ TclpGetSeconds(void) *---------------------------------------------------------------------- */ -unsigned long +Tcl_WideUInt TclpGetClicks(void) { Tcl_WideInt usecSincePosixEpoch; @@ -218,7 +190,7 @@ TclpGetClicks(void) if ( tclGetTimeProcPtr == NativeGetTime && (usecSincePosixEpoch = NativeGetMicroseconds()) ) { - return (unsigned long)usecSincePosixEpoch; + return (Tcl_WideUInt)usecSincePosixEpoch; } else { /* * Use the Tcl_GetTime abstraction to get the time in microseconds, as @@ -228,7 +200,7 @@ TclpGetClicks(void) Tcl_Time now; /* Current Tcl time */ tclGetTimeProcPtr(&now, tclTimeClientData); /* Tcl_GetTime inlined */ - return (unsigned long)(now.sec * 1000000) + now.usec; + return (Tcl_WideUInt)(now.sec * 1000000) + now.usec; } } @@ -711,243 +683,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) || (defined(_MSC_VER) && _MSC_VER < 1400)) -# 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) && (_MSC_VER >= 1900) -# 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. - */ - - /* - * Hm, Borland's localtime manages to return NULL under certain - * circumstances (e.g. wintime.test, test 1.2). Nobody tests for this, - * since 'localtime' isn't supposed to do this, possibly leading to - * crashes. - * - * Patch: We only call this function if we are at least one day into - * the epoch, else we handle it ourselves (like we do for times < 0). - * H. Giese, June 2003 - */ - -#ifdef __BORLANDC__ -#define LOCALTIME_VALIDITY_BOUNDARY SECSPERDAY -#else -#define LOCALTIME_VALIDITY_BOUNDARY 0 -#endif - - if (t2 >= LOCALTIME_VALIDITY_BOUNDARY) { - return TclpLocaltime(&t2); - } - -#if defined(_MSC_VER) && (_MSC_VER >= 1900) - _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 @@ -1336,77 +1071,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) || (defined(_MSC_VER) && _MSC_VER < 1400) - return gmtime(timePtr); -#else - return _gmtime32((const __time32_t *)timePtr); -#endif -} - -/* - *---------------------------------------------------------------------- - * - * 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) || (defined(_MSC_VER) && _MSC_VER < 1400) - return localtime(timePtr); -#else - return _localtime32((const __time32_t *)timePtr); -#endif -} -#endif /* TCL_NO_DEPRECATED */ - -/* - *---------------------------------------------------------------------- - * * Tcl_SetTimeProc -- * * TIP #233 (Virtualized Time): Registers two handlers for the |