diff options
author | apnadkarni <apnmbx-wits@yahoo.com> | 2023-04-05 04:47:52 (GMT) |
---|---|---|
committer | apnadkarni <apnmbx-wits@yahoo.com> | 2023-04-05 04:47:52 (GMT) |
commit | 543bde3f267b817f06c56f74d3480c691866ecb1 (patch) | |
tree | e542ef53f829700969740db4e9d1f5b3e9a4a845 /generic | |
parent | d9bef75f08c6f69d631963242bdd1b887f8cb093 (diff) | |
parent | 096c6ef84ff367ccee30eb44d9833fe3f61c45cc (diff) | |
download | tcl-543bde3f267b817f06c56f74d3480c691866ecb1.zip tcl-543bde3f267b817f06c56f74d3480c691866ecb1.tar.gz tcl-543bde3f267b817f06c56f74d3480c691866ecb1.tar.bz2 |
Merge 9.0
Diffstat (limited to 'generic')
-rw-r--r-- | generic/tclCompile.h | 4 | ||||
-rw-r--r-- | generic/tclEncoding.c | 8 | ||||
-rw-r--r-- | generic/tclExecute.c | 4 | ||||
-rw-r--r-- | generic/tclIO.c | 110 | ||||
-rw-r--r-- | generic/tclInt.h | 18 | ||||
-rw-r--r-- | generic/tclLiteral.c | 2 | ||||
-rw-r--r-- | generic/tclOO.c | 6 | ||||
-rw-r--r-- | generic/tclOO.decls | 8 | ||||
-rw-r--r-- | generic/tclOODefineCmds.c | 4 | ||||
-rw-r--r-- | generic/tclOOIntDecls.h | 18 | ||||
-rw-r--r-- | generic/tclObj.c | 20 | ||||
-rw-r--r-- | generic/tclPathObj.c | 12 | ||||
-rw-r--r-- | generic/tclUtil.c | 36 |
13 files changed, 148 insertions, 102 deletions
diff --git a/generic/tclCompile.h b/generic/tclCompile.h index 5772dec..bb3c42e 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -1115,7 +1115,7 @@ MODULE_SCOPE Tcl_Size TclCreateExceptRange(ExceptionRangeType type, CompileEnv *envPtr); MODULE_SCOPE ExecEnv * TclCreateExecEnv(Tcl_Interp *interp, size_t size); MODULE_SCOPE Tcl_Obj * TclCreateLiteral(Interp *iPtr, const char *bytes, - Tcl_Size length, TCL_HASH_TYPE hash, int *newPtr, + Tcl_Size length, size_t hash, int *newPtr, Namespace *nsPtr, int flags, LiteralEntry **globalPtrPtr); MODULE_SCOPE void TclDeleteExecEnv(ExecEnv *eePtr); @@ -1129,7 +1129,7 @@ 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, int index); +MODULE_SCOPE Tcl_Obj * TclFetchLiteral(CompileEnv *envPtr, Tcl_Size index); MODULE_SCOPE Tcl_Size TclFindCompiledLocal(const char *name, Tcl_Size nameChars, int create, CompileEnv *envPtr); MODULE_SCOPE int TclFixupForwardJump(CompileEnv *envPtr, diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index 37e8638..f73666e 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -2570,8 +2570,7 @@ UtfToUtfProc( } } else { /* - * Convert 0xC080 to real nulls when we are in output mode, - * irrespective of the profile. + * For output convert 0xC080 to a real null. */ *dst++ = 0; src += 2; @@ -2822,6 +2821,11 @@ Utf32ToUtfProc( if ((unsigned)ch - 1 < 0x7F) { *dst++ = (ch & 0xFF); } else { +#if TCL_UTF_MAX < 4 + if (!HIGH_SURROGATE(prev) && LOW_SURROGATE(ch)) { + *dst = 0; /* In case of lower surrogate, don't try to combine */ + } +#endif dst += Tcl_UniCharToUtf(ch, dst); } src += 4; diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 047fff5..356f522 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -1240,13 +1240,13 @@ void * TclStackRealloc( Tcl_Interp *interp, void *ptr, - size_t numBytes) + Tcl_Size numBytes) { Interp *iPtr = (Interp *) interp; ExecEnv *eePtr; ExecStack *esPtr; Tcl_Obj **markerPtr; - size_t numWords; + Tcl_Size numWords; if (iPtr == NULL || iPtr->execEnvPtr == NULL) { return Tcl_Realloc(ptr, numBytes); diff --git a/generic/tclIO.c b/generic/tclIO.c index 2ae4290..c5e6965 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -174,6 +174,8 @@ static int CloseWrite(Tcl_Interp *interp, Channel *chanPtr); static void CommonGetsCleanup(Channel *chanPtr); static int CopyData(CopyState *csPtr, int mask); static void DeleteTimerHandler(ChannelState *statePtr); +int Lossless(ChannelState *inStatePtr, + ChannelState *outStatePtr, long long toRead); static int MoveBytes(CopyState *csPtr); static void MBCallback(CopyState *csPtr, Tcl_Obj *errObj); @@ -196,7 +198,7 @@ static void DiscardOutputQueued(ChannelState *chanPtr); static Tcl_Size DoRead(Channel *chanPtr, char *dst, Tcl_Size bytesToRead, int allowShortReads); static Tcl_Size DoReadChars(Channel *chan, Tcl_Obj *objPtr, Tcl_Size toRead, - int appendFlag); + int allowShortReads, int appendFlag); static int FilterInputBytes(Channel *chanPtr, GetsState *statePtr); static int FlushChannel(Tcl_Interp *interp, Channel *chanPtr, @@ -338,6 +340,9 @@ static const Tcl_ObjType chanObjType = { TCL_OBJTYPE_V0 }; +#define GetIso88591() \ + (binaryEncoding ? Tcl_GetEncoding(NULL, "iso8859-1") : binaryEncoding) + #define ChanSetInternalRep(objPtr, resPtr) \ do { \ Tcl_ObjInternalRep ir; \ @@ -5899,7 +5904,7 @@ Tcl_ReadChars( return TCL_INDEX_NONE; } - return DoReadChars(chanPtr, objPtr, toRead, appendFlag); + return DoReadChars(chanPtr, objPtr, toRead, 0, appendFlag); } /* *--------------------------------------------------------------------------- @@ -5930,6 +5935,7 @@ DoReadChars( Tcl_Size toRead, /* Maximum number of characters to store, or * TCL_INDEX_NONE to read all available data (up to EOF or * when channel blocks). */ + int allowShortReads, /* Allow half-blocking (pipes,sockets) */ int appendFlag) /* If non-zero, data read from the channel * will be appended to the object. Otherwise, * the data will replace the existing contents @@ -6070,8 +6076,8 @@ DoReadChars( if (GotFlag(statePtr, CHANNEL_EOF)) { break; } - if (GotFlag(statePtr, CHANNEL_NONBLOCKING|CHANNEL_BLOCKED) - == (CHANNEL_NONBLOCKING|CHANNEL_BLOCKED)) { + if ((GotFlag(statePtr, CHANNEL_NONBLOCKING) || allowShortReads) + && GotFlag(statePtr, CHANNEL_BLOCKED)) { break; } result = GetInput(chanPtr); @@ -9363,18 +9369,7 @@ TclCopyChannel( ResetFlag(outStatePtr, CHANNEL_LINEBUFFERED); SetFlag(outStatePtr, CHANNEL_UNBUFFERED); - /* - * Test for conditions where we know we can just move bytes from input - * channel to output channel with no transformation or even examination - * of the bytes themselves. - */ - - moveBytes = inStatePtr->inEofChar == '\0' /* No eofChar to stop input */ - && inStatePtr->inputTranslation == TCL_TRANSLATE_LF - && outStatePtr->outputTranslation == TCL_TRANSLATE_LF - && inStatePtr->encoding == outStatePtr->encoding - && CHANNEL_PROFILE_GET(inStatePtr->inputEncodingFlags) == TCL_ENCODING_PROFILE_TCL8 - && CHANNEL_PROFILE_GET(outStatePtr->outputEncodingFlags) == TCL_ENCODING_PROFILE_TCL8; + moveBytes = Lossless(inStatePtr, outStatePtr, toRead); /* * Allocate a new CopyState to maintain info about the current copy in @@ -9681,8 +9676,7 @@ CopyData( Tcl_WideInt total; Tcl_WideInt size; const char *buffer; - int inBinary, outBinary, sameEncoding; - /* Encoding control */ + int moveBytes; int underflow; /* Input underflow */ inChan = (Tcl_Channel) csPtr->readPtr; @@ -9700,13 +9694,9 @@ CopyData( * the bottom of the stack. */ - inBinary = (inStatePtr->encoding == NULL); - outBinary = (outStatePtr->encoding == NULL); - sameEncoding = inStatePtr->encoding == outStatePtr->encoding - && CHANNEL_PROFILE_GET(inStatePtr->inputEncodingFlags) == TCL_ENCODING_PROFILE_TCL8 - && CHANNEL_PROFILE_GET(outStatePtr->outputEncodingFlags) == TCL_ENCODING_PROFILE_TCL8; + moveBytes = Lossless(inStatePtr, outStatePtr, csPtr->toRead); - if (!(inBinary || sameEncoding)) { + if (!moveBytes) { TclNewObj(bufObj); Tcl_IncrRefCount(bufObj); } @@ -9747,7 +9737,7 @@ CopyData( underflow = 1; } else { /* - * Read up to bufSize bytes. + * Read up to bufSize characters. */ if ((csPtr->toRead == (Tcl_WideInt) -1) @@ -9757,12 +9747,13 @@ CopyData( sizeb = csPtr->toRead; } - if (inBinary || sameEncoding) { + if (moveBytes) { size = DoRead(inStatePtr->topChanPtr, csPtr->buffer, sizeb, !GotFlag(inStatePtr, CHANNEL_NONBLOCKING)); } else { size = DoReadChars(inStatePtr->topChanPtr, bufObj, sizeb, - 0 /* No append */); + !GotFlag(inStatePtr, CHANNEL_NONBLOCKING) + ,0 /* No append */); } underflow = (size >= 0) && (size < sizeb); /* Input underflow */ } @@ -9823,25 +9814,20 @@ CopyData( * Now write the buffer out. */ - if (inBinary || sameEncoding) { + if (moveBytes) { buffer = csPtr->buffer; - sizeb = size; + sizeb = WriteBytes(outStatePtr->topChanPtr, buffer, size); } else { buffer = Tcl_GetStringFromObj(bufObj, &sizeb); - } - - if (outBinary || sameEncoding) { - sizeb = WriteBytes(outStatePtr->topChanPtr, buffer, sizeb); - } else { sizeb = WriteChars(outStatePtr->topChanPtr, buffer, sizeb); } /* * [Bug 2895565]. At this point 'size' still contains the number of - * bytes or characters which have been read. We keep this to later to + * characters which have been read. We keep this to later to * update the totals and toRead information, see marker (UP) below. We * must not overwrite it with 'sizeb', which is the number of written - * bytes or characters, and both EOL translation and encoding + * characters, and both EOL translation and encoding * conversion may have changed this number unpredictably in relation * to 'size' (It can be smaller or larger, in the latter case able to * drive toRead below -1, causing infinite looping). Completely @@ -9868,10 +9854,10 @@ CopyData( } /* - * Update the current byte count. Do it now so the count is valid + * Update the current character count. Do it now so the count is valid * before a return or break takes us out of the loop. The invariant at * the top of the loop should be that csPtr->toRead holds the number - * of bytes left to copy. + * of characters left to copy. */ if (csPtr->toRead != -1) { @@ -9938,8 +9924,8 @@ CopyData( } /* - * Make the callback or return the number of bytes transferred. The local - * total is used because StopCopy frees csPtr. + * Make the callback or return the number of characters transferred. The + * local total is used because StopCopy frees csPtr. */ total = csPtr->total; @@ -10262,6 +10248,50 @@ CopyEventProc( /* *---------------------------------------------------------------------- * + * Lossless -- + * + * Determines whether copying characters between two channel states would + * be lossless, i.e. whether one byte corresponds to one character, every + * character appears in the Unicode character set, there are no + * translations to be performed, and no inline signals to respond to. + * + * Result: + * True if copying would be lossless. + * + *---------------------------------------------------------------------- + */ +int +Lossless( + ChannelState *inStatePtr, + ChannelState *outStatePtr, + long long toRead) +{ + return inStatePtr->inEofChar == '\0' /* No eofChar to stop input */ + && inStatePtr->inputTranslation == TCL_TRANSLATE_LF + && outStatePtr->outputTranslation == TCL_TRANSLATE_LF + && ( + ( + (inStatePtr->encoding == NULL + || inStatePtr->encoding == GetBinaryEncoding() + ) + && + (outStatePtr->encoding == NULL + || outStatePtr->encoding == GetBinaryEncoding() + ) + ) + || + ( + toRead == -1 + && inStatePtr->encoding == outStatePtr->encoding + && CHANNEL_PROFILE_GET(inStatePtr->inputEncodingFlags) == TCL_ENCODING_PROFILE_TCL8 + && CHANNEL_PROFILE_GET(outStatePtr->inputEncodingFlags) == TCL_ENCODING_PROFILE_TCL8 + ) + ); +} + +/* + *---------------------------------------------------------------------- + * * StopCopy -- * * This routine halts a copy that is in progress. diff --git a/generic/tclInt.h b/generic/tclInt.h index 5b9762d..e65a3ee 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3076,8 +3076,8 @@ MODULE_SCOPE int TclAsyncNotifier(int sigNumber, Tcl_ThreadId threadId, MODULE_SCOPE void TclAsyncMarkFromNotifier(void); MODULE_SCOPE double TclBignumToDouble(const void *bignum); MODULE_SCOPE int TclByteArrayMatch(const unsigned char *string, - size_t strLen, const unsigned char *pattern, - size_t ptnLen, int flags); + Tcl_Size strLen, const unsigned char *pattern, + Tcl_Size ptnLen, int flags); MODULE_SCOPE double TclCeil(const void *a); MODULE_SCOPE void TclChannelPreserve(Tcl_Channel chan); MODULE_SCOPE void TclChannelRelease(Tcl_Channel chan); @@ -3090,7 +3090,7 @@ MODULE_SCOPE Tcl_ObjCmdProc TclChannelNamesCmd; MODULE_SCOPE Tcl_NRPostProc TclClearRootEnsemble; MODULE_SCOPE int TclCompareTwoNumbers(Tcl_Obj *valuePtr, Tcl_Obj *value2Ptr); -MODULE_SCOPE ContLineLoc *TclContinuationsEnter(Tcl_Obj *objPtr, size_t num, +MODULE_SCOPE ContLineLoc *TclContinuationsEnter(Tcl_Obj *objPtr, Tcl_Size num, int *loc); MODULE_SCOPE void TclContinuationsEnterDerived(Tcl_Obj *objPtr, int start, int *clNext); @@ -3220,7 +3220,7 @@ MODULE_SCOPE void TclInitObjSubsystem(void); MODULE_SCOPE int TclInterpReady(Tcl_Interp *interp); MODULE_SCOPE int TclIsDigitProc(int byte); MODULE_SCOPE int TclIsBareword(int byte); -MODULE_SCOPE Tcl_Obj * TclJoinPath(size_t elements, Tcl_Obj * const objv[], +MODULE_SCOPE Tcl_Obj * TclJoinPath(Tcl_Size elements, Tcl_Obj * const objv[], int forceRelative); MODULE_SCOPE int MakeTildeRelativePath(Tcl_Interp *interp, const char *user, const char *subPath, Tcl_DString *dsPtr); @@ -3285,7 +3285,7 @@ MODULE_SCOPE Tcl_Obj * TclpTempFileName(void); MODULE_SCOPE Tcl_Obj * TclpTempFileNameForLibrary(Tcl_Interp *interp, Tcl_Obj* pathPtr); MODULE_SCOPE Tcl_Obj * TclNewFSPathObj(Tcl_Obj *dirPtr, const char *addStrRep, - size_t len); + Tcl_Size len); MODULE_SCOPE void TclpAlertNotifier(void *clientData); MODULE_SCOPE void *TclpNotifierData(void); MODULE_SCOPE void TclpServiceModeHook(int mode); @@ -3360,9 +3360,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, - size_t reStrLen, Tcl_DString *dsPtr, int *flagsPtr, + Tcl_Size reStrLen, Tcl_DString *dsPtr, int *flagsPtr, int *quantifiersFoundPtr); -MODULE_SCOPE TCL_HASH_TYPE TclScanElement(const char *string, Tcl_Size length, +MODULE_SCOPE Tcl_Size TclScanElement(const char *string, Tcl_Size length, char *flagPtr); MODULE_SCOPE void TclSetBgErrorHandler(Tcl_Interp *interp, Tcl_Obj *cmdPrefix); @@ -3380,14 +3380,14 @@ MODULE_SCOPE void TclSpellFix(Tcl_Interp *interp, Tcl_Obj *const *objv, Tcl_Size objc, Tcl_Size subIdx, Tcl_Obj *bad, Tcl_Obj *fix); MODULE_SCOPE void * TclStackRealloc(Tcl_Interp *interp, void *ptr, - size_t numBytes); + Tcl_Size numBytes); typedef int (*memCmpFn_t)(const void*, const void*, size_t); MODULE_SCOPE int TclStringCmp(Tcl_Obj *value1Ptr, Tcl_Obj *value2Ptr, int checkEq, int nocase, Tcl_Size reqlength); MODULE_SCOPE int TclStringCmpOpts(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int *nocase, int *reqlength); -MODULE_SCOPE int TclStringMatch(const char *str, size_t strLen, +MODULE_SCOPE int TclStringMatch(const char *str, Tcl_Size strLen, const char *pattern, int ptnLen, int flags); MODULE_SCOPE int TclStringMatchObj(Tcl_Obj *stringObj, Tcl_Obj *patternObj, int flags); diff --git a/generic/tclLiteral.c b/generic/tclLiteral.c index 9bc9d10..17546b8 100644 --- a/generic/tclLiteral.c +++ b/generic/tclLiteral.c @@ -351,7 +351,7 @@ Tcl_Obj * TclFetchLiteral( CompileEnv *envPtr, /* Points to the CompileEnv from which to * fetch the registered literal value. */ - int index) /* Index of the desired literal, as returned + Tcl_Size index) /* Index of the desired literal, as returned * by prior call to TclRegisterLiteral() */ { if (index >= envPtr->literalArrayNext) { diff --git a/generic/tclOO.c b/generic/tclOO.c index b4c739e..64f769c 100644 --- a/generic/tclOO.c +++ b/generic/tclOO.c @@ -2556,7 +2556,7 @@ TclOOInvokeObject( * (PRIVATE_METHOD), or a *really* private * context (any other value; conventionally * 0). */ - size_t objc, /* Number of arguments. */ + Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Array of argument objects. It is assumed * that the name of the method to invoke will * be at index 1. */ @@ -2627,7 +2627,7 @@ int TclOOObjectCmdCore( Object *oPtr, /* The object being invoked. */ Tcl_Interp *interp, /* The interpreter containing the object. */ - size_t objc, /* How many arguments are being passed in. */ + Tcl_Size objc, /* How many arguments are being passed in. */ Tcl_Obj *const *objv, /* The array of arguments. */ int flags, /* Whether this is an invocation through the * public or the private command interface. */ @@ -2648,7 +2648,7 @@ TclOOObjectCmdCore( * processing. */ - if (objc + 1 < 3) { + if (objc < 2) { flags |= FORCE_UNKNOWN; methodNamePtr = NULL; goto noMapping; diff --git a/generic/tclOO.decls b/generic/tclOO.decls index 44fda7d..2df34d0 100644 --- a/generic/tclOO.decls +++ b/generic/tclOO.decls @@ -184,7 +184,7 @@ declare 4 { ProcedureMethod **pmPtrPtr) } declare 5 { - int TclOOObjectCmdCore(Object *oPtr, Tcl_Interp *interp, size_t objc, + int TclOOObjectCmdCore(Object *oPtr, Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const *objv, int publicOnly, Class *startCls) } declare 6 { @@ -214,7 +214,7 @@ declare 10 { } declare 11 { int TclOOInvokeObject(Tcl_Interp *interp, Tcl_Object object, - Tcl_Class startCls, int publicPrivate, size_t objc, + Tcl_Class startCls, int publicPrivate, Tcl_Size objc, Tcl_Obj *const *objv) } declare 12 { @@ -226,12 +226,12 @@ declare 13 { Tcl_Size numFilters, Tcl_Obj *const *filters) } declare 14 { - void TclOOObjectSetMixins(Object *oPtr, size_t numMixins, + void TclOOObjectSetMixins(Object *oPtr, Tcl_Size numMixins, Class *const *mixins) } declare 15 { void TclOOClassSetMixins(Tcl_Interp *interp, Class *classPtr, - size_t numMixins, Class *const *mixins) + Tcl_Size numMixins, Class *const *mixins) } return diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c index f559786..bde8203 100644 --- a/generic/tclOODefineCmds.c +++ b/generic/tclOODefineCmds.c @@ -371,7 +371,7 @@ TclOOClassSetFilters( void TclOOObjectSetMixins( Object *oPtr, - size_t numMixins, + Tcl_Size numMixins, Class *const *mixins) { Class *mixinPtr; @@ -432,7 +432,7 @@ void TclOOClassSetMixins( Tcl_Interp *interp, Class *classPtr, - size_t numMixins, + Tcl_Size numMixins, Class *const *mixins) { Class *mixinPtr; diff --git a/generic/tclOOIntDecls.h b/generic/tclOOIntDecls.h index 17c20b6..730a73a 100644 --- a/generic/tclOOIntDecls.h +++ b/generic/tclOOIntDecls.h @@ -42,7 +42,7 @@ TCLAPI Method * TclOONewProcMethod(Tcl_Interp *interp, Class *clsPtr, ProcedureMethod **pmPtrPtr); /* 5 */ TCLAPI int TclOOObjectCmdCore(Object *oPtr, Tcl_Interp *interp, - size_t objc, Tcl_Obj *const *objv, + Tcl_Size objc, Tcl_Obj *const *objv, int publicOnly, Class *startCls); /* 6 */ TCLAPI int TclOOIsReachable(Class *targetPtr, Class *startPtr); @@ -75,7 +75,7 @@ TCLAPI Tcl_Method TclOONewProcMethodEx(Tcl_Interp *interp, /* 11 */ TCLAPI int TclOOInvokeObject(Tcl_Interp *interp, Tcl_Object object, Tcl_Class startCls, - int publicPrivate, size_t objc, + int publicPrivate, Tcl_Size objc, Tcl_Obj *const *objv); /* 12 */ TCLAPI void TclOOObjectSetFilters(Object *oPtr, @@ -85,11 +85,11 @@ TCLAPI void TclOOClassSetFilters(Tcl_Interp *interp, Class *classPtr, Tcl_Size numFilters, Tcl_Obj *const *filters); /* 14 */ -TCLAPI void TclOOObjectSetMixins(Object *oPtr, size_t numMixins, - Class *const *mixins); +TCLAPI void TclOOObjectSetMixins(Object *oPtr, + Tcl_Size numMixins, Class *const *mixins); /* 15 */ TCLAPI void TclOOClassSetMixins(Tcl_Interp *interp, - Class *classPtr, size_t numMixins, + Class *classPtr, Tcl_Size numMixins, Class *const *mixins); typedef struct TclOOIntStubs { @@ -101,17 +101,17 @@ typedef struct TclOOIntStubs { Tcl_Method (*tclOOMakeProcMethod) (Tcl_Interp *interp, Class *clsPtr, int flags, Tcl_Obj *nameObj, const char *namePtr, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr, void *clientData, Proc **procPtrPtr); /* 2 */ Method * (*tclOONewProcInstanceMethod) (Tcl_Interp *interp, Object *oPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, ProcedureMethod **pmPtrPtr); /* 3 */ Method * (*tclOONewProcMethod) (Tcl_Interp *interp, Class *clsPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, ProcedureMethod **pmPtrPtr); /* 4 */ - int (*tclOOObjectCmdCore) (Object *oPtr, Tcl_Interp *interp, size_t objc, Tcl_Obj *const *objv, int publicOnly, Class *startCls); /* 5 */ + int (*tclOOObjectCmdCore) (Object *oPtr, Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const *objv, int publicOnly, Class *startCls); /* 5 */ int (*tclOOIsReachable) (Class *targetPtr, Class *startPtr); /* 6 */ Method * (*tclOONewForwardMethod) (Tcl_Interp *interp, Class *clsPtr, int isPublic, Tcl_Obj *nameObj, Tcl_Obj *prefixObj); /* 7 */ Method * (*tclOONewForwardInstanceMethod) (Tcl_Interp *interp, Object *oPtr, int isPublic, Tcl_Obj *nameObj, Tcl_Obj *prefixObj); /* 8 */ Tcl_Method (*tclOONewProcInstanceMethodEx) (Tcl_Interp *interp, Tcl_Object oPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, ProcErrorProc *errProc, void *clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr); /* 9 */ Tcl_Method (*tclOONewProcMethodEx) (Tcl_Interp *interp, Tcl_Class clsPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, ProcErrorProc *errProc, void *clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr); /* 10 */ - int (*tclOOInvokeObject) (Tcl_Interp *interp, Tcl_Object object, Tcl_Class startCls, int publicPrivate, size_t objc, Tcl_Obj *const *objv); /* 11 */ + int (*tclOOInvokeObject) (Tcl_Interp *interp, Tcl_Object object, Tcl_Class startCls, int publicPrivate, Tcl_Size objc, Tcl_Obj *const *objv); /* 11 */ void (*tclOOObjectSetFilters) (Object *oPtr, Tcl_Size numFilters, Tcl_Obj *const *filters); /* 12 */ void (*tclOOClassSetFilters) (Tcl_Interp *interp, Class *classPtr, Tcl_Size numFilters, Tcl_Obj *const *filters); /* 13 */ - void (*tclOOObjectSetMixins) (Object *oPtr, size_t numMixins, Class *const *mixins); /* 14 */ - void (*tclOOClassSetMixins) (Tcl_Interp *interp, Class *classPtr, size_t numMixins, Class *const *mixins); /* 15 */ + void (*tclOOObjectSetMixins) (Object *oPtr, Tcl_Size numMixins, Class *const *mixins); /* 14 */ + void (*tclOOClassSetMixins) (Tcl_Interp *interp, Class *classPtr, Tcl_Size numMixins, Class *const *mixins); /* 15 */ } TclOOIntStubs; extern const TclOOIntStubs *tclOOIntStubsPtr; diff --git a/generic/tclObj.c b/generic/tclObj.c index 0817686..d0daa24 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -346,6 +346,18 @@ typedef struct ResolvedCmdName { * structure can be freed when refCount * becomes zero. */ } ResolvedCmdName; + +#ifdef TCL_MEM_DEBUG +/* + * Filler matches the value used for filling freed memory in tclCkalloc. + * On 32-bit systems, the ref counts do not cross 0x7fffffff. On 64-bit + * implementations, ref counts will never reach this value (unless explicitly + * incremented without actual references!) + */ +#define FREEDREFCOUNTFILLER \ + (sizeof(objPtr->refCount) == 4 ? 0xe8e8e8e8 : 0xe8e8e8e8e8e8e8e8) +#endif + /* *------------------------------------------------------------------------- @@ -538,7 +550,7 @@ TclGetContLineTable(void) ContLineLoc * TclContinuationsEnter( Tcl_Obj *objPtr, - size_t num, + Tcl_Size num, int *loc) { int newEntry; @@ -3736,7 +3748,7 @@ Tcl_DbIncrRefCount( int line) /* Line number in the source file; used for * debugging. */ { - if (objPtr->refCount == 0x61616161) { + if (objPtr->refCount == FREEDREFCOUNTFILLER) { fprintf(stderr, "file = %s, line = %d\n", file, line); fflush(stderr); Tcl_Panic("incrementing refCount of previously disposed object"); @@ -3809,7 +3821,7 @@ Tcl_DbDecrRefCount( int line) /* Line number in the source file; used for * debugging. */ { - if (objPtr->refCount == 0x61616161) { + if (objPtr->refCount == FREEDREFCOUNTFILLER) { fprintf(stderr, "file = %s, line = %d\n", file, line); fflush(stderr); Tcl_Panic("decrementing refCount of previously disposed object"); @@ -3891,7 +3903,7 @@ Tcl_DbIsShared( #endif { #ifdef TCL_MEM_DEBUG - if (objPtr->refCount == 0x61616161) { + if (objPtr->refCount == FREEDREFCOUNTFILLER) { fprintf(stderr, "file = %s, line = %d\n", file, line); fflush(stderr); Tcl_Panic("checking whether previously disposed object is shared"); diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c index df6f04b..aa678a0 100644 --- a/generic/tclPathObj.c +++ b/generic/tclPathObj.c @@ -813,13 +813,13 @@ Tcl_FSJoinPath( Tcl_Obj * TclJoinPath( - size_t elements, /* Number of elements to use */ + Tcl_Size elements, /* Number of elements to use */ Tcl_Obj * const objv[], /* Path elements to join */ int forceRelative) /* If non-zero, assume all more paths are * relative (e. g. simple normalization) */ { Tcl_Obj *res = NULL; - size_t i; + Tcl_Size i; const Tcl_Filesystem *fsPtr = NULL; if (elements == 0) { @@ -856,7 +856,7 @@ TclJoinPath( TclGetPathType(tailObj, NULL, NULL, NULL); if (type == TCL_PATH_RELATIVE) { const char *str; - size_t len; + Tcl_Size len; str = Tcl_GetStringFromObj(tailObj, &len); if (len == 0) { @@ -1220,7 +1220,7 @@ Tcl_Obj * TclNewFSPathObj( Tcl_Obj *dirPtr, const char *addStrRep, - size_t len) + Tcl_Size len) { FsPath *fsPathPtr; Tcl_Obj *pathPtr; @@ -1273,7 +1273,7 @@ TclNewFSPathObj( * things as needing more aggressive normalization that don't actually * need it. No harm done. */ - for (p = addStrRep; len+1 > 1; p++, len--) { + for (p = addStrRep; len > 0; p++, len--) { switch (state) { case 0: /* So far only "." since last dirsep or start */ switch (*p) { @@ -1317,7 +1317,7 @@ AppendPath( { const char *bytes; Tcl_Obj *copy = Tcl_DuplicateObj(head); - size_t length; + Tcl_Size length; /* * This is likely buggy when dealing with virtual filesystem drivers diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 0e90b6a..9b5a1b1 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -1022,7 +1022,7 @@ Tcl_ScanCountedElement( *---------------------------------------------------------------------- */ -TCL_HASH_TYPE +Tcl_Size TclScanElement( const char *src, /* String to convert to Tcl list element. */ Tcl_Size length, /* Number of bytes in src, or TCL_INDEX_NONE. */ @@ -1465,7 +1465,7 @@ TclConvertElement( } *p = '}'; p++; - return (size_t)(p - dst); + return (p - dst); } /* conversion == CONVERT_ESCAPE or CONVERT_MASK */ @@ -1972,7 +1972,7 @@ Tcl_ConcatObj( */ for (i = 0; i < objc; i++) { - size_t length; + Tcl_Size length; objPtr = objv[i]; if (TclListObjIsCanonical(objPtr)) { @@ -2331,11 +2331,11 @@ Tcl_StringCaseMatch( int TclByteArrayMatch( const unsigned char *string,/* String. */ - size_t strLen, /* Length of String */ + Tcl_Size strLen, /* Length of String */ const unsigned char *pattern, /* Pattern, which may contain special * characters. */ - size_t ptnLen, /* Length of Pattern */ + Tcl_Size ptnLen, /* Length of Pattern */ TCL_UNUSED(int) /*flags*/) { const unsigned char *stringEnd, *patternEnd; @@ -2513,7 +2513,7 @@ TclStringMatchObj( * 0. */ { int match; - size_t length = 0, plen = 0; + Tcl_Size length = 0, plen = 0; /* * Promote based on the type of incoming object. @@ -3353,7 +3353,7 @@ GetWideForIndex( * NULL, then no error message is left after * errors. */ Tcl_Obj *objPtr, /* Points to the value to be parsed */ - Tcl_WideInt endValue, /* The value to be stored at *widePtr if + Tcl_WideInt endValue, /* The value to be stored at *widePtr if * objPtr holds "end". * NOTE: this value may be TCL_INDEX_NONE. */ Tcl_WideInt *widePtr) /* Location filled in with a wide integer @@ -3732,8 +3732,8 @@ GetEndOffsetFromObj( * are possible. The value objPtr might be parsed as an absolute * index value in the Tcl_Size range. Note that this includes * index values that are integers as presented and it includes index - * arithmetic expressions. - * + * arithmetic expressions. + * * The largest string supported in Tcl 8 has byte length TCL_SIZE_MAX. * This means the largest supported character length is also TCL_SIZE_MAX, * and the index of the last character in a string of length TCL_SIZE_MAX @@ -3741,8 +3741,8 @@ GetEndOffsetFromObj( * directly meaningful as an index into either a list or a string are * integer values in the range 0 to TCL_SIZE_MAX - 1. * - * This function however can only handle integer indices in the range - * 0 : INT_MAX-1. + * This function however can only handle integer indices in the range + * 0 : INT_MAX-1. * * Any absolute index value parsed outside that range is encoded * using the before and after values passed in by the @@ -3808,18 +3808,18 @@ TclIndexEncode( * (3) 2*INT_MAX:WIDE_MAX when * (a,b) as above * (c) objPtr was of the form end+N - * (4) (2*INT_MAX)-TCL_SIZE_MAX : -1 when + * (4) (2*INT_MAX)-TCL_SIZE_MAX : -1 when * (a,b) as above * (c) objPtr was of the form end-N where N was in the range 0:TCL_SIZE_MAX * (5) WIDE_MIN:(2*INT_MAX)-TCL_SIZE_MAX * (a,b) as above * (c) objPtr was of the form end-N where N was > TCL_SIZE_MAX - * + * * For all cases (b) and (c), the internal representation of objPtr * will be shimmered to endOffsetType. That allows us to distinguish between * (for example) 1a (encodable) and 1c (not encodable) though the computed * index value is the same. - * + * * Further note, the values TCL_SIZE_MAX < N < WIDE_MAX come into play * only in the 32-bit builds as TCL_SIZE_MAX == WIDE_MAX for 64-bits. */ @@ -3846,7 +3846,7 @@ TclIndexEncode( * error is raised. On 32-bit systems, indices in that range indicate * the position after the end and so do not raise an error. */ - if ((sizeof(int) != sizeof(size_t)) && + if ((sizeof(int) != sizeof(size_t)) && (wide > INT_MAX) && (wide < WIDE_MAX-1)) { /* 2(a,b) on 64-bit systems*/ goto rangeerror; @@ -3876,7 +3876,7 @@ TclIndexEncode( * indices in that range indicate the position before the beginning * and so do not raise an error. */ - if ((sizeof(int) != sizeof(size_t)) && + if ((sizeof(int) != sizeof(size_t)) && (wide > (ENDVALUE - LIST_MAX)) && (wide <= INT_MAX)) { /* 1(c), 4(a,b) on 64-bit systems */ goto rangeerror; @@ -4166,7 +4166,7 @@ TclGetProcessGlobalValue( Tcl_Obj *value = NULL; Tcl_HashTable *cacheMap; Tcl_HashEntry *hPtr; - size_t epoch = pgvPtr->epoch; + Tcl_Size epoch = pgvPtr->epoch; if (pgvPtr->encoding) { Tcl_Encoding current = Tcl_GetEncoding(NULL, NULL); @@ -4373,7 +4373,7 @@ int TclReToGlob( Tcl_Interp *interp, const char *reStr, - size_t reStrLen, + Tcl_Size reStrLen, Tcl_DString *dsPtr, int *exactPtr, int *quantifiersFoundPtr) |