From d2abd44f2bc2abbd42bda4643478e51c2ae04e3d Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 22 Mar 2022 08:16:01 +0000 Subject: Add UTF-16 versions of Tcl_UniCharLength/Tcl_NumUtfChars/Tcl_UtfAtIndex. Needed for Tk's glyph_indexing_2, and possibly other extensions sticking at TCL_UTF_MAX=3 --- generic/tcl.decls | 15 ++++++++-- generic/tclDecls.h | 47 ++++++++++++++++++++++++-------- generic/tclInt.h | 2 +- generic/tclStringObj.c | 46 ++++++++++++++++++++++++++++--- generic/tclStubInit.c | 9 ++++-- generic/tclUtf.c | 74 ++++++++++++++++++++++++++++++++++++++++++++++++++ 6 files changed, 170 insertions(+), 23 deletions(-) diff --git a/generic/tcl.decls b/generic/tcl.decls index 5a03bd2..98419d6 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -1162,7 +1162,7 @@ declare 311 { const Tcl_Time *timePtr) } declare 312 { - size_t Tcl_NumUtfChars(const char *src, size_t length) + size_t TclNumUtfChars(const char *src, size_t length) } declare 313 { size_t Tcl_ReadChars(Tcl_Channel channel, Tcl_Obj *objPtr, @@ -1206,7 +1206,7 @@ declare 324 { int Tcl_UniCharToUtf(int ch, char *buf) } declare 325 { - const char *Tcl_UtfAtIndex(const char *src, size_t index) + const char *TclUtfAtIndex(const char *src, size_t index) } declare 326 { int TclUtfCharComplete(const char *src, size_t length) @@ -1396,7 +1396,7 @@ declare 379 { size_t numChars) } declare 380 { - size_t Tcl_GetCharLength(Tcl_Obj *objPtr) + size_t TclGetCharLength(Tcl_Obj *objPtr) } declare 381 { int Tcl_GetUniChar(Tcl_Obj *objPtr, size_t index) @@ -2516,6 +2516,15 @@ declare 660 { declare 668 { size_t Tcl_UniCharLen(const int *uniStr) } +declare 669 { + size_t Tcl_NumUtfChars(const char *src, size_t length) +} +declare 670 { + size_t Tcl_GetCharLength(Tcl_Obj *objPtr) +} +declare 671 { + const char *Tcl_UtfAtIndex(const char *src, size_t index) +} # ----- BASELINE -- FOR -- 8.7.0 ----- # diff --git a/generic/tclDecls.h b/generic/tclDecls.h index cc33cf8..81ce6f8 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -828,7 +828,7 @@ EXTERN void Tcl_ConditionNotify(Tcl_Condition *condPtr); EXTERN void Tcl_ConditionWait(Tcl_Condition *condPtr, Tcl_Mutex *mutexPtr, const Tcl_Time *timePtr); /* 312 */ -EXTERN size_t Tcl_NumUtfChars(const char *src, size_t length); +EXTERN size_t TclNumUtfChars(const char *src, size_t length); /* 313 */ EXTERN size_t Tcl_ReadChars(Tcl_Channel channel, Tcl_Obj *objPtr, size_t charsToRead, int appendFlag); @@ -857,7 +857,7 @@ EXTERN int Tcl_UniCharToUpper(int ch); /* 324 */ EXTERN int Tcl_UniCharToUtf(int ch, char *buf); /* 325 */ -EXTERN const char * Tcl_UtfAtIndex(const char *src, size_t index); +EXTERN const char * TclUtfAtIndex(const char *src, size_t index); /* 326 */ EXTERN int TclUtfCharComplete(const char *src, size_t length); /* 327 */ @@ -996,7 +996,7 @@ EXTERN Tcl_Obj * Tcl_NewUnicodeObj(const Tcl_UniChar *unicode, EXTERN void Tcl_SetUnicodeObj(Tcl_Obj *objPtr, const Tcl_UniChar *unicode, size_t numChars); /* 380 */ -EXTERN size_t Tcl_GetCharLength(Tcl_Obj *objPtr); +EXTERN size_t TclGetCharLength(Tcl_Obj *objPtr); /* 381 */ EXTERN int Tcl_GetUniChar(Tcl_Obj *objPtr, size_t index); /* Slot 382 is reserved */ @@ -1774,6 +1774,12 @@ EXTERN int Tcl_AsyncMarkFromSignal(Tcl_AsyncHandler async, /* Slot 667 is reserved */ /* 668 */ EXTERN size_t Tcl_UniCharLen(const int *uniStr); +/* 669 */ +EXTERN size_t Tcl_NumUtfChars(const char *src, size_t length); +/* 670 */ +EXTERN size_t Tcl_GetCharLength(Tcl_Obj *objPtr); +/* 671 */ +EXTERN const char * Tcl_UtfAtIndex(const char *src, size_t index); typedef struct { const struct TclPlatStubs *tclPlatStubs; @@ -2097,7 +2103,7 @@ typedef struct TclStubs { void (*tcl_MutexUnlock) (Tcl_Mutex *mutexPtr); /* 309 */ void (*tcl_ConditionNotify) (Tcl_Condition *condPtr); /* 310 */ void (*tcl_ConditionWait) (Tcl_Condition *condPtr, Tcl_Mutex *mutexPtr, const Tcl_Time *timePtr); /* 311 */ - size_t (*tcl_NumUtfChars) (const char *src, size_t length); /* 312 */ + size_t (*tclNumUtfChars) (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); @@ -2110,7 +2116,7 @@ typedef struct TclStubs { 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, size_t index); /* 325 */ + const char * (*tclUtfAtIndex) (const char *src, size_t index); /* 325 */ int (*tclUtfCharComplete) (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 */ @@ -2165,7 +2171,7 @@ typedef struct TclStubs { void (*tcl_RegExpGetInfo) (Tcl_RegExp regexp, Tcl_RegExpInfo *infoPtr); /* 377 */ 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 */ + size_t (*tclGetCharLength) (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 */ @@ -2454,6 +2460,9 @@ typedef struct TclStubs { void (*reserved666)(void); void (*reserved667)(void); size_t (*tcl_UniCharLen) (const int *uniStr); /* 668 */ + size_t (*tcl_NumUtfChars) (const char *src, size_t length); /* 669 */ + size_t (*tcl_GetCharLength) (Tcl_Obj *objPtr); /* 670 */ + const char * (*tcl_UtfAtIndex) (const char *src, size_t index); /* 671 */ } TclStubs; extern const TclStubs *tclStubsPtr; @@ -3046,8 +3055,8 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_ConditionNotify) /* 310 */ #define Tcl_ConditionWait \ (tclStubsPtr->tcl_ConditionWait) /* 311 */ -#define Tcl_NumUtfChars \ - (tclStubsPtr->tcl_NumUtfChars) /* 312 */ +#define TclNumUtfChars \ + (tclStubsPtr->tclNumUtfChars) /* 312 */ #define Tcl_ReadChars \ (tclStubsPtr->tcl_ReadChars) /* 313 */ /* Slot 314 is reserved */ @@ -3070,8 +3079,8 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_UniCharToUpper) /* 323 */ #define Tcl_UniCharToUtf \ (tclStubsPtr->tcl_UniCharToUtf) /* 324 */ -#define Tcl_UtfAtIndex \ - (tclStubsPtr->tcl_UtfAtIndex) /* 325 */ +#define TclUtfAtIndex \ + (tclStubsPtr->tclUtfAtIndex) /* 325 */ #define TclUtfCharComplete \ (tclStubsPtr->tclUtfCharComplete) /* 326 */ #define Tcl_UtfBackslash \ @@ -3176,8 +3185,8 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_NewUnicodeObj) /* 378 */ #define Tcl_SetUnicodeObj \ (tclStubsPtr->tcl_SetUnicodeObj) /* 379 */ -#define Tcl_GetCharLength \ - (tclStubsPtr->tcl_GetCharLength) /* 380 */ +#define TclGetCharLength \ + (tclStubsPtr->tclGetCharLength) /* 380 */ #define Tcl_GetUniChar \ (tclStubsPtr->tcl_GetUniChar) /* 381 */ /* Slot 382 is reserved */ @@ -3736,6 +3745,12 @@ extern const TclStubs *tclStubsPtr; /* Slot 667 is reserved */ #define Tcl_UniCharLen \ (tclStubsPtr->tcl_UniCharLen) /* 668 */ +#define Tcl_NumUtfChars \ + (tclStubsPtr->tcl_NumUtfChars) /* 669 */ +#define Tcl_GetCharLength \ + (tclStubsPtr->tcl_GetCharLength) /* 670 */ +#define Tcl_UtfAtIndex \ + (tclStubsPtr->tcl_UtfAtIndex) /* 671 */ #endif /* defined(USE_TCL_STUBS) */ @@ -3937,6 +3952,14 @@ extern const TclStubs *tclStubsPtr; # define Tcl_UtfToUniChar Tcl_UtfToChar16 # undef Tcl_UniCharLen # define Tcl_UniCharLen Tcl_Char16Len +#if !defined(BUILD_tcl) +# undef Tcl_NumUtfChars +# define Tcl_NumUtfChars TclNumUtfChars +# undef Tcl_GetCharLength +# define Tcl_GetCharLength TclGetCharLength +# undef Tcl_UtfAtIndex +# define Tcl_UtfAtIndex TclUtfAtIndex +#endif #endif #if defined(USE_TCL_STUBS) # define Tcl_WCharToUtfDString (sizeof(wchar_t) != sizeof(short) \ diff --git a/generic/tclInt.h b/generic/tclInt.h index 596e1cb..055c497 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -4668,7 +4668,7 @@ MODULE_SCOPE const TclFileAttrProcs tclpFileAttrProcs[]; *---------------------------------------------------------------- */ -#define TclNumUtfChars(numChars, bytes, numBytes) \ +#define TclNumUtfChars_NOTUSED(numChars, bytes, numBytes) \ do { \ size_t _count, _i = (numBytes); \ unsigned char *_str = (unsigned char *) (bytes); \ diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index c8d9df7..76d43a6 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -394,6 +394,7 @@ Tcl_NewUnicodeObj( *---------------------------------------------------------------------- */ +#undef Tcl_GetCharLength size_t Tcl_GetCharLength( Tcl_Obj *objPtr) /* The String object to get the num chars @@ -440,12 +441,49 @@ Tcl_GetCharLength( */ if (numChars == TCL_INDEX_NONE) { - TclNumUtfChars(numChars, objPtr->bytes, objPtr->length); + numChars = Tcl_NumUtfChars(objPtr->bytes, objPtr->length); stringPtr->numChars = numChars; } return numChars; } +size_t +TclGetCharLength( + Tcl_Obj *objPtr) /* The String object to get the num chars + * of. */ +{ + size_t numChars = 0; + + /* + * Quick, no-shimmer return for short string reps. + */ + + if ((objPtr->bytes) && (objPtr->length < 2)) { + /* 0 bytes -> 0 chars; 1 byte -> 1 char */ + return objPtr->length; + } + + /* + * Optimize the case where we're really dealing with a bytearray object; + * we don't need to convert to a string to perform the get-length operation. + * + * Starting in Tcl 8.7, we check for a "pure" bytearray, because the + * machinery behind that test is using a proper bytearray ObjType. We + * could also compute length of an improper bytearray without shimmering + * but there's no value in that. We *want* to shimmer an improper bytearray + * because improper bytearrays have worthless internal reps. + */ + + if (TclIsPureByteArray(objPtr)) { + (void) Tcl_GetByteArrayFromObj(objPtr, &numChars); + } else { + numChars = TclNumUtfChars(objPtr->bytes, objPtr->length); + } + + return numChars; +} + + /* *---------------------------------------------------------------------- * @@ -543,7 +581,7 @@ Tcl_GetUniChar( */ if (stringPtr->numChars == TCL_INDEX_NONE) { - TclNumUtfChars(stringPtr->numChars, objPtr->bytes, objPtr->length); + stringPtr->numChars = Tcl_NumUtfChars(objPtr->bytes, objPtr->length); } if (stringPtr->numChars == objPtr->length) { return (unsigned char) objPtr->bytes[index]; @@ -709,7 +747,7 @@ Tcl_GetRange( */ if (stringPtr->numChars == TCL_INDEX_NONE) { - TclNumUtfChars(stringPtr->numChars, objPtr->bytes, objPtr->length); + stringPtr->numChars = Tcl_NumUtfChars(objPtr->bytes, objPtr->length); } if (stringPtr->numChars == objPtr->length) { if (last >= stringPtr->numChars) { @@ -4045,7 +4083,7 @@ ExtendUnicodeRepWithString( numOrigChars = stringPtr->numChars; } if (numAppendChars == TCL_INDEX_NONE) { - TclNumUtfChars(numAppendChars, bytes, numBytes); + numAppendChars = Tcl_NumUtfChars(bytes, numBytes); } needed = numOrigChars + numAppendChars; diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index ea7083f..6704df8 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -1005,7 +1005,7 @@ const TclStubs tclStubs = { Tcl_MutexUnlock, /* 309 */ Tcl_ConditionNotify, /* 310 */ Tcl_ConditionWait, /* 311 */ - Tcl_NumUtfChars, /* 312 */ + TclNumUtfChars, /* 312 */ Tcl_ReadChars, /* 313 */ 0, /* 314 */ 0, /* 315 */ @@ -1018,7 +1018,7 @@ const TclStubs tclStubs = { Tcl_UniCharToTitle, /* 322 */ Tcl_UniCharToUpper, /* 323 */ Tcl_UniCharToUtf, /* 324 */ - Tcl_UtfAtIndex, /* 325 */ + TclUtfAtIndex, /* 325 */ TclUtfCharComplete, /* 326 */ Tcl_UtfBackslash, /* 327 */ Tcl_UtfFindFirst, /* 328 */ @@ -1073,7 +1073,7 @@ const TclStubs tclStubs = { Tcl_RegExpGetInfo, /* 377 */ Tcl_NewUnicodeObj, /* 378 */ Tcl_SetUnicodeObj, /* 379 */ - Tcl_GetCharLength, /* 380 */ + TclGetCharLength, /* 380 */ Tcl_GetUniChar, /* 381 */ 0, /* 382 */ Tcl_GetRange, /* 383 */ @@ -1362,6 +1362,9 @@ const TclStubs tclStubs = { 0, /* 666 */ 0, /* 667 */ Tcl_UniCharLen, /* 668 */ + Tcl_NumUtfChars, /* 669 */ + Tcl_GetCharLength, /* 670 */ + Tcl_UtfAtIndex, /* 671 */ }; /* !END!: Do not edit above this line. */ diff --git a/generic/tclUtf.c b/generic/tclUtf.c index e353b7f..6c6940c 100644 --- a/generic/tclUtf.c +++ b/generic/tclUtf.c @@ -799,6 +799,7 @@ Tcl_UtfCharComplete( *--------------------------------------------------------------------------- */ +#undef Tcl_NumUtfChars size_t Tcl_NumUtfChars( const char *src, /* The UTF-8 string to measure. */ @@ -851,6 +852,58 @@ Tcl_NumUtfChars( return i; } +size_t +TclNumUtfChars( + const char *src, /* The UTF-8 string to measure. */ + size_t length) /* The length of the string in bytes, or + * TCL_INDEX_NONE for strlen(src). */ +{ + unsigned short ch = 0; + size_t i = 0; + + if (length == TCL_INDEX_NONE) { + /* string is NUL-terminated, so TclUtfToUniChar calls are safe. */ + while (*src != '\0') { + src += Tcl_UtfToChar16(src, &ch); + i++; + } + } else { + /* Will return value between 0 and length. No overflow checks. */ + + /* 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 */ + const char *optPtr = endPtr - 4; + + /* + * Optimize away the call in this loop. Justified because... + * when (src <= optPtr), (endPtr - src) >= (endPtr - optPtr) + * By initialization above (endPtr - optPtr) = TCL_UTF_MAX + * So (endPtr - src) >= TCL_UTF_MAX, and passing that to + * Tcl_UtfCharComplete we know will cause return of 1. + */ + while (src <= optPtr + /* && Tcl_UtfCharComplete(src, endPtr - src) */ ) { + src += Tcl_UtfToChar16(src, &ch); + i++; + } + /* Loop over the remaining string where call must happen */ + while (src < endPtr) { + if (Tcl_UtfCharComplete(src, endPtr - src)) { + src += Tcl_UtfToChar16(src, &ch); + } else { + /* + * src points to incomplete UTF-8 sequence + * Treat first byte as character and count it + */ + src++; + } + i++; + } + } + return i; +} + /* *--------------------------------------------------------------------------- * @@ -1167,6 +1220,7 @@ Tcl_UniCharAtIndex( *--------------------------------------------------------------------------- */ +#undef Tcl_UtfAtIndex const char * Tcl_UtfAtIndex( const char *src, /* The UTF-8 string. */ @@ -1195,6 +1249,26 @@ Tcl_UtfAtIndex( return src; } +const char * +TclUtfAtIndex( + const char *src, /* The UTF-8 string. */ + size_t index) /* The position of the desired character. */ +{ + unsigned short ch = 0; + size_t len = 0; + + if (index != TCL_INDEX_NONE) { + while (index--) { + src += (len = Tcl_UtfToChar16(src, &ch)); + } + if ((ch >= 0xD800) && (len < 3)) { + /* Index points at character following high Surrogate */ + src += Tcl_UtfToChar16(src, &ch); + } + } + return src; +} + /* *--------------------------------------------------------------------------- * -- cgit v0.12 From f13079289a274d0195bb0a57b34fa61bd1775e28 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 22 Mar 2022 17:06:57 +0000 Subject: Put back TclNumUtfChars (as TclNumUtfCharsM) macro for speedup --- generic/tclInt.h | 2 +- generic/tclStringObj.c | 8 ++++---- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/generic/tclInt.h b/generic/tclInt.h index 055c497..8c6d5f0 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -4668,7 +4668,7 @@ MODULE_SCOPE const TclFileAttrProcs tclpFileAttrProcs[]; *---------------------------------------------------------------- */ -#define TclNumUtfChars_NOTUSED(numChars, bytes, numBytes) \ +#define TclNumUtfCharsM(numChars, bytes, numBytes) \ do { \ size_t _count, _i = (numBytes); \ unsigned char *_str = (unsigned char *) (bytes); \ diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 76d43a6..7e65ef1 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -441,7 +441,7 @@ Tcl_GetCharLength( */ if (numChars == TCL_INDEX_NONE) { - numChars = Tcl_NumUtfChars(objPtr->bytes, objPtr->length); + TclNumUtfCharsM(numChars, objPtr->bytes, objPtr->length); stringPtr->numChars = numChars; } return numChars; @@ -581,7 +581,7 @@ Tcl_GetUniChar( */ if (stringPtr->numChars == TCL_INDEX_NONE) { - stringPtr->numChars = Tcl_NumUtfChars(objPtr->bytes, objPtr->length); + TclNumUtfCharsM(stringPtr->numChars, objPtr->bytes, objPtr->length); } if (stringPtr->numChars == objPtr->length) { return (unsigned char) objPtr->bytes[index]; @@ -747,7 +747,7 @@ Tcl_GetRange( */ if (stringPtr->numChars == TCL_INDEX_NONE) { - stringPtr->numChars = Tcl_NumUtfChars(objPtr->bytes, objPtr->length); + TclNumUtfCharsM(stringPtr->numChars, objPtr->bytes, objPtr->length); } if (stringPtr->numChars == objPtr->length) { if (last >= stringPtr->numChars) { @@ -4083,7 +4083,7 @@ ExtendUnicodeRepWithString( numOrigChars = stringPtr->numChars; } if (numAppendChars == TCL_INDEX_NONE) { - numAppendChars = Tcl_NumUtfChars(bytes, numBytes); + TclNumUtfCharsM(numAppendChars, bytes, numBytes); } needed = numOrigChars + numAppendChars; -- cgit v0.12 From 4fcff1f053c279076fb2bc1507dac8a26b3c562b Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 22 Mar 2022 23:18:23 +0000 Subject: Simplyfy Tcl_UtfAtIndex --- generic/tclUtf.c | 25 ++++++------------------- 1 file changed, 6 insertions(+), 19 deletions(-) diff --git a/generic/tclUtf.c b/generic/tclUtf.c index 6c6940c..09e464f 100644 --- a/generic/tclUtf.c +++ b/generic/tclUtf.c @@ -1226,25 +1226,12 @@ Tcl_UtfAtIndex( const char *src, /* The UTF-8 string. */ size_t index) /* The position of the desired character. */ { - Tcl_UniChar ch = 0; -#if TCL_UTF_MAX < 4 - size_t len = 0; -#endif + int ch = 0; if (index != TCL_INDEX_NONE) { while (index--) { -#if TCL_UTF_MAX < 4 - src += (len = TclUtfToUniChar(src, &ch)); -#else - src += TclUtfToUniChar(src, &ch); -#endif + src += Tcl_UtfToUniChar(src, &ch); } -#if TCL_UTF_MAX < 4 - if ((ch >= 0xD800) && (len < 3)) { - /* Index points at character following high Surrogate */ - src += TclUtfToUniChar(src, &ch); - } -#endif } return src; } @@ -1261,10 +1248,10 @@ TclUtfAtIndex( while (index--) { src += (len = Tcl_UtfToChar16(src, &ch)); } - if ((ch >= 0xD800) && (len < 3)) { - /* Index points at character following high Surrogate */ - src += Tcl_UtfToChar16(src, &ch); - } + if ((ch >= 0xD800) && (len < 3)) { + /* Index points at character following high Surrogate */ + src += Tcl_UtfToChar16(src, &ch); + } } return src; } -- cgit v0.12 From db3553f6b2e985ce55fa6c42cb0bf268a06cdc70 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 24 Mar 2022 14:28:10 +0000 Subject: Add UTF-16 versions of Tcl_GetRange/Tcl_GetUniChar --- generic/tcl.decls | 10 ++++-- generic/tclDecls.h | 31 ++++++++++++++----- generic/tclStringObj.c | 83 ++++++++++++++++++++++++++++++++++++++++++++++++++ generic/tclStubInit.c | 6 ++-- 4 files changed, 118 insertions(+), 12 deletions(-) diff --git a/generic/tcl.decls b/generic/tcl.decls index 98419d6..d4f1c59 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -1399,14 +1399,14 @@ declare 380 { size_t TclGetCharLength(Tcl_Obj *objPtr) } declare 381 { - int Tcl_GetUniChar(Tcl_Obj *objPtr, size_t index) + int TclGetUniChar(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, size_t first, size_t last) + Tcl_Obj *TclGetRange(Tcl_Obj *objPtr, size_t first, size_t last) } # Removed in 9.0 #declare 384 { @@ -2525,6 +2525,12 @@ declare 670 { declare 671 { const char *Tcl_UtfAtIndex(const char *src, size_t index) } +declare 672 { + Tcl_Obj *Tcl_GetRange(Tcl_Obj *objPtr, size_t first, size_t last) +} +declare 673 { + int Tcl_GetUniChar(Tcl_Obj *objPtr, size_t index) +} # ----- BASELINE -- FOR -- 8.7.0 ----- # diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 81ce6f8..1345c6c 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -998,10 +998,10 @@ EXTERN void Tcl_SetUnicodeObj(Tcl_Obj *objPtr, /* 380 */ EXTERN size_t TclGetCharLength(Tcl_Obj *objPtr); /* 381 */ -EXTERN int Tcl_GetUniChar(Tcl_Obj *objPtr, size_t index); +EXTERN int TclGetUniChar(Tcl_Obj *objPtr, size_t index); /* Slot 382 is reserved */ /* 383 */ -EXTERN Tcl_Obj * Tcl_GetRange(Tcl_Obj *objPtr, size_t first, +EXTERN Tcl_Obj * TclGetRange(Tcl_Obj *objPtr, size_t first, size_t last); /* Slot 384 is reserved */ /* 385 */ @@ -1780,6 +1780,11 @@ EXTERN size_t Tcl_NumUtfChars(const char *src, size_t length); EXTERN size_t Tcl_GetCharLength(Tcl_Obj *objPtr); /* 671 */ EXTERN const char * Tcl_UtfAtIndex(const char *src, size_t index); +/* 672 */ +EXTERN Tcl_Obj * Tcl_GetRange(Tcl_Obj *objPtr, size_t first, + size_t last); +/* 673 */ +EXTERN int Tcl_GetUniChar(Tcl_Obj *objPtr, size_t index); typedef struct { const struct TclPlatStubs *tclPlatStubs; @@ -2172,9 +2177,9 @@ typedef struct TclStubs { 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 (*tclGetCharLength) (Tcl_Obj *objPtr); /* 380 */ - int (*tcl_GetUniChar) (Tcl_Obj *objPtr, size_t index); /* 381 */ + int (*tclGetUniChar) (Tcl_Obj *objPtr, size_t index); /* 381 */ void (*reserved382)(void); - Tcl_Obj * (*tcl_GetRange) (Tcl_Obj *objPtr, size_t first, size_t last); /* 383 */ + Tcl_Obj * (*tclGetRange) (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) (const Tcl_NotifierProcs *notifierProcPtr); /* 386 */ @@ -2463,6 +2468,8 @@ typedef struct TclStubs { size_t (*tcl_NumUtfChars) (const char *src, size_t length); /* 669 */ size_t (*tcl_GetCharLength) (Tcl_Obj *objPtr); /* 670 */ const char * (*tcl_UtfAtIndex) (const char *src, size_t index); /* 671 */ + Tcl_Obj * (*tcl_GetRange) (Tcl_Obj *objPtr, size_t first, size_t last); /* 672 */ + int (*tcl_GetUniChar) (Tcl_Obj *objPtr, size_t index); /* 673 */ } TclStubs; extern const TclStubs *tclStubsPtr; @@ -3187,11 +3194,11 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_SetUnicodeObj) /* 379 */ #define TclGetCharLength \ (tclStubsPtr->tclGetCharLength) /* 380 */ -#define Tcl_GetUniChar \ - (tclStubsPtr->tcl_GetUniChar) /* 381 */ +#define TclGetUniChar \ + (tclStubsPtr->tclGetUniChar) /* 381 */ /* Slot 382 is reserved */ -#define Tcl_GetRange \ - (tclStubsPtr->tcl_GetRange) /* 383 */ +#define TclGetRange \ + (tclStubsPtr->tclGetRange) /* 383 */ /* Slot 384 is reserved */ #define Tcl_RegExpMatchObj \ (tclStubsPtr->tcl_RegExpMatchObj) /* 385 */ @@ -3751,6 +3758,10 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_GetCharLength) /* 670 */ #define Tcl_UtfAtIndex \ (tclStubsPtr->tcl_UtfAtIndex) /* 671 */ +#define Tcl_GetRange \ + (tclStubsPtr->tcl_GetRange) /* 672 */ +#define Tcl_GetUniChar \ + (tclStubsPtr->tcl_GetUniChar) /* 673 */ #endif /* defined(USE_TCL_STUBS) */ @@ -3959,6 +3970,10 @@ extern const TclStubs *tclStubsPtr; # define Tcl_GetCharLength TclGetCharLength # undef Tcl_UtfAtIndex # define Tcl_UtfAtIndex TclUtfAtIndex +# undef Tcl_GetRange +# define Tcl_GetRange TclGetRange +# undef Tcl_GetUniChar +# define Tcl_GetUniChar TclGetUniChar #endif #endif #if defined(USE_TCL_STUBS) diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 7e65ef1..dc64fcd 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -612,6 +612,40 @@ Tcl_GetUniChar( #endif return ch; } + +int +TclGetUniChar( + Tcl_Obj *objPtr, /* The object to get the Unicode charater + * from. */ + size_t index) /* Get the index'th Unicode character. */ +{ + int ch = 0; + + /* + * Optimize the case where we're really dealing with a bytearray object + * we don't need to convert to a string to perform the indexing operation. + */ + + if (TclIsPureByteArray(objPtr)) { + size_t length = 0; + unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &length); + if (index >= length) { + return -1; + } + + return bytes[index]; + } + + size_t numChars = TclNumUtfChars(objPtr->bytes, objPtr->length); + + if (index >= numChars) { + return -1; + } + const char *begin = TclUtfAtIndex(objPtr->bytes, index); + Tcl_UtfToUniChar(begin, &ch); + return ch; +} + /* *---------------------------------------------------------------------- @@ -792,6 +826,55 @@ Tcl_GetRange( #endif return Tcl_NewUnicodeObj(stringPtr->unicode + first, last - first + 1); } + +Tcl_Obj * +TclGetRange( + Tcl_Obj *objPtr, /* The Tcl object to find the range of. */ + size_t first, /* First index of the range. */ + size_t last) /* Last index of the range. */ +{ + Tcl_Obj *newObjPtr; /* The Tcl object to find the range of. */ + size_t length = 0; + + if (first == TCL_INDEX_NONE) { + first = TCL_INDEX_START; + } + if (last + 2 <= first + 1) { + return Tcl_NewObj(); + } + + /* + * Optimize the case where we're really dealing with a bytearray object + * we don't need to convert to a string to perform the substring operation. + */ + + if (TclIsPureByteArray(objPtr)) { + unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &length); + + if (last >= length) { + last = length - 1; + } + if (last < first) { + TclNewObj(newObjPtr); + return newObjPtr; + } + return Tcl_NewByteArrayObj(bytes + first, last - first + 1); + } + + size_t numChars = TclNumUtfChars(objPtr->bytes, objPtr->length); + + if (last >= numChars) { + last = numChars - 1; + } + if (last < first) { + TclNewObj(newObjPtr); + return newObjPtr; + } + const char *begin = TclUtfAtIndex(objPtr->bytes, first); + const char *end = TclUtfAtIndex(objPtr->bytes, last + 1); + return Tcl_NewStringObj(begin, end - begin); +} + /* *---------------------------------------------------------------------- diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 6704df8..704c51a 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -1074,9 +1074,9 @@ const TclStubs tclStubs = { Tcl_NewUnicodeObj, /* 378 */ Tcl_SetUnicodeObj, /* 379 */ TclGetCharLength, /* 380 */ - Tcl_GetUniChar, /* 381 */ + TclGetUniChar, /* 381 */ 0, /* 382 */ - Tcl_GetRange, /* 383 */ + TclGetRange, /* 383 */ 0, /* 384 */ Tcl_RegExpMatchObj, /* 385 */ Tcl_SetNotifier, /* 386 */ @@ -1365,6 +1365,8 @@ const TclStubs tclStubs = { Tcl_NumUtfChars, /* 669 */ Tcl_GetCharLength, /* 670 */ Tcl_UtfAtIndex, /* 671 */ + Tcl_GetRange, /* 672 */ + Tcl_GetUniChar, /* 673 */ }; /* !END!: Do not edit above this line. */ -- cgit v0.12 From 0dba465244f6e7cc0396e739ead01dd2575aaf2b Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 24 Mar 2022 22:55:32 +0000 Subject: Bugfix for TclGetCharLength(): Make sure objPtr->bytes is filled --- generic/tclStringObj.c | 1 + 1 file changed, 1 insertion(+) diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index dc64fcd..7cee05d 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -477,6 +477,7 @@ TclGetCharLength( if (TclIsPureByteArray(objPtr)) { (void) Tcl_GetByteArrayFromObj(objPtr, &numChars); } else { + Tcl_GetString(objPtr); numChars = TclNumUtfChars(objPtr->bytes, objPtr->length); } -- cgit v0.12 From f768cd1df73e1d1801bef8b03e89609d1bb6f885 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 25 Mar 2022 08:20:31 +0000 Subject: Put back Tcl_AppendUnicodeToObj() --- ChangeLog.1999 | 2 +- generic/tcl.decls | 9 ++++----- generic/tclCmdMZ.c | 38 +++++++++++++++++++------------------- generic/tclDecls.h | 9 ++++++--- generic/tclExecute.c | 6 +++--- generic/tclInt.decls | 5 ----- generic/tclIntDecls.h | 9 +++------ generic/tclStringObj.c | 10 +++++----- generic/tclStubInit.c | 6 +++--- generic/tclTestObj.c | 2 +- 10 files changed, 45 insertions(+), 51 deletions(-) diff --git a/ChangeLog.1999 b/ChangeLog.1999 index 3bf4e9a..4d88b61 100644 --- a/ChangeLog.1999 +++ b/ChangeLog.1999 @@ -1226,7 +1226,7 @@ 1999-06-09 Scott Stanton * generic/tclUnicodeObj.c: Lots of cleanup and simplification. Fixed - several memory bugs. Added TclAppendUnicodeToObj. + several memory bugs. Added Tcl_AppendUnicodeToObj. * generic/tclInt.h: Added declarations for various Unicode string functions. diff --git a/generic/tcl.decls b/generic/tcl.decls index d4f1c59..731baa8 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -1408,11 +1408,10 @@ declare 381 { declare 383 { Tcl_Obj *TclGetRange(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, -# int length) -#} +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) diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 85174ec..534a5ae 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -624,8 +624,8 @@ Tcl_RegsubObjCmd( resultPtr = Tcl_NewUnicodeObj(wstring, 0); Tcl_IncrRefCount(resultPtr); for (; wstring < wend; wstring++) { - TclAppendUnicodeToObj(resultPtr, wsubspec, wsublen); - TclAppendUnicodeToObj(resultPtr, wstring, 1); + Tcl_AppendUnicodeToObj(resultPtr, wsubspec, wsublen); + Tcl_AppendUnicodeToObj(resultPtr, wstring, 1); numMatches++; } wlen = 0; @@ -641,14 +641,14 @@ Tcl_RegsubObjCmd( Tcl_IncrRefCount(resultPtr); } if (p != wstring) { - TclAppendUnicodeToObj(resultPtr, p, wstring - p); + Tcl_AppendUnicodeToObj(resultPtr, p, wstring - p); p = wstring + slen; } else { p += slen; } wstring = p - 1; - TclAppendUnicodeToObj(resultPtr, wsubspec, wsublen); + Tcl_AppendUnicodeToObj(resultPtr, wsubspec, wsublen); numMatches++; } } @@ -751,7 +751,7 @@ Tcl_RegsubObjCmd( * specified. */ - TclAppendUnicodeToObj(resultPtr, wstring, offset); + Tcl_AppendUnicodeToObj(resultPtr, wstring, offset); } } numMatches++; @@ -764,7 +764,7 @@ Tcl_RegsubObjCmd( Tcl_RegExpGetInfo(regExpr, &info); start = info.matches[0].start; end = info.matches[0].end; - TclAppendUnicodeToObj(resultPtr, wstring + offset, start); + Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, start); /* * In command-prefix mode, the substitutions are added as quoted @@ -839,7 +839,7 @@ Tcl_RegsubObjCmd( */ if (offset < wlen) { - TclAppendUnicodeToObj(resultPtr, wstring + offset, 1); + Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, 1); } offset++; } @@ -868,7 +868,7 @@ Tcl_RegsubObjCmd( idx = ch - '0'; } else if ((ch == '\\') || (ch == '&')) { *wsrc = ch; - TclAppendUnicodeToObj(resultPtr, wfirstChar, + Tcl_AppendUnicodeToObj(resultPtr, wfirstChar, wsrc - wfirstChar + 1); *wsrc = '\\'; wfirstChar = wsrc + 2; @@ -882,7 +882,7 @@ Tcl_RegsubObjCmd( } if (wfirstChar != wsrc) { - TclAppendUnicodeToObj(resultPtr, wfirstChar, + Tcl_AppendUnicodeToObj(resultPtr, wfirstChar, wsrc - wfirstChar); } @@ -890,7 +890,7 @@ Tcl_RegsubObjCmd( subStart = info.matches[idx].start; subEnd = info.matches[idx].end; if ((subStart != TCL_INDEX_NONE) && (subEnd != TCL_INDEX_NONE)) { - TclAppendUnicodeToObj(resultPtr, + Tcl_AppendUnicodeToObj(resultPtr, wstring + offset + subStart, subEnd - subStart); } } @@ -902,7 +902,7 @@ Tcl_RegsubObjCmd( } if (wfirstChar != wsrc) { - TclAppendUnicodeToObj(resultPtr, wfirstChar, wsrc - wfirstChar); + Tcl_AppendUnicodeToObj(resultPtr, wfirstChar, wsrc - wfirstChar); } if (end == 0) { @@ -912,7 +912,7 @@ Tcl_RegsubObjCmd( */ if (offset < wlen) { - TclAppendUnicodeToObj(resultPtr, wstring + offset, 1); + Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, 1); } offset++; } else { @@ -924,7 +924,7 @@ Tcl_RegsubObjCmd( */ if (offset < wlen) { - TclAppendUnicodeToObj(resultPtr, wstring + offset, 1); + Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, 1); } offset++; } @@ -949,7 +949,7 @@ Tcl_RegsubObjCmd( resultPtr = objv[1]; Tcl_IncrRefCount(resultPtr); } else if (offset < wlen) { - TclAppendUnicodeToObj(resultPtr, wstring + offset, wlen - offset); + Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, wlen - offset); } if (objc == 4) { if (Tcl_ObjSetVar2(interp, objv[3], NULL, resultPtr, @@ -2112,14 +2112,14 @@ StringMapCmd( (length2==1 || strCmpFn(ustring1, ustring2, length2) == 0)) { if (p != ustring1) { - TclAppendUnicodeToObj(resultPtr, p, ustring1-p); + Tcl_AppendUnicodeToObj(resultPtr, p, ustring1-p); p = ustring1 + length2; } else { p += length2; } ustring1 = p - 1; - TclAppendUnicodeToObj(resultPtr, mapString, mapLen); + Tcl_AppendUnicodeToObj(resultPtr, mapString, mapLen); } } } @@ -2165,7 +2165,7 @@ StringMapCmd( * Put the skipped chars onto the result first. */ - TclAppendUnicodeToObj(resultPtr, p, ustring1-p); + Tcl_AppendUnicodeToObj(resultPtr, p, ustring1-p); p = ustring1 + length2; } else { p += length2; @@ -2181,7 +2181,7 @@ StringMapCmd( * Append the map value to the unicode string. */ - TclAppendUnicodeToObj(resultPtr, + Tcl_AppendUnicodeToObj(resultPtr, mapStrings[index+1], mapLens[index+1]); break; } @@ -2198,7 +2198,7 @@ StringMapCmd( * Put the rest of the unmapped chars onto result. */ - TclAppendUnicodeToObj(resultPtr, p, ustring1 - p); + Tcl_AppendUnicodeToObj(resultPtr, p, ustring1 - p); } Tcl_SetObjResult(interp, resultPtr); done: diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 1345c6c..d95b965 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -1003,7 +1003,9 @@ EXTERN int TclGetUniChar(Tcl_Obj *objPtr, size_t index); /* 383 */ EXTERN Tcl_Obj * TclGetRange(Tcl_Obj *objPtr, size_t first, size_t last); -/* Slot 384 is reserved */ +/* 384 */ +EXTERN void Tcl_AppendUnicodeToObj(Tcl_Obj *objPtr, + const Tcl_UniChar *unicode, size_t length); /* 385 */ EXTERN int Tcl_RegExpMatchObj(Tcl_Interp *interp, Tcl_Obj *textObj, Tcl_Obj *patternObj); @@ -2180,7 +2182,7 @@ typedef struct TclStubs { int (*tclGetUniChar) (Tcl_Obj *objPtr, size_t index); /* 381 */ void (*reserved382)(void); Tcl_Obj * (*tclGetRange) (Tcl_Obj *objPtr, size_t first, size_t last); /* 383 */ - void (*reserved384)(void); + void (*tcl_AppendUnicodeToObj) (Tcl_Obj *objPtr, const Tcl_UniChar *unicode, size_t length); /* 384 */ int (*tcl_RegExpMatchObj) (Tcl_Interp *interp, Tcl_Obj *textObj, Tcl_Obj *patternObj); /* 385 */ void (*tcl_SetNotifier) (const Tcl_NotifierProcs *notifierProcPtr); /* 386 */ Tcl_Mutex * (*tcl_GetAllocMutex) (void); /* 387 */ @@ -3199,7 +3201,8 @@ extern const TclStubs *tclStubsPtr; /* Slot 382 is reserved */ #define TclGetRange \ (tclStubsPtr->tclGetRange) /* 383 */ -/* Slot 384 is reserved */ +#define Tcl_AppendUnicodeToObj \ + (tclStubsPtr->tcl_AppendUnicodeToObj) /* 384 */ #define Tcl_RegExpMatchObj \ (tclStubsPtr->tcl_RegExpMatchObj) /* 385 */ #define Tcl_SetNotifier \ diff --git a/generic/tclExecute.c b/generic/tclExecute.c index d3b9dac..2c08b7d 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -5297,14 +5297,14 @@ TEBCresume( memcmp(ustring1, ustring2, sizeof(Tcl_UniChar) * length2) == 0)) { if (p != ustring1) { - TclAppendUnicodeToObj(objResultPtr, p, ustring1-p); + Tcl_AppendUnicodeToObj(objResultPtr, p, ustring1-p); p = ustring1 + length2; } else { p += length2; } ustring1 = p - 1; - TclAppendUnicodeToObj(objResultPtr, ustring3, length3); + Tcl_AppendUnicodeToObj(objResultPtr, ustring3, length3); } } if (p != ustring1) { @@ -5312,7 +5312,7 @@ TEBCresume( * Put the rest of the unmapped chars onto result. */ - TclAppendUnicodeToObj(objResultPtr, p, ustring1 - p); + Tcl_AppendUnicodeToObj(objResultPtr, p, ustring1 - p); } doneStringMap: TRACE_WITH_OBJ(("%.20s %.20s %.20s => ", diff --git a/generic/tclInt.decls b/generic/tclInt.decls index 2d91d0a..79694a7 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -478,11 +478,6 @@ declare 234 { declare 235 { void TclInitVarHashTable(TclVarHashTable *tablePtr, Namespace *nsPtr) } -# TIP 542 -declare 236 { - void TclAppendUnicodeToObj(Tcl_Obj *objPtr, - const Tcl_UniChar *unicode, size_t length) -} # TIP #285: Script cancellation support. declare 237 { diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index 48cec3d..bf05a0e 100644 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.h @@ -500,9 +500,7 @@ EXTERN Var * TclVarHashCreateVar(TclVarHashTable *tablePtr, /* 235 */ EXTERN void TclInitVarHashTable(TclVarHashTable *tablePtr, Namespace *nsPtr); -/* 236 */ -EXTERN void TclAppendUnicodeToObj(Tcl_Obj *objPtr, - const Tcl_UniChar *unicode, size_t length); +/* Slot 236 is reserved */ /* 237 */ EXTERN int TclResetCancellation(Tcl_Interp *interp, int force); /* 238 */ @@ -819,7 +817,7 @@ typedef struct TclIntStubs { void (*tclGetSrcInfoForPc) (CmdFrame *contextPtr); /* 233 */ Var * (*tclVarHashCreateVar) (TclVarHashTable *tablePtr, const char *key, int *newPtr); /* 234 */ void (*tclInitVarHashTable) (TclVarHashTable *tablePtr, Namespace *nsPtr); /* 235 */ - void (*tclAppendUnicodeToObj) (Tcl_Obj *objPtr, const Tcl_UniChar *unicode, size_t length); /* 236 */ + void (*reserved236)(void); int (*tclResetCancellation) (Tcl_Interp *interp, int force); /* 237 */ int (*tclNRInterpProc) (void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 238 */ int (*tclNRInterpProcCore) (Tcl_Interp *interp, Tcl_Obj *procNameObj, size_t skip, ProcErrorProc *errorProc); /* 239 */ @@ -1211,8 +1209,7 @@ extern const TclIntStubs *tclIntStubsPtr; (tclIntStubsPtr->tclVarHashCreateVar) /* 234 */ #define TclInitVarHashTable \ (tclIntStubsPtr->tclInitVarHashTable) /* 235 */ -#define TclAppendUnicodeToObj \ - (tclIntStubsPtr->tclAppendUnicodeToObj) /* 236 */ +/* Slot 236 is reserved */ #define TclResetCancellation \ (tclIntStubsPtr->tclResetCancellation) /* 237 */ #define TclNRInterpProc \ diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 7cee05d..b5c6520 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -1331,7 +1331,7 @@ Tcl_AppendToObj( /* *---------------------------------------------------------------------- * - * TclAppendUnicodeToObj -- + * Tcl_AppendUnicodeToObj -- * * This function appends a Unicode string to an object in the most * efficient manner possible. Length must be >= 0. @@ -1346,7 +1346,7 @@ Tcl_AppendToObj( */ void -TclAppendUnicodeToObj( +Tcl_AppendUnicodeToObj( Tcl_Obj *objPtr, /* Points to the object to append to. */ const Tcl_UniChar *unicode, /* The unicode string to append to the * object. */ @@ -1355,7 +1355,7 @@ TclAppendUnicodeToObj( String *stringPtr; if (Tcl_IsShared(objPtr)) { - Tcl_Panic("%s called with shared object", "TclAppendUnicodeToObj"); + Tcl_Panic("%s called with shared object", "Tcl_AppendUnicodeToObj"); } if (length == 0) { @@ -3012,7 +3012,7 @@ TclStringRepeat( Tcl_AppendObjToObj(objResultPtr, objResultPtr); done *= 2; } - TclAppendUnicodeToObj(objResultPtr, Tcl_GetUnicode(objResultPtr), + Tcl_AppendUnicodeToObj(objResultPtr, Tcl_GetUnicode(objResultPtr), (count - done) * length); } else { /* @@ -4116,7 +4116,7 @@ TclStringReplace( Tcl_AppendObjToObj(result, insertPtr); } if (first + count < (size_t)numChars) { - TclAppendUnicodeToObj(result, ustring + first + count, + Tcl_AppendUnicodeToObj(result, ustring + first + count, numChars - first - count); } diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 704c51a..9f052e3 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -81,7 +81,7 @@ static void uniCodePanic() { # define TclGetUnicodeFromObj (Tcl_UniChar *(*)(Tcl_Obj *, int *))(void *)uniCodePanic # define Tcl_NewUnicodeObj (Tcl_Obj *(*)(const Tcl_UniChar *, size_t))(void *)uniCodePanic # define Tcl_SetUnicodeObj (void(*)(Tcl_Obj *, const Tcl_UniChar *, size_t))(void *)uniCodePanic -# define TclAppendUnicodeToObj (void(*)(Tcl_Obj *, const Tcl_UniChar *, size_t))(void *)uniCodePanic +# define Tcl_AppendUnicodeToObj (void(*)(Tcl_Obj *, const Tcl_UniChar *, size_t))(void *)uniCodePanic #endif #define TclUtfCharComplete Tcl_UtfCharComplete @@ -528,7 +528,7 @@ static const TclIntStubs tclIntStubs = { TclGetSrcInfoForPc, /* 233 */ TclVarHashCreateVar, /* 234 */ TclInitVarHashTable, /* 235 */ - TclAppendUnicodeToObj, /* 236 */ + 0, /* 236 */ TclResetCancellation, /* 237 */ TclNRInterpProc, /* 238 */ TclNRInterpProcCore, /* 239 */ @@ -1077,7 +1077,7 @@ const TclStubs tclStubs = { TclGetUniChar, /* 381 */ 0, /* 382 */ TclGetRange, /* 383 */ - 0, /* 384 */ + Tcl_AppendUnicodeToObj, /* 384 */ Tcl_RegExpMatchObj, /* 385 */ Tcl_SetNotifier, /* 386 */ Tcl_GetAllocMutex, /* 387 */ diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c index 7ea1723..388eae6 100644 --- a/generic/tclTestObj.c +++ b/generic/tclTestObj.c @@ -1377,7 +1377,7 @@ TeststringobjCmd( return TCL_ERROR; } - TclAppendUnicodeToObj(varPtr[varIndex], unicode + length, size - length); + Tcl_AppendUnicodeToObj(varPtr[varIndex], unicode + length, size - length); Tcl_SetObjResult(interp, varPtr[varIndex]); break; } -- cgit v0.12