summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tcl.decls10
-rw-r--r--generic/tclCkalloc.c26
-rw-r--r--generic/tclCmdAH.c4
-rw-r--r--generic/tclDecls.h44
-rw-r--r--generic/tclEncoding.c11
-rw-r--r--generic/tclIO.c4
-rw-r--r--generic/tclInt.h17
-rw-r--r--generic/tclLink.c12
-rw-r--r--generic/tclLoad.c25
-rw-r--r--generic/tclMain.c2
-rw-r--r--generic/tclStringObj.c11
-rw-r--r--generic/tclStringRep.h2
-rw-r--r--generic/tclStubInit.c7
-rw-r--r--generic/tclUtf.c91
-rw-r--r--generic/tclUtil.c8
-rw-r--r--generic/tclZlib.c8
16 files changed, 199 insertions, 83 deletions
diff --git a/generic/tcl.decls b/generic/tcl.decls
index 5a03bd2..b943edd 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)
@@ -2516,6 +2516,12 @@ declare 660 {
declare 668 {
size_t Tcl_UniCharLen(const int *uniStr)
}
+declare 669 {
+ size_t Tcl_NumUtfChars(const char *src, size_t length)
+}
+declare 671 {
+ const char *Tcl_UtfAtIndex(const char *src, size_t index)
+}
# ----- BASELINE -- FOR -- 8.7.0 ----- #
diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c
index af2c21c..6a6ed31 100644
--- a/generic/tclCkalloc.c
+++ b/generic/tclCkalloc.c
@@ -36,7 +36,7 @@
typedef struct {
size_t refCount; /* Number of mem_headers referencing this
* tag. */
- char string[1]; /* Actual size of string will be as large as
+ char string[TCLFLEXARRAY]; /* Actual size of string will be as large as
* needed for actual tag. This must be the
* last field in the structure. */
} MemTag;
@@ -65,7 +65,7 @@ struct mem_header {
/* Aligns body on 8-byte boundary, plus
* provides at least 8 additional guard bytes
* to detect underruns. */
- char body[1]; /* First byte of client's space. Actual size
+ char body[TCLFLEXARRAY]; /* First byte of client's space. Actual size
* of this field will be larger than one. */
};
@@ -93,8 +93,8 @@ static unsigned int total_mallocs = 0;
static unsigned int total_frees = 0;
static size_t current_bytes_malloced = 0;
static size_t maximum_bytes_malloced = 0;
-static unsigned int current_malloc_packets = 0;
-static unsigned int maximum_malloc_packets = 0;
+static size_t current_malloc_packets = 0;
+static size_t maximum_malloc_packets = 0;
static unsigned int break_on_malloc = 0;
static unsigned int trace_on_at_malloc = 0;
static int alloc_tracing = FALSE;
@@ -188,9 +188,9 @@ TclDumpMemoryInfo(
sprintf(buf,
"total mallocs %10u\n"
"total frees %10u\n"
- "current packets allocated %10u\n"
+ "current packets allocated %10" TCL_Z_MODIFIER "u\n"
"current bytes allocated %10" TCL_Z_MODIFIER "u\n"
- "maximum packets allocated %10u\n"
+ "maximum packets allocated %10" TCL_Z_MODIFIER "u\n"
"maximum bytes allocated %10" TCL_Z_MODIFIER "u\n",
total_mallocs,
total_frees,
@@ -406,9 +406,9 @@ Tcl_DbCkalloc(
}
/* Don't let size argument to TclpAlloc overflow */
- if (size <= UINT_MAX - HIGH_GUARD_SIZE -sizeof(struct mem_header)) {
+ if (size <= UINT_MAX - offsetof(struct mem_header, body) - 1U - HIGH_GUARD_SIZE) {
result = (struct mem_header *) TclpAlloc(size +
- sizeof(struct mem_header) + HIGH_GUARD_SIZE);
+ offsetof(struct mem_header, body) + 1U + HIGH_GUARD_SIZE);
}
if (result == NULL) {
fflush(stdout);
@@ -424,7 +424,7 @@ Tcl_DbCkalloc(
if (init_malloced_bodies) {
memset(result, GUARD_VALUE,
- size + sizeof(struct mem_header) + HIGH_GUARD_SIZE);
+ offsetof(struct mem_header, body) + 1U + HIGH_GUARD_SIZE + size);
} else {
memset(result->low_guard, GUARD_VALUE, LOW_GUARD_SIZE);
memset(result->body + size, GUARD_VALUE, HIGH_GUARD_SIZE);
@@ -496,9 +496,9 @@ Tcl_AttemptDbCkalloc(
}
/* Don't let size argument to TclpAlloc overflow */
- if (size <= UINT_MAX - HIGH_GUARD_SIZE - sizeof(struct mem_header)) {
+ if (size <= UINT_MAX - offsetof(struct mem_header, body) - 1U - HIGH_GUARD_SIZE) {
result = (struct mem_header *) TclpAlloc(size +
- sizeof(struct mem_header) + HIGH_GUARD_SIZE);
+ offsetof(struct mem_header, body) + 1U + HIGH_GUARD_SIZE);
}
if (result == NULL) {
fflush(stdout);
@@ -513,7 +513,7 @@ Tcl_AttemptDbCkalloc(
*/
if (init_malloced_bodies) {
memset(result, GUARD_VALUE,
- size + sizeof(struct mem_header) + HIGH_GUARD_SIZE);
+ offsetof(struct mem_header, body) + 1U + HIGH_GUARD_SIZE + size);
} else {
memset(result->low_guard, GUARD_VALUE, LOW_GUARD_SIZE);
memset(result->body + size, GUARD_VALUE, HIGH_GUARD_SIZE);
@@ -857,7 +857,7 @@ MemoryCmd(
}
if (strcmp(TclGetString(objv[1]),"info") == 0) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "%-25s %10u\n%-25s %10u\n%-25s %10u\n%-25s %10" TCL_Z_MODIFIER"u\n%-25s %10u\n%-25s %10" TCL_Z_MODIFIER "u\n",
+ "%-25s %10u\n%-25s %10u\n%-25s %10" TCL_Z_MODIFIER "u\n%-25s %10" TCL_Z_MODIFIER "u\n%-25s %10" TCL_Z_MODIFIER "u\n%-25s %10" TCL_Z_MODIFIER "u\n",
"total mallocs", total_mallocs, "total frees", total_frees,
"current packets allocated", current_malloc_packets,
"current bytes allocated", current_bytes_malloced,
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index a413113..a236f8f 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -455,7 +455,7 @@ encConvFromOK:
}
result = Tcl_ExternalToUtfDStringEx(encoding, bytesPtr, length,
flags, &ds);
- if (!(flags & TCL_ENCODING_NOCOMPLAIN) && (result != (size_t)-1)) {
+ if (!(flags & TCL_ENCODING_NOCOMPLAIN) && (result != TCL_INDEX_NONE)) {
char buf[TCL_INTEGER_SPACE];
sprintf(buf, "%" TCL_Z_MODIFIER "u", result);
Tcl_SetObjResult(interp, Tcl_ObjPrintf("unexpected byte sequence starting at index %"
@@ -547,7 +547,7 @@ encConvToOK:
stringPtr = Tcl_GetStringFromObj(data, &length);
result = Tcl_UtfToExternalDStringEx(encoding, stringPtr, length,
flags, &ds);
- if (!(flags & TCL_ENCODING_NOCOMPLAIN) && (result != (size_t)-1)) {
+ if (!(flags & TCL_ENCODING_NOCOMPLAIN) && (result != TCL_INDEX_NONE)) {
size_t pos = Tcl_NumUtfChars(stringPtr, result);
int ucs4;
char buf[TCL_INTEGER_SPACE];
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index 30382a3..4fb379c 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 */
@@ -1774,6 +1774,11 @@ 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);
+/* Slot 670 is reserved */
+/* 671 */
+EXTERN const char * Tcl_UtfAtIndex(const char *src, size_t index);
typedef struct {
const struct TclPlatStubs *tclPlatStubs;
@@ -2097,7 +2102,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 +2115,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 */
@@ -2454,6 +2459,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 */
+ void (*reserved670)(void);
+ const char * (*tcl_UtfAtIndex) (const char *src, size_t index); /* 671 */
} TclStubs;
extern const TclStubs *tclStubsPtr;
@@ -3046,8 +3054,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 +3078,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 \
@@ -3736,6 +3744,11 @@ extern const TclStubs *tclStubsPtr;
/* Slot 667 is reserved */
#define Tcl_UniCharLen \
(tclStubsPtr->tcl_UniCharLen) /* 668 */
+#define Tcl_NumUtfChars \
+ (tclStubsPtr->tcl_NumUtfChars) /* 669 */
+/* Slot 670 is reserved */
+#define Tcl_UtfAtIndex \
+ (tclStubsPtr->tcl_UtfAtIndex) /* 671 */
#endif /* defined(USE_TCL_STUBS) */
@@ -3816,6 +3829,15 @@ extern const TclStubs *tclStubsPtr;
} \
} while(0)
+#undef Tcl_UtfToExternalDString
+#define Tcl_UtfToExternalDString(encoding, src, len, ds) \
+ (Tcl_UtfToExternalDStringEx((encoding), (src), (len), \
+ TCL_ENCODING_NOCOMPLAIN, (ds)), Tcl_DStringValue(ds))
+#undef Tcl_ExternalToUtfDString
+#define Tcl_ExternalToUtfDString(encoding, src, len, ds) \
+ (Tcl_ExternalToUtfDStringEx((encoding), (src), (len), \
+ TCL_ENCODING_NOCOMPLAIN, (ds)), Tcl_DStringValue(ds))
+
#if defined(USE_TCL_STUBS)
# if defined(_WIN32) && defined(_WIN64)
# undef Tcl_GetTime
@@ -3936,6 +3958,12 @@ extern const TclStubs *tclStubsPtr;
# define Tcl_UniCharToUtf(c, p) \
((Tcl_UniCharToUtf)((c)|TCL_COMBINE, (p)))
# endif
+#if !defined(BUILD_tcl)
+# undef Tcl_NumUtfChars
+# define Tcl_NumUtfChars TclNumUtfChars
+# undef Tcl_UtfAtIndex
+# define Tcl_UtfAtIndex TclUtfAtIndex
+#endif
#endif
#if defined(USE_TCL_STUBS)
# define Tcl_WCharToUtfDString (sizeof(wchar_t) != sizeof(short) \
diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c
index 5f51ea1..043c725 100644
--- a/generic/tclEncoding.c
+++ b/generic/tclEncoding.c
@@ -1068,6 +1068,7 @@ Tcl_CreateEncoding(
*-------------------------------------------------------------------------
*/
+#undef Tcl_ExternalToUtfDString
char *
Tcl_ExternalToUtfDString(
Tcl_Encoding encoding, /* The encoding for the source string, or NULL
@@ -1078,7 +1079,7 @@ Tcl_ExternalToUtfDString(
Tcl_DString *dstPtr) /* Uninitialized or free DString in which the
* converted string is stored. */
{
- Tcl_ExternalToUtfDStringEx(encoding, src, srcLen, 0, dstPtr);
+ Tcl_ExternalToUtfDStringEx(encoding, src, srcLen, TCL_ENCODING_NOCOMPLAIN, dstPtr);
return Tcl_DStringValue(dstPtr);
}
@@ -1304,7 +1305,7 @@ Tcl_ExternalToUtf(
*
*-------------------------------------------------------------------------
*/
-
+#undef Tcl_UtfToExternalDString
char *
Tcl_UtfToExternalDString(
Tcl_Encoding encoding, /* The encoding for the converted string, or
@@ -1315,7 +1316,7 @@ Tcl_UtfToExternalDString(
Tcl_DString *dstPtr) /* Uninitialized or free DString in which the
* converted string is stored. */
{
- Tcl_UtfToExternalDStringEx(encoding, src, srcLen, 0, dstPtr);
+ Tcl_UtfToExternalDStringEx(encoding, src, srcLen, TCL_ENCODING_NOCOMPLAIN, dstPtr);
return Tcl_DStringValue(dstPtr);
}
@@ -2303,7 +2304,7 @@ UtfToUtfProc(
*/
if (flags & TCL_ENCODING_MODIFIED) {
- if (!(flags & TCL_ENCODING_NOCOMPLAIN)) {
+ if (!(flags & TCL_ENCODING_NOCOMPLAIN) && (flags & TCL_ENCODING_CHAR_LIMIT)) {
result = TCL_CONVERT_MULTIBYTE;
break;
}
@@ -3087,7 +3088,7 @@ TableFromUtfProc(
word = fromUnicode[(ch >> 8)][ch & 0xFF];
if ((word == 0) && (ch != 0)) {
- if (!(flags & TCL_ENCODING_NOCOMPLAIN)) {
+ if (!(flags & TCL_ENCODING_NOCOMPLAIN) && (flags & TCL_ENCODING_CHAR_LIMIT)) {
result = TCL_CONVERT_UNKNOWN;
break;
}
diff --git a/generic/tclIO.c b/generic/tclIO.c
index 55a4792..98675da 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -103,7 +103,7 @@ typedef struct CopyState {
Tcl_Interp *interp; /* Interp that started the copy. */
Tcl_Obj *cmdPtr; /* Command to be invoked at completion. */
int bufSize; /* Size of appended buffer. */
- char buffer[1]; /* Copy buffer, this must be the last
+ char buffer[TCLFLEXARRAY]; /* Copy buffer, this must be the last
* field. */
} CopyState;
@@ -9196,7 +9196,7 @@ TclCopyChannel(
* completed.
*/
- csPtr = (CopyState *)Tcl_Alloc(sizeof(CopyState) + !moveBytes * inStatePtr->bufSize);
+ csPtr = (CopyState *)Tcl_Alloc(offsetof(CopyState, buffer) + 1U + !moveBytes * inStatePtr->bufSize);
csPtr->bufSize = !moveBytes * inStatePtr->bufSize;
csPtr->readPtr = inPtr;
csPtr->writePtr = outPtr;
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 596e1cb..edd0172 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -115,21 +115,24 @@ typedef int ptrdiff_t;
* to/from pointer from/to integer of different size".
*/
-#if !defined(INT2PTR) && !defined(PTR2INT)
+#if !defined(INT2PTR)
# if defined(HAVE_INTPTR_T) || defined(intptr_t)
# define INT2PTR(p) ((void *)(intptr_t)(p))
-# define PTR2INT(p) ((intptr_t)(p))
# else
# define INT2PTR(p) ((void *)(p))
+# endif
+#endif
+#if !defined(PTR2INT)
+# if defined(HAVE_INTPTR_T) || defined(intptr_t)
+# define PTR2INT(p) ((intptr_t)(p))
+# else
# define PTR2INT(p) ((long)(p))
# endif
#endif
-#if !defined(UINT2PTR) && !defined(PTR2UINT)
+#if !defined(PTR2UINT)
# if defined(HAVE_UINTPTR_T) || defined(uintptr_t)
-# define UINT2PTR(p) ((void *)(uintptr_t)(p))
# define PTR2UINT(p) ((uintptr_t)(p))
# else
-# define UINT2PTR(p) ((void *)(p))
# define PTR2UINT(p) ((unsigned long)(p))
# endif
#endif
@@ -4663,12 +4666,12 @@ MODULE_SCOPE const TclFileAttrProcs tclpFileAttrProcs[];
* of counting along a string of all one-byte characters. The ANSI C
* "prototype" for this macro is:
*
- * MODULE_SCOPE void TclNumUtfChars(int numChars, const char *bytes,
+ * MODULE_SCOPE void TclNumUtfCharsM(int numChars, const char *bytes,
* size_t numBytes);
*----------------------------------------------------------------
*/
-#define TclNumUtfChars(numChars, bytes, numBytes) \
+#define TclNumUtfCharsM(numChars, bytes, numBytes) \
do { \
size_t _count, _i = (numBytes); \
unsigned char *_str = (unsigned char *) (bytes); \
diff --git a/generic/tclLink.c b/generic/tclLink.c
index c345614..62c3370 100644
--- a/generic/tclLink.c
+++ b/generic/tclLink.c
@@ -1071,7 +1071,7 @@ LinkTraceProc(
if (linkPtr->flags & LINK_ALLOC_LAST) {
for (i=0; i < objc; i++) {
if (GetInt(objv[i], &valueInt)
- || !InRange(0, valueInt, UCHAR_MAX)) {
+ || !InRange(0, valueInt, (int)UCHAR_MAX)) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
ObjValue(linkPtr), TCL_GLOBAL_ONLY);
return (char *)
@@ -1081,7 +1081,7 @@ LinkTraceProc(
}
} else {
if (GetInt(valueObj, &valueInt)
- || !InRange(0, valueInt, UCHAR_MAX)) {
+ || !InRange(0, valueInt, (int)UCHAR_MAX)) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
ObjValue(linkPtr), TCL_GLOBAL_ONLY);
return (char *) "variable must have unsigned char value";
@@ -1117,7 +1117,7 @@ LinkTraceProc(
if (linkPtr->flags & LINK_ALLOC_LAST) {
for (i=0; i < objc; i++) {
if (GetInt(objv[i], &valueInt)
- || !InRange(0, valueInt, USHRT_MAX)) {
+ || !InRange(0, valueInt, (int)USHRT_MAX)) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
ObjValue(linkPtr), TCL_GLOBAL_ONLY);
return (char *)
@@ -1127,7 +1127,7 @@ LinkTraceProc(
}
} else {
if (GetInt(valueObj, &valueInt)
- || !InRange(0, valueInt, USHRT_MAX)) {
+ || !InRange(0, valueInt, (int)USHRT_MAX)) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
ObjValue(linkPtr), TCL_GLOBAL_ONLY);
return (char *) "variable must have unsigned short value";
@@ -1141,7 +1141,7 @@ LinkTraceProc(
if (linkPtr->flags & LINK_ALLOC_LAST) {
for (i=0; i < objc; i++) {
if (GetWide(objv[i], &valueWide)
- || !InRange(0, valueWide, UINT_MAX)) {
+ || !InRange(0, valueWide, (Tcl_WideInt)UINT_MAX)) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
ObjValue(linkPtr), TCL_GLOBAL_ONLY);
return (char *)
@@ -1151,7 +1151,7 @@ LinkTraceProc(
}
} else {
if (GetWide(valueObj, &valueWide)
- || !InRange(0, valueWide, UINT_MAX)) {
+ || !InRange(0, valueWide, (Tcl_WideInt)UINT_MAX)) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
ObjValue(linkPtr), TCL_GLOBAL_ONLY);
return (char *) "variable must have unsigned int value";
diff --git a/generic/tclLoad.c b/generic/tclLoad.c
index cca5b7a..88f4724 100644
--- a/generic/tclLoad.c
+++ b/generic/tclLoad.c
@@ -536,7 +536,7 @@ Tcl_LoadObjCmd(
*
* Tcl_UnloadObjCmd --
*
- * This function is invoked to process the "unload" Tcl command. See the
+ * Implements the the "unload" Tcl command. See the
* user documentation for details on what it does.
*
* Results:
@@ -754,6 +754,23 @@ Tcl_UnloadObjCmd(
return code;
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UnloadLibrary --
+ *
+ * Unloads a library from an interpreter, and also from the process if it
+ * is unloadable, i.e. if it provides an "unload" function.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See description.
+ *
+ *----------------------------------------------------------------------
+ */
static int
UnloadLibrary(
Tcl_Interp *interp,
@@ -874,11 +891,9 @@ UnloadLibrary(
}
/*
- * The unload function executed fine. Examine the reference count to see
- * if we unload the DLL.
+ * The unload function was called succesfully.
*/
-
Tcl_MutexLock(&libraryMutex);
if (Tcl_IsSafe(target)) {
libraryPtr->safeInterpRefCount--;
@@ -907,7 +922,7 @@ UnloadLibrary(
code = TCL_OK;
if (libraryPtr->safeInterpRefCount <= 0 && libraryPtr->interpRefCount <= 0
- && !keepLibrary) {
+ && (unloadProc != NULL) && !keepLibrary) {
/*
* Unload the shared library from the application memory...
*/
diff --git a/generic/tclMain.c b/generic/tclMain.c
index 2778451..02d8924 100644
--- a/generic/tclMain.c
+++ b/generic/tclMain.c
@@ -53,7 +53,7 @@ NewNativeObj(
Tcl_DStringInit(&ds);
Tcl_WCharToUtfDString(string, -1, &ds);
#else
- Tcl_ExternalToUtfDString(NULL, (char *)string, -1, &ds);
+ (void)Tcl_ExternalToUtfDString(NULL, (char *)string, -1, &ds);
#endif
return TclDStringToObj(&ds);
}
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index 76b703e..fdc39cf 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -71,8 +71,7 @@ static size_t UnicodeLength(const Tcl_UniChar *unicode);
static void UpdateStringOfString(Tcl_Obj *objPtr);
#define ISCONTINUATION(bytes) (\
- ((((bytes)[0] & 0xC0) == 0x80) || (((bytes)[0] == '\xED') \
- && (((bytes)[1] & 0xF0) == 0xB0) && (((bytes)[2] & 0xC0) == 0x80))))
+ ((bytes)[0] & 0xC0) == 0x80)
/*
@@ -440,7 +439,7 @@ Tcl_GetCharLength(
*/
if (numChars == TCL_INDEX_NONE) {
- TclNumUtfChars(numChars, objPtr->bytes, objPtr->length);
+ TclNumUtfCharsM(numChars, objPtr->bytes, objPtr->length);
stringPtr->numChars = numChars;
}
return numChars;
@@ -543,7 +542,7 @@ Tcl_GetUniChar(
*/
if (stringPtr->numChars == TCL_INDEX_NONE) {
- TclNumUtfChars(stringPtr->numChars, objPtr->bytes, objPtr->length);
+ TclNumUtfCharsM(stringPtr->numChars, objPtr->bytes, objPtr->length);
}
if (stringPtr->numChars == objPtr->length) {
return (unsigned char) objPtr->bytes[index];
@@ -709,7 +708,7 @@ Tcl_GetRange(
*/
if (stringPtr->numChars == TCL_INDEX_NONE) {
- TclNumUtfChars(stringPtr->numChars, objPtr->bytes, objPtr->length);
+ TclNumUtfCharsM(stringPtr->numChars, objPtr->bytes, objPtr->length);
}
if (stringPtr->numChars == objPtr->length) {
if (last >= stringPtr->numChars) {
@@ -4045,7 +4044,7 @@ ExtendUnicodeRepWithString(
numOrigChars = stringPtr->numChars;
}
if (numAppendChars == TCL_INDEX_NONE) {
- TclNumUtfChars(numAppendChars, bytes, numBytes);
+ TclNumUtfCharsM(numAppendChars, bytes, numBytes);
}
needed = numOrigChars + numAppendChars;
diff --git a/generic/tclStringRep.h b/generic/tclStringRep.h
index fdbe119..425f08c 100644
--- a/generic/tclStringRep.h
+++ b/generic/tclStringRep.h
@@ -69,7 +69,7 @@ typedef struct {
} String;
#define STRING_SIZE(numChars) \
- (offsetof(String, unicode) + (((numChars) + 1U) * sizeof(Tcl_UniChar)))
+ (offsetof(String, unicode) + sizeof(Tcl_UniChar) + ((numChars) * sizeof(Tcl_UniChar)))
#define stringAttemptAlloc(numChars) \
(String *) Tcl_AttemptAlloc(STRING_SIZE(numChars))
#define stringAlloc(numChars) \
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index ea7083f..59036ec 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 */
@@ -1362,6 +1362,9 @@ const TclStubs tclStubs = {
0, /* 666 */
0, /* 667 */
Tcl_UniCharLen, /* 668 */
+ Tcl_NumUtfChars, /* 669 */
+ 0, /* 670 */
+ Tcl_UtfAtIndex, /* 671 */
};
/* !END!: Do not edit above this line. */
diff --git a/generic/tclUtf.c b/generic/tclUtf.c
index a04e41c..deb6d3e 100644
--- a/generic/tclUtf.c
+++ b/generic/tclUtf.c
@@ -811,6 +811,7 @@ Tcl_UtfCharComplete(
*---------------------------------------------------------------------------
*/
+#undef Tcl_NumUtfChars
size_t
Tcl_NumUtfChars(
const char *src, /* The UTF-8 string to measure. */
@@ -863,6 +864,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;
+}
+
/*
*---------------------------------------------------------------------------
*
@@ -1179,34 +1232,42 @@ Tcl_UniCharAtIndex(
*---------------------------------------------------------------------------
*/
+#undef Tcl_UtfAtIndex
const char *
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;
}
+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;
+}
+
/*
*---------------------------------------------------------------------------
*
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index e340202..bc51a41 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -4010,10 +4010,10 @@ TclGetProcessGlobalValue(
Tcl_MutexLock(&pgvPtr->mutex);
epoch = ++pgvPtr->epoch;
- Tcl_UtfToExternalDString(pgvPtr->encoding, pgvPtr->value,
- pgvPtr->numBytes, &native);
- Tcl_ExternalToUtfDString(current, Tcl_DStringValue(&native),
- Tcl_DStringLength(&native), &newValue);
+ Tcl_UtfToExternalDStringEx(pgvPtr->encoding, pgvPtr->value,
+ pgvPtr->numBytes, TCL_ENCODING_NOCOMPLAIN, &native);
+ Tcl_ExternalToUtfDStringEx(current, Tcl_DStringValue(&native),
+ Tcl_DStringLength(&native), TCL_ENCODING_NOCOMPLAIN, &newValue);
Tcl_DStringFree(&native);
Tcl_Free(pgvPtr->value);
pgvPtr->value = (char *)Tcl_Alloc(Tcl_DStringLength(&newValue) + 1);
diff --git a/generic/tclZlib.c b/generic/tclZlib.c
index a833d04..ebff94b 100644
--- a/generic/tclZlib.c
+++ b/generic/tclZlib.c
@@ -547,8 +547,8 @@ ExtractHeader(
}
}
- Tcl_ExternalToUtfDString(latin1enc, (char *) headerPtr->comment, -1,
- &tmp);
+ Tcl_ExternalToUtfDStringEx(latin1enc, (char *) headerPtr->comment, -1,
+ TCL_ENCODING_NOCOMPLAIN, &tmp);
SetValue(dictObj, "comment", TclDStringToObj(&tmp));
}
SetValue(dictObj, "crc", Tcl_NewBooleanObj(headerPtr->hcrc));
@@ -564,8 +564,8 @@ ExtractHeader(
}
}
- Tcl_ExternalToUtfDString(latin1enc, (char *) headerPtr->name, -1,
- &tmp);
+ Tcl_ExternalToUtfDStringEx(latin1enc, (char *) headerPtr->name, -1,
+ TCL_ENCODING_NOCOMPLAIN, &tmp);
SetValue(dictObj, "filename", TclDStringToObj(&tmp));
}
if (headerPtr->os != 255) {
generated by cgit v0.12 at 2024-09-28 15:23:47 (GMT)