summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tcl.decls4
-rw-r--r--generic/tcl.h29
-rw-r--r--generic/tclBasic.c2
-rw-r--r--generic/tclBinary.c6
-rw-r--r--generic/tclCmdAH.c154
-rw-r--r--generic/tclCompile.h24
-rw-r--r--generic/tclDecls.h17
-rw-r--r--generic/tclEnsemble.c2
-rw-r--r--generic/tclExecute.c2
-rw-r--r--generic/tclFileSystem.h2
-rw-r--r--generic/tclIORChan.c8
-rw-r--r--generic/tclIORTrans.c4
-rw-r--r--generic/tclInt.h72
-rw-r--r--generic/tclLiteral.c8
-rw-r--r--generic/tclNotify.c40
-rw-r--r--generic/tclOO.c6
-rw-r--r--generic/tclOO.h14
-rw-r--r--generic/tclObj.c4
-rw-r--r--generic/tclStringObj.c2
-rw-r--r--generic/tclTest.c2
-rw-r--r--generic/tclThreadTest.c3
-rw-r--r--generic/tclUtil.c2
-rw-r--r--generic/tclVar.c6
23 files changed, 249 insertions, 164 deletions
diff --git a/generic/tcl.decls b/generic/tcl.decls
index 2c5f01c..fc3c8cb 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -734,7 +734,7 @@ declare 204 {
const char *Tcl_PosixError(Tcl_Interp *interp)
}
declare 205 {
- void Tcl_QueueEvent(Tcl_Event *evPtr, Tcl_QueuePosition position)
+ void Tcl_QueueEvent(Tcl_Event *evPtr, int flags)
}
declare 206 {
int Tcl_Read(Tcl_Channel chan, char *bufPtr, int toRead)
@@ -1144,7 +1144,7 @@ declare 318 {
}
declare 319 {
void Tcl_ThreadQueueEvent(Tcl_ThreadId threadId, Tcl_Event *evPtr,
- Tcl_QueuePosition position)
+ int flags)
}
declare 320 {
int Tcl_UniCharAtIndex(const char *src, int index)
diff --git a/generic/tcl.h b/generic/tcl.h
index 33b8217..94196a2 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -47,7 +47,12 @@ extern "C" {
* unix/tcl.spec (1 LOC patch)
*/
+#if !defined(TCL_MAJOR_VERSION)
#define TCL_MAJOR_VERSION 8
+#endif
+#if TCL_MAJOR_VERSION != 8
+#error "This header-file is for Tcl 8 only"
+#endif
#define TCL_MINOR_VERSION 7
#define TCL_RELEASE_LEVEL TCL_ALPHA_RELEASE
#define TCL_RELEASE_SERIAL 6
@@ -578,6 +583,14 @@ typedef struct Tcl_RegExpInfo {
} Tcl_RegExpInfo;
/*
+ * Picky compilers complain if this typdef doesn't appear before the struct's
+ * reference in tclDecls.h.
+ */
+
+typedef Tcl_StatBuf *Tcl_Stat_;
+typedef struct stat *Tcl_OldStat_;
+
+/*
*----------------------------------------------------------------------------
* When a TCL command returns, the interpreter contains a result from the
* command. Programmers are strongly encouraged to use one of the functions
@@ -992,6 +1005,13 @@ typedef struct Tcl_DString {
#define TCL_INDEX_TEMP_TABLE 64
/*
+ * Flags that may be passed to Tcl_UniCharToUtf.
+ * TCL_COMBINE Combine surrogates (default in Tcl 8.x)
+ */
+
+#define TCL_COMBINE 0
+
+/*
*----------------------------------------------------------------------------
* Flag values passed to Tcl_RecordAndEval, Tcl_EvalObj, Tcl_EvalObjv.
* WARNING: these bit choices must not conflict with the bit choices for
@@ -1303,7 +1323,7 @@ typedef struct Tcl_HashSearch {
typedef struct {
void *next; /* Search position for underlying hash
* table. */
- unsigned int epoch; /* Epoch marker for dictionary being searched,
+ TCL_HASH_TYPE epoch; /* Epoch marker for dictionary being searched,
* or 0 if search has terminated. */
Tcl_Dict dictionaryPtr; /* Reference to dictionary being searched. */
} Tcl_DictSearch;
@@ -1336,11 +1356,12 @@ struct Tcl_Event {
};
/*
- * Positions to pass to Tcl_QueueEvent:
+ * Positions to pass to Tcl_QueueEvent/Tcl_ThreadQueueEvent:
*/
typedef enum {
- TCL_QUEUE_TAIL, TCL_QUEUE_HEAD, TCL_QUEUE_MARK
+ TCL_QUEUE_TAIL, TCL_QUEUE_HEAD, TCL_QUEUE_MARK,
+ TCL_QUEUE_ALERT_IF_EMPTY=4
} Tcl_QueuePosition;
/*
@@ -2558,7 +2579,7 @@ EXTERN const char *TclZipfs_AppHook(int *argc, char ***argv);
*/
#define Tcl_GetHashValue(h) ((h)->clientData)
-#define Tcl_SetHashValue(h, value) ((h)->clientData = (ClientData) (value))
+#define Tcl_SetHashValue(h, value) ((h)->clientData = (void *)(value))
#define Tcl_GetHashKey(tablePtr, h) \
((void *) (((tablePtr)->keyType == TCL_ONE_WORD_KEYS || \
(tablePtr)->keyType == TCL_CUSTOM_PTR_KEYS) \
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 5501897..d0af547 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -5354,7 +5354,7 @@ TEOV_RunEnterTraces(
{
Interp *iPtr = (Interp *) interp;
Command *cmdPtr = *cmdPtrPtr;
- unsigned int newEpoch, cmdEpoch = cmdPtr->cmdEpoch;
+ int newEpoch, cmdEpoch = cmdPtr->cmdEpoch;
int length, traceCode = TCL_OK;
const char *command = TclGetStringFromObj(commandPtr, &length);
diff --git a/generic/tclBinary.c b/generic/tclBinary.c
index 5678a66..bf40924 100644
--- a/generic/tclBinary.c
+++ b/generic/tclBinary.c
@@ -556,12 +556,8 @@ TclGetByteArrayFromObj(
baPtr = GET_BYTEARRAY(irPtr);
if (numBytesPtr != NULL) {
-#if TCL_MAJOR_VERSION > 8
- *numBytesPtr = baPtr->used;
-#else
- /* TODO: What's going on here? Document or eliminate. */
+ /* Make sure we return a value between 0 and UINT_MAX-1, or (size_t)-1 */
*numBytesPtr = ((size_t)(unsigned int)(baPtr->used + 1)) - 1;
-#endif
}
return baPtr->bytes;
}
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index 134b226..28fc210 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -556,36 +556,57 @@ EncodingConvertfromObjCmd(
int flags = TCL_ENCODING_NOCOMPLAIN;
#endif
int result;
+ Tcl_Obj *failVarObj = NULL;
+ /*
+ * Decode parameters:
+ * Possible combinations:
+ * 1) data -> objc = 2
+ * 2) encoding data -> objc = 3
+ * 3) -nocomplain data -> objc = 3
+ * 4) -nocomplain encoding data -> objc = 4
+ * 5) -failindex val data -> objc = 4
+ * 6) -failindex val encoding data -> objc = 5
+ */
if (objc == 2) {
encoding = Tcl_GetEncoding(interp, NULL);
data = objv[1];
- } else if ((unsigned)(objc - 2) < 3) {
+ } else if (objc > 2 && objc < 6) {
+ int objcUnprocessed = objc;
data = objv[objc - 1];
bytesPtr = Tcl_GetString(objv[1]);
if (bytesPtr[0] == '-' && bytesPtr[1] == 'n'
&& !strncmp(bytesPtr, "-nocomplain", strlen(bytesPtr))) {
flags = TCL_ENCODING_NOCOMPLAIN;
- } else if (objc < 4) {
- if (Tcl_GetEncodingFromObj(interp, objv[objc - 2], &encoding) != TCL_OK) {
- return TCL_ERROR;
+ objcUnprocessed--;
+ } else if (bytesPtr[0] == '-' && bytesPtr[1] == 'f'
+ && !strncmp(bytesPtr, "-failindex", strlen(bytesPtr))) {
+ /* at least two additional arguments needed */
+ if (objc < 4) {
+ goto encConvFromError;
}
- goto encConvFromOK;
- } else {
- goto encConvFromError;
+ failVarObj = objv[2];
+ flags = TCL_ENCODING_STOPONERROR;
+ objcUnprocessed -= 2;
}
- if (objc < 4) {
- encoding = Tcl_GetEncoding(interp, NULL);
- } else if (Tcl_GetEncodingFromObj(interp, objv[objc - 2], &encoding) != TCL_OK) {
- return TCL_ERROR;
+ switch (objcUnprocessed) {
+ case 3:
+ if (Tcl_GetEncodingFromObj(interp, objv[objc - 2], &encoding) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ break;
+ case 2:
+ encoding = Tcl_GetEncoding(interp, NULL);
+ break;
+ default:
+ goto encConvFromError;
}
} else {
encConvFromError:
- Tcl_WrongNumArgs(interp, 1, objv, "?-nocomplain? ?encoding? data");
+ Tcl_WrongNumArgs(interp, 1, objv, "?-nocomplain? ?-failindex var? ?encoding? data");
return TCL_ERROR;
}
-encConvFromOK:
/*
* Convert the string into a byte array in 'ds'
*/
@@ -601,14 +622,24 @@ encConvFromOK:
result = Tcl_ExternalToUtfDStringEx(encoding, bytesPtr, length,
flags, &ds);
if (!(flags & TCL_ENCODING_NOCOMPLAIN) && (result != TCL_INDEX_NONE)) {
- char buf[TCL_INTEGER_SPACE];
- sprintf(buf, "%u", result);
- Tcl_SetObjResult(interp, Tcl_ObjPrintf("unexpected byte sequence starting at index %"
- "u: '\\x%X'", result, UCHAR(bytesPtr[result])));
- Tcl_SetErrorCode(interp, "TCL", "ENCODING", "ILLEGALSEQUENCE",
- buf, NULL);
- Tcl_DStringFree(&ds);
- return TCL_ERROR;
+ if (failVarObj != NULL) {
+ if (Tcl_ObjSetVar2(interp, failVarObj, NULL, Tcl_NewWideIntObj(result), TCL_LEAVE_ERR_MSG) == NULL) {
+ return TCL_ERROR;
+ }
+ } else {
+ char buf[TCL_INTEGER_SPACE];
+ sprintf(buf, "%u", result);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("unexpected byte sequence starting at index %"
+ "u: '\\x%X'", result, UCHAR(bytesPtr[result])));
+ Tcl_SetErrorCode(interp, "TCL", "ENCODING", "ILLEGALSEQUENCE",
+ buf, NULL);
+ Tcl_DStringFree(&ds);
+ return TCL_ERROR;
+ }
+ } else if (failVarObj != NULL) {
+ if (Tcl_ObjSetVar2(interp, failVarObj, NULL, Tcl_NewIntObj(-1), TCL_LEAVE_ERR_MSG) == NULL) {
+ return TCL_ERROR;
+ }
}
/*
@@ -659,36 +690,58 @@ EncodingConverttoObjCmd(
#else
int flags = TCL_ENCODING_NOCOMPLAIN;
#endif
+ Tcl_Obj *failVarObj = NULL;
+
+ /*
+ * Decode parameters:
+ * Possible combinations:
+ * 1) data -> objc = 2
+ * 2) encoding data -> objc = 3
+ * 3) -nocomplain data -> objc = 3
+ * 4) -nocomplain encoding data -> objc = 4
+ * 5) -failindex val data -> objc = 4
+ * 6) -failindex val encoding data -> objc = 5
+ */
if (objc == 2) {
encoding = Tcl_GetEncoding(interp, NULL);
data = objv[1];
- } else if ((unsigned)(objc - 2) < 3) {
+ } else if (objc > 2 && objc < 6) {
+ int objcUnprocessed = objc;
data = objv[objc - 1];
stringPtr = Tcl_GetString(objv[1]);
if (stringPtr[0] == '-' && stringPtr[1] == 'n'
&& !strncmp(stringPtr, "-nocomplain", strlen(stringPtr))) {
flags = TCL_ENCODING_NOCOMPLAIN;
- } else if (objc < 4) {
- if (Tcl_GetEncodingFromObj(interp, objv[objc - 2], &encoding) != TCL_OK) {
- return TCL_ERROR;
+ objcUnprocessed--;
+ } else if (stringPtr[0] == '-' && stringPtr[1] == 'f'
+ && !strncmp(stringPtr, "-failindex", strlen(stringPtr))) {
+ /* at least two additional arguments needed */
+ if (objc < 4) {
+ goto encConvToError;
}
- goto encConvToOK;
- } else {
- goto encConvToError;
+ failVarObj = objv[2];
+ flags = TCL_ENCODING_STOPONERROR;
+ objcUnprocessed -= 2;
}
- if (objc < 4) {
- encoding = Tcl_GetEncoding(interp, NULL);
- } else if (Tcl_GetEncodingFromObj(interp, objv[objc - 2], &encoding) != TCL_OK) {
- return TCL_ERROR;
+ switch (objcUnprocessed) {
+ case 3:
+ if (Tcl_GetEncodingFromObj(interp, objv[objc - 2], &encoding) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ break;
+ case 2:
+ encoding = Tcl_GetEncoding(interp, NULL);
+ break;
+ default:
+ goto encConvToError;
}
} else {
encConvToError:
- Tcl_WrongNumArgs(interp, 1, objv, "?-nocomplain? ?encoding? data");
+ Tcl_WrongNumArgs(interp, 1, objv, "?-nocomplain? ?-failindex var? ?encoding? data");
return TCL_ERROR;
}
-encConvToOK:
/*
* Convert the string to a byte array in 'ds'
*/
@@ -697,17 +750,28 @@ encConvToOK:
result = Tcl_UtfToExternalDStringEx(encoding, stringPtr, length,
flags, &ds);
if (!(flags & TCL_ENCODING_NOCOMPLAIN) && (result != TCL_INDEX_NONE)) {
- int pos = Tcl_NumUtfChars(stringPtr, result);
- int ucs4;
- char buf[TCL_INTEGER_SPACE];
- TclUtfToUCS4(&stringPtr[result], &ucs4);
- sprintf(buf, "%u", result);
- Tcl_SetObjResult(interp, Tcl_ObjPrintf("unexpected character at index %"
- "u: 'U+%06X'", pos, ucs4));
- Tcl_SetErrorCode(interp, "TCL", "ENCODING", "ILLEGALSEQUENCE",
- buf, NULL);
- Tcl_DStringFree(&ds);
- return TCL_ERROR;
+ if (failVarObj != NULL) {
+ /* I hope, wide int will cover size_t data type */
+ if (Tcl_ObjSetVar2(interp, failVarObj, NULL, Tcl_NewWideIntObj(result), TCL_LEAVE_ERR_MSG) == NULL) {
+ return TCL_ERROR;
+ }
+ } else {
+ size_t pos = Tcl_NumUtfChars(stringPtr, result);
+ int ucs4;
+ char buf[TCL_INTEGER_SPACE];
+ TclUtfToUCS4(&stringPtr[result], &ucs4);
+ sprintf(buf, "%u", result);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("unexpected character at index %"
+ TCL_Z_MODIFIER "u: 'U+%06X'", pos, ucs4));
+ Tcl_SetErrorCode(interp, "TCL", "ENCODING", "ILLEGALSEQUENCE",
+ buf, NULL);
+ Tcl_DStringFree(&ds);
+ return TCL_ERROR;
+ }
+ } else if (failVarObj != NULL) {
+ if (Tcl_ObjSetVar2(interp, failVarObj, NULL, Tcl_NewIntObj(-1), TCL_LEAVE_ERR_MSG) == NULL) {
+ return TCL_ERROR;
+ }
}
Tcl_SetObjResult(interp,
Tcl_NewByteArrayObj((unsigned char*) Tcl_DStringValue(&ds),
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index ae30c19..b3f1c78 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -97,7 +97,7 @@ typedef struct ExceptionRange {
int numCodeBytes; /* Number of bytes in the code range. */
int breakOffset; /* If LOOP_EXCEPTION_RANGE, the target PC
* offset for a break command in the range. */
- int continueOffset; /* If LOOP_EXCEPTION_RANGE and not -1, the
+ int continueOffset; /* If LOOP_EXCEPTION_RANGE and not TCL_INDEX_NONE, the
* target PC offset for a continue command in
* the code range. Otherwise, ignore this
* range when processing a continue
@@ -135,7 +135,7 @@ typedef struct ExceptionAux {
int numBreakTargets; /* The number of [break]s that want to be
* targeted to the place where this loop
* exception will be bound to. */
- unsigned int *breakTargets; /* The offsets of the INST_JUMP4 instructions
+ TCL_HASH_TYPE *breakTargets; /* The offsets of the INST_JUMP4 instructions
* issued by the [break]s that we must
* update. Note that resizing a jump (via
* TclFixupForwardJump) can cause the contents
@@ -145,7 +145,7 @@ typedef struct ExceptionAux {
int numContinueTargets; /* The number of [continue]s that want to be
* targeted to the place where this loop
* exception will be bound to. */
- unsigned int *continueTargets; /* The offsets of the INST_JUMP4 instructions
+ TCL_HASH_TYPE *continueTargets; /* The offsets of the INST_JUMP4 instructions
* issued by the [continue]s that we must
* update. Note that resizing a jump (via
* TclFixupForwardJump) can cause the contents
@@ -221,7 +221,7 @@ typedef void *(AuxDataDupProc) (void *clientData);
typedef void (AuxDataFreeProc) (void *clientData);
typedef void (AuxDataPrintProc)(void *clientData,
Tcl_Obj *appendObj, struct ByteCode *codePtr,
- unsigned int pcOffset);
+ TCL_HASH_TYPE pcOffset);
/*
* We define a separate AuxDataType struct to hold type-related information
@@ -297,9 +297,9 @@ typedef struct CompileEnv {
* information provided by ObjInterpProc in
* tclProc.c. */
int numCommands; /* Number of commands compiled. */
- int exceptDepth; /* Current exception range nesting level; -1
+ int exceptDepth; /* Current exception range nesting level; TCL_INDEX_NONE
* if not in any range currently. */
- int maxExceptDepth; /* Max nesting level of exception ranges; -1
+ int maxExceptDepth; /* Max nesting level of exception ranges; TCL_INDEX_NONE
* if no ranges have been compiled. */
int maxStackDepth; /* Maximum number of stack elements needed to
* execute the code. Set by compilation
@@ -417,7 +417,7 @@ typedef struct ByteCode {
* procs are specific to an interpreter so the
* code emitted will depend on the
* interpreter. */
- unsigned int compileEpoch; /* Value of iPtr->compileEpoch when this
+ int compileEpoch; /* Value of iPtr->compileEpoch when this
* ByteCode was compiled. Used to invalidate
* code when, e.g., commands with compile
* procs are redefined. */
@@ -425,11 +425,11 @@ typedef struct ByteCode {
* compiled. If the code is executed if a
* different namespace, it must be
* recompiled. */
- unsigned int nsEpoch; /* Value of nsPtr->resolverEpoch when this
+ int nsEpoch; /* Value of nsPtr->resolverEpoch when this
* ByteCode was compiled. Used to invalidate
* code when new namespace resolution rules
* are put into effect. */
- unsigned int refCount; /* Reference count: set 1 when created plus 1
+ int refCount; /* Reference count: set 1 when created plus 1
* for each execution of the code currently
* active. This structure can be freed when
* refCount becomes zero. */
@@ -458,7 +458,7 @@ typedef struct ByteCode {
int numCmdLocBytes; /* Number of bytes needed for encoded command
* location information. */
int maxExceptDepth; /* Maximum nesting level of ExceptionRanges;
- * -1 if no ranges were compiled. */
+ * TCL_INDEX_NONE if no ranges were compiled. */
int maxStackDepth; /* Maximum number of stack elements needed to
* execute the code. */
unsigned char *codeStart; /* Points to the first byte of the code. This
@@ -1124,7 +1124,7 @@ MODULE_SCOPE int TclCreateExceptRange(ExceptionRangeType type,
CompileEnv *envPtr);
MODULE_SCOPE ExecEnv * TclCreateExecEnv(Tcl_Interp *interp, int size);
MODULE_SCOPE Tcl_Obj * TclCreateLiteral(Interp *iPtr, const char *bytes,
- int length, unsigned int hash, int *newPtr,
+ int length, TCL_HASH_TYPE hash, int *newPtr,
Namespace *nsPtr, int flags,
LiteralEntry **globalPtrPtr);
MODULE_SCOPE void TclDeleteExecEnv(ExecEnv *eePtr);
@@ -1138,7 +1138,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, unsigned int index);
+MODULE_SCOPE Tcl_Obj * TclFetchLiteral(CompileEnv *envPtr, TCL_HASH_TYPE index);
MODULE_SCOPE int TclFindCompiledLocal(const char *name, int nameChars,
int create, CompileEnv *envPtr);
MODULE_SCOPE int TclFixupForwardJump(CompileEnv *envPtr,
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index dcf2b82..58eb1d0 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -642,8 +642,7 @@ EXTERN int Tcl_PutEnv(const char *assignment);
/* 204 */
EXTERN const char * Tcl_PosixError(Tcl_Interp *interp);
/* 205 */
-EXTERN void Tcl_QueueEvent(Tcl_Event *evPtr,
- Tcl_QueuePosition position);
+EXTERN void Tcl_QueueEvent(Tcl_Event *evPtr, int flags);
/* 206 */
EXTERN int Tcl_Read(Tcl_Channel chan, char *bufPtr, int toRead);
/* 207 */
@@ -981,7 +980,7 @@ EXTERN Tcl_Obj * Tcl_SetVar2Ex(Tcl_Interp *interp, const char *part1,
EXTERN void Tcl_ThreadAlert(Tcl_ThreadId threadId);
/* 319 */
EXTERN void Tcl_ThreadQueueEvent(Tcl_ThreadId threadId,
- Tcl_Event *evPtr, Tcl_QueuePosition position);
+ Tcl_Event *evPtr, int flags);
/* 320 */
EXTERN int Tcl_UniCharAtIndex(const char *src, int index);
/* 321 */
@@ -2237,7 +2236,7 @@ typedef struct TclStubs {
void (*tcl_PrintDouble) (Tcl_Interp *interp, double value, char *dst); /* 202 */
int (*tcl_PutEnv) (const char *assignment); /* 203 */
const char * (*tcl_PosixError) (Tcl_Interp *interp); /* 204 */
- void (*tcl_QueueEvent) (Tcl_Event *evPtr, Tcl_QueuePosition position); /* 205 */
+ void (*tcl_QueueEvent) (Tcl_Event *evPtr, int flags); /* 205 */
int (*tcl_Read) (Tcl_Channel chan, char *bufPtr, int toRead); /* 206 */
void (*tcl_ReapDetachedProcs) (void); /* 207 */
int (*tcl_RecordAndEval) (Tcl_Interp *interp, const char *cmd, int flags); /* 208 */
@@ -2351,7 +2350,7 @@ typedef struct TclStubs {
int (*tcl_SetSystemEncoding) (Tcl_Interp *interp, const char *name); /* 316 */
Tcl_Obj * (*tcl_SetVar2Ex) (Tcl_Interp *interp, const char *part1, const char *part2, Tcl_Obj *newValuePtr, int flags); /* 317 */
void (*tcl_ThreadAlert) (Tcl_ThreadId threadId); /* 318 */
- void (*tcl_ThreadQueueEvent) (Tcl_ThreadId threadId, Tcl_Event *evPtr, Tcl_QueuePosition position); /* 319 */
+ void (*tcl_ThreadQueueEvent) (Tcl_ThreadId threadId, Tcl_Event *evPtr, int flags); /* 319 */
int (*tcl_UniCharAtIndex) (const char *src, int index); /* 320 */
int (*tcl_UniCharToLower) (int ch); /* 321 */
int (*tcl_UniCharToTitle) (int ch); /* 322 */
@@ -4188,7 +4187,7 @@ extern const TclStubs *tclStubsPtr;
Tcl_UpVar2(interp, frameName, varName, NULL, localName, flags)
#undef Tcl_AddErrorInfo
#define Tcl_AddErrorInfo(interp, message) \
- Tcl_AppendObjToErrorInfo(interp, Tcl_NewStringObj(message, -1))
+ Tcl_AppendObjToErrorInfo(interp, Tcl_NewStringObj(message, TCL_INDEX_NONE))
#undef Tcl_AddObjErrorInfo
#define Tcl_AddObjErrorInfo(interp, message, length) \
Tcl_AppendObjToErrorInfo(interp, Tcl_NewStringObj(message, length))
@@ -4211,10 +4210,10 @@ extern const TclStubs *tclStubsPtr;
#define Tcl_GetStringResult(interp) Tcl_GetString(Tcl_GetObjResult(interp))
#undef Tcl_Eval
#define Tcl_Eval(interp, objPtr) \
- Tcl_EvalEx(interp, objPtr, -1, 0)
+ Tcl_EvalEx(interp, objPtr, TCL_INDEX_NONE, 0)
#undef Tcl_GlobalEval
#define Tcl_GlobalEval(interp, objPtr) \
- Tcl_EvalEx(interp, objPtr, -1, TCL_EVAL_GLOBAL)
+ Tcl_EvalEx(interp, objPtr, TCL_INDEX_NONE, TCL_EVAL_GLOBAL)
#undef Tcl_SaveResult
#define Tcl_SaveResult(interp, statePtr) \
do { \
@@ -4237,7 +4236,7 @@ extern const TclStubs *tclStubsPtr;
do { \
const char *__result = result; \
Tcl_FreeProc *__freeProc = freeProc; \
- Tcl_SetObjResult(interp, Tcl_NewStringObj(__result, -1)); \
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(__result, TCL_INDEX_NONE)); \
if (__result != NULL && __freeProc != NULL && __freeProc != TCL_VOLATILE) { \
if (__freeProc == TCL_DYNAMIC) { \
ckfree((char *)__result); \
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index 6c82c6a..5c30a0b 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -105,7 +105,7 @@ static const Tcl_ObjType ensembleCmdType = {
*/
typedef struct {
- unsigned int epoch; /* Used to confirm when the data in this
+ int epoch; /* Used to confirm when the data in this
* really structure matches up with the
* ensemble. */
Command *token; /* Reference to the command for which this
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 2b197c6..923aae3 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -73,7 +73,7 @@ int tclTraceExec = 0;
* expression opcodes (e.g., INST_LOR) in tclCompile.h.
*
* Does not include the string for INST_EXPON (and beyond), as that is
- * disjoint for backward-compatability reasons.
+ * disjoint for backward-compatibility reasons.
*/
static const char *const operatorStrings[] = {
diff --git a/generic/tclFileSystem.h b/generic/tclFileSystem.h
index 1eec7ff..684407c 100644
--- a/generic/tclFileSystem.h
+++ b/generic/tclFileSystem.h
@@ -30,7 +30,7 @@ MODULE_SCOPE Tcl_Obj * TclFSMakePathRelative(Tcl_Interp *interp,
MODULE_SCOPE int TclFSEnsureEpochOk(Tcl_Obj *pathPtr,
const Tcl_Filesystem **fsPtrPtr);
MODULE_SCOPE void TclFSSetPathDetails(Tcl_Obj *pathPtr,
- const Tcl_Filesystem *fsPtr, ClientData clientData);
+ const Tcl_Filesystem *fsPtr, void *clientData);
MODULE_SCOPE Tcl_Obj * TclFSNormalizeAbsolutePath(Tcl_Interp *interp,
Tcl_Obj *pathPtr);
MODULE_SCOPE size_t TclFSEpoch(void);
diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index 75119de..ec82fc5 100644
--- a/generic/tclIORChan.c
+++ b/generic/tclIORChan.c
@@ -994,8 +994,8 @@ TclChanPostEventObjCmd(
* XXX Actually, in that case the channel should be dead also !
*/
- Tcl_ThreadQueueEvent(rcPtr->owner, (Tcl_Event *) ev, TCL_QUEUE_TAIL);
- Tcl_ThreadAlert(rcPtr->owner);
+ Tcl_ThreadQueueEvent(rcPtr->owner, (Tcl_Event *) ev,
+ TCL_QUEUE_TAIL|TCL_QUEUE_ALERT_IF_EMPTY);
}
#endif
@@ -2998,8 +2998,8 @@ ForwardOpToHandlerThread(
* Queue the event and poke the other thread's notifier.
*/
- Tcl_ThreadQueueEvent(dst, (Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
- Tcl_ThreadAlert(dst);
+ Tcl_ThreadQueueEvent(dst, (Tcl_Event *) evPtr,
+ TCL_QUEUE_TAIL|TCL_QUEUE_ALERT_IF_EMPTY);
/*
* (*) Block until the handler thread has either processed the transfer or
diff --git a/generic/tclIORTrans.c b/generic/tclIORTrans.c
index bd7a59f..3fe2585 100644
--- a/generic/tclIORTrans.c
+++ b/generic/tclIORTrans.c
@@ -2454,8 +2454,8 @@ ForwardOpToOwnerThread(
* Queue the event and poke the other thread's notifier.
*/
- Tcl_ThreadQueueEvent(dst, (Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
- Tcl_ThreadAlert(dst);
+ Tcl_ThreadQueueEvent(dst, (Tcl_Event *) evPtr,
+ TCL_QUEUE_TAIL|TCL_QUEUE_ALERT_IF_EMPTY);
/*
* (*) Block until the other thread has either processed the transfer or
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 72107ef..ee3dbf8 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -298,7 +298,7 @@ typedef struct Namespace {
* frames for this namespace that are on the
* Tcl call stack. The namespace won't be
* freed until activationCount becomes zero. */
- unsigned int refCount; /* Count of references by namespaceName
+ int refCount; /* Count of references by namespaceName
* objects. The namespace can't be freed until
* refCount becomes zero. */
Tcl_HashTable cmdTable; /* Contains all the commands currently
@@ -323,12 +323,12 @@ typedef struct Namespace {
* registered using "namespace export". */
int maxExportPatterns; /* Mumber of export patterns for which space
* is currently allocated. */
- unsigned int cmdRefEpoch; /* Incremented if a newly added command
+ int cmdRefEpoch; /* Incremented if a newly added command
* shadows a command for which this namespace
* has already cached a Command* pointer; this
* causes all its cached Command* pointers to
* be invalidated. */
- unsigned int resolverEpoch; /* Incremented whenever (a) the name
+ int resolverEpoch; /* Incremented whenever (a) the name
* resolution rules change for this namespace
* or (b) a newly added command shadows a
* command that is compiled to bytecodes. This
@@ -355,7 +355,7 @@ typedef struct Namespace {
* LookupCompiledLocal to resolve variable
* references within the namespace at compile
* time. */
- unsigned int exportLookupEpoch; /* Incremented whenever a command is added to
+ int exportLookupEpoch; /* Incremented whenever a command is added to
* a namespace, removed from a namespace or
* the exports of a namespace are changed.
* Allows TIP#112-driven command lists to be
@@ -455,7 +455,7 @@ typedef struct EnsembleConfig {
* if the command has been deleted (or never
* existed; the global namespace never has an
* ensemble command.) */
- unsigned int epoch; /* The epoch at which this ensemble's table of
+ int epoch; /* The epoch at which this ensemble's table of
* exported commands is valid. */
char **subcommandArrayPtr; /* Array of ensemble subcommand names. At all
* consistent points, this will have the same
@@ -568,7 +568,7 @@ typedef struct CommandTrace {
struct CommandTrace *nextPtr;
/* Next in list of traces associated with a
* particular command. */
- unsigned int refCount; /* Used to ensure this structure is not
+ int refCount; /* Used to ensure this structure is not
* deleted too early. Keeps track of how many
* pieces of code have a pointer to this
* structure. */
@@ -641,7 +641,7 @@ typedef struct Var {
typedef struct VarInHash {
Var var;
- unsigned int refCount; /* Counts number of active uses of this
+ int refCount; /* Counts number of active uses of this
* variable: 1 for the entry in the hash
* table, 1 for each additional variable whose
* linkPtr points here, 1 for each nested
@@ -978,7 +978,7 @@ typedef struct CompiledLocal {
typedef struct Proc {
struct Interp *iPtr; /* Interpreter for which this command is
* defined. */
- unsigned int refCount; /* Reference count: 1 if still present in
+ int refCount; /* Reference count: 1 if still present in
* command table plus 1 for each call to the
* procedure that is currently active. This
* structure can be freed when refCount
@@ -1095,7 +1095,7 @@ typedef struct AssocData {
*/
typedef struct LocalCache {
- unsigned int refCount;
+ int refCount;
int numVars;
Tcl_Obj *varName0;
} LocalCache;
@@ -1261,7 +1261,7 @@ typedef struct CmdFrame {
typedef struct CFWord {
CmdFrame *framePtr; /* CmdFrame to access. */
int word; /* Index of the word in the command. */
- unsigned int refCount; /* Number of times the word is on the
+ int refCount; /* Number of times the word is on the
* stack. */
} CFWord;
@@ -1529,11 +1529,11 @@ typedef struct LiteralEntry {
* NULL if end of chain. */
Tcl_Obj *objPtr; /* Points to Tcl object that holds the
* literal's bytes and length. */
- unsigned int refCount; /* If in an interpreter's global literal
+ int refCount; /* If in an interpreter's global literal
* table, the number of ByteCode structures
* that share the literal object; the literal
* entry can be freed when refCount drops to
- * 0. If in a local literal table, (unsigned)-1. */
+ * 0. If in a local literal table, TCL_INDEX_NONE. */
Namespace *nsPtr; /* Namespace in which this literal is used. We
* try to avoid sharing literal non-FQ command
* names among different namespaces to reduce
@@ -1547,13 +1547,13 @@ typedef struct LiteralTable {
LiteralEntry *staticBuckets[TCL_SMALL_HASH_TABLE];
/* Bucket array used for small tables to avoid
* mallocs and frees. */
- unsigned int numBuckets; /* Total number of buckets allocated at
+ TCL_HASH_TYPE numBuckets; /* Total number of buckets allocated at
* **buckets. */
- unsigned int numEntries; /* Total number of entries present in
+ TCL_HASH_TYPE numEntries; /* Total number of entries present in
* table. */
- unsigned int rebuildSize; /* Enlarge table when numEntries gets to be
+ TCL_HASH_TYPE rebuildSize; /* Enlarge table when numEntries gets to be
* this large. */
- unsigned int mask; /* Mask value used in hashing function. */
+ TCL_HASH_TYPE mask; /* Mask value used in hashing function. */
} LiteralTable;
/*
@@ -1671,12 +1671,12 @@ typedef struct Command {
* recreated). */
Namespace *nsPtr; /* Points to the namespace containing this
* command. */
- unsigned int refCount; /* 1 if in command hashtable plus 1 for each
+ int refCount; /* 1 if in command hashtable plus 1 for each
* reference from a CmdName Tcl object
* representing a command's name in a ByteCode
* instruction sequence. This structure can be
* freed when refCount becomes zero. */
- unsigned int cmdEpoch; /* Incremented to invalidate any references
+ int cmdEpoch; /* Incremented to invalidate any references
* that point to this command when it is
* renamed, deleted, hidden, or exposed. */
CompileProc *compileProc; /* Procedure called to compile command. NULL
@@ -1728,6 +1728,7 @@ typedef struct Command {
*/
#define CMD_DYING 0x01
+#define CMD_IS_DELETED 0x01 /* Same as CMD_DYING (Deprecated) */
#define CMD_TRACE_ACTIVE 0x02
#define CMD_HAS_EXEC_TRACES 0x04
#define CMD_COMPILES_EXPANDED 0x08
@@ -1900,7 +1901,7 @@ typedef struct Interp {
* See Tcl_AppendResult code for details.
*/
-#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
+#if !defined(TCL_NO_DEPRECATED)
char *appendResult; /* Storage space for results generated by
* Tcl_AppendResult. Ckalloc-ed. NULL means
* not yet allocated. */
@@ -1942,7 +1943,7 @@ typedef struct Interp {
* compiled by the interpreter. Indexed by the
* string representations of literals. Used to
* avoid creating duplicate objects. */
- unsigned int compileEpoch; /* Holds the current "compilation epoch" for
+ int compileEpoch; /* Holds the current "compilation epoch" for
* this interpreter. This is incremented to
* invalidate existing ByteCodes when, e.g., a
* command with a compile procedure is
@@ -1974,13 +1975,11 @@ typedef struct Interp {
* string. Returned by Tcl_ObjSetVar2 when
* variable traces change a variable in a
* gross way. */
-#if TCL_MAJOR_VERSION < 9
-# if !defined(TCL_NO_DEPRECATED)
+#if !defined(TCL_NO_DEPRECATED)
char resultSpace[TCL_DSTRING_STATIC_SIZE+1];
/* Static space holding small results. */
-# else
+#else
char resultSpaceDontUse[TCL_DSTRING_STATIC_SIZE+1];
-# endif
#endif
Tcl_Obj *objResultPtr; /* If the last command returned an object
* result, this points to it. Should not be
@@ -2432,7 +2431,7 @@ typedef enum TclEolTranslation {
*/
typedef struct List {
- unsigned int refCount;
+ int refCount;
int maxElemCount; /* Total number of element array slots. */
int elemCount; /* Current number of list elements. */
int canonicalFlag; /* Set if the string representation was
@@ -2645,7 +2644,7 @@ typedef Tcl_Channel (TclOpenFileChannelProc_)(Tcl_Interp *interp,
*----------------------------------------------------------------
*/
-#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
+#if !defined(TCL_NO_DEPRECATED)
typedef Tcl_CmdProc *TclCmdProcType;
typedef Tcl_ObjCmdProc *TclObjCmdProcType;
#endif
@@ -2656,7 +2655,7 @@ typedef Tcl_ObjCmdProc *TclObjCmdProcType;
*----------------------------------------------------------------
*/
-typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, unsigned int *lengthPtr,
+typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, TCL_HASH_TYPE *lengthPtr,
Tcl_Encoding *encodingPtr);
/*
@@ -2668,9 +2667,9 @@ typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, unsigned int *leng
*/
typedef struct ProcessGlobalValue {
- unsigned int epoch; /* Epoch counter to detect changes in the
+ int epoch; /* Epoch counter to detect changes in the
* global value. */
- unsigned int numBytes; /* Length of the global string. */
+ TCL_HASH_TYPE numBytes; /* Length of the global string. */
char *value; /* The global string value. */
Tcl_Encoding encoding; /* system encoding when global string was
* initialized. */
@@ -2716,7 +2715,7 @@ typedef struct ProcessGlobalValue {
*/
#define TCL_NUMBER_INT 2
-#if (TCL_MAJOR_VERSION < 9) && !defined(TCL_NO_DEPRECATED)
+#if !defined(TCL_NO_DEPRECATED)
# define TCL_NUMBER_LONG 1 /* deprecated, not used any more */
# define TCL_NUMBER_WIDE TCL_NUMBER_INT /* deprecated */
#endif
@@ -3018,8 +3017,7 @@ MODULE_SCOPE int TclFSFileAttrIndex(Tcl_Obj *pathPtr,
MODULE_SCOPE Tcl_Command TclNRCreateCommandInNs(Tcl_Interp *interp,
const char *cmdName, Tcl_Namespace *nsPtr,
Tcl_ObjCmdProc *proc, Tcl_ObjCmdProc *nreProc,
- ClientData clientData,
- Tcl_CmdDeleteProc *deleteProc);
+ void *clientData, Tcl_CmdDeleteProc *deleteProc);
MODULE_SCOPE int TclNREvalFile(Tcl_Interp *interp, Tcl_Obj *pathPtr,
const char *encodingName);
MODULE_SCOPE void TclFSUnloadTempFile(Tcl_LoadHandle loadHandle);
@@ -3043,7 +3041,7 @@ MODULE_SCOPE Tcl_Obj * TclGetProcessGlobalValue(ProcessGlobalValue *pgvPtr);
MODULE_SCOPE Tcl_Obj * TclGetSourceFromFrame(CmdFrame *cfPtr, int objc,
Tcl_Obj *const objv[]);
MODULE_SCOPE char * TclGetStringStorage(Tcl_Obj *objPtr,
- unsigned int *sizePtr);
+ TCL_HASH_TYPE *sizePtr);
MODULE_SCOPE int TclGetLoadedLibraries(Tcl_Interp *interp,
const char *targetName,
const char *packageName);
@@ -3160,7 +3158,7 @@ MODULE_SCOPE int TclpThreadCreate(Tcl_ThreadId *idPtr,
int stackSize, int flags);
MODULE_SCOPE int TclpFindVariable(const char *name, int *lengthPtr);
MODULE_SCOPE void TclpInitLibraryPath(char **valuePtr,
- unsigned int *lengthPtr, Tcl_Encoding *encodingPtr);
+ TCL_HASH_TYPE *lengthPtr, Tcl_Encoding *encodingPtr);
MODULE_SCOPE void TclpInitLock(void);
MODULE_SCOPE ClientData TclpInitNotifier(void);
MODULE_SCOPE void TclpInitPlatform(void);
@@ -3380,7 +3378,7 @@ MODULE_SCOPE Tcl_Command TclInitBinaryCmd(Tcl_Interp *interp);
MODULE_SCOPE int Tcl_BreakObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
-#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
+#if !defined(TCL_NO_DEPRECATED)
MODULE_SCOPE int Tcl_CaseObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
@@ -4541,7 +4539,7 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
(objPtr)->bytes = &tclEmptyString; \
(objPtr)->length = 0; \
} else { \
- (objPtr)->bytes = (char *)ckalloc((unsigned int)(len) + 1U); \
+ (objPtr)->bytes = (char *)ckalloc((len) + 1U); \
memcpy((objPtr)->bytes, (bytePtr) ? (bytePtr) : &tclEmptyString, (len)); \
(objPtr)->bytes[len] = '\0'; \
(objPtr)->length = (len); \
@@ -4586,7 +4584,7 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
(objPtr)->typePtr = NULL; \
}
-#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 8
+#if !defined(TCL_NO_DEPRECATED)
# define TclFreeIntRep(objPtr) TclFreeInternalRep(objPtr)
#endif
diff --git a/generic/tclLiteral.c b/generic/tclLiteral.c
index e1943a1..0c2c545 100644
--- a/generic/tclLiteral.c
+++ b/generic/tclLiteral.c
@@ -229,7 +229,7 @@ TclCreateLiteral(
if (flags & LITERAL_ON_HEAP) {
ckfree(bytes);
}
- if (globalPtr->refCount != (unsigned) -1) {
+ if (globalPtr->refCount != TCL_INDEX_NONE) {
globalPtr->refCount++;
}
return objPtr;
@@ -630,7 +630,7 @@ TclAddLiteralObj(
lPtr = &envPtr->literalArrayPtr[objIndex];
lPtr->objPtr = objPtr;
Tcl_IncrRefCount(objPtr);
- lPtr->refCount = (unsigned) -1; /* i.e., unused */
+ lPtr->refCount = TCL_INDEX_NONE; /* i.e., unused */
lPtr->nextPtr = NULL;
if (litPtrPtr) {
@@ -854,7 +854,7 @@ TclReleaseLiteral(
* literal table entry (decrement the ref count of the object).
*/
- if ((entryPtr->refCount != (unsigned)-1) && (entryPtr->refCount-- <= 1)) {
+ if ((entryPtr->refCount != TCL_INDEX_NONE) && (entryPtr->refCount-- <= 1)) {
if (prevPtr == NULL) {
globalTablePtr->buckets[index] = entryPtr->nextPtr;
} else {
@@ -1183,7 +1183,7 @@ TclVerifyLocalLiteralTable(
for (localPtr=localTablePtr->buckets[i] ; localPtr!=NULL;
localPtr=localPtr->nextPtr) {
count++;
- if (localPtr->refCount != (unsigned)-1) {
+ if (localPtr->refCount != TCL_INDEX_NONE) {
bytes = TclGetStringFromObj(localPtr->objPtr, &length);
Tcl_Panic("%s: local literal \"%.*s\" had bad refCount %u",
"TclVerifyLocalLiteralTable",
diff --git a/generic/tclNotify.c b/generic/tclNotify.c
index 1140168..8613e98 100644
--- a/generic/tclNotify.c
+++ b/generic/tclNotify.c
@@ -95,8 +95,8 @@ TCL_DECLARE_MUTEX(listLock)
* Declarations for routines used only in this file.
*/
-static void QueueEvent(ThreadSpecificData *tsdPtr,
- Tcl_Event *evPtr, Tcl_QueuePosition position);
+static int QueueEvent(ThreadSpecificData *tsdPtr,
+ Tcl_Event *evPtr, int flags);
/*
*----------------------------------------------------------------------
@@ -392,12 +392,12 @@ Tcl_QueueEvent(
* malloc (ckalloc), and it becomes the
* property of the event queue. It will be
* freed after the event has been handled. */
- Tcl_QueuePosition position) /* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD,
- * TCL_QUEUE_MARK. */
+ int flags) /* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD,
+ * TCL_QUEUE_MARK, possibly combined with TCL_QUEUE_ALERT_IF_EMPTY. */
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- QueueEvent(tsdPtr, evPtr, position);
+ (void) QueueEvent(tsdPtr, evPtr, flags);
}
/*
@@ -424,8 +424,8 @@ Tcl_ThreadQueueEvent(
* malloc (ckalloc), and it becomes the
* property of the event queue. It will be
* freed after the event has been handled. */
- Tcl_QueuePosition position) /* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD,
- * TCL_QUEUE_MARK. */
+ int flags) /* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD,
+ * TCL_QUEUE_MARK, possibly combined with TCL_QUEUE_ALERT_IF_EMPTY. */
{
ThreadSpecificData *tsdPtr;
@@ -444,7 +444,9 @@ Tcl_ThreadQueueEvent(
*/
if (tsdPtr) {
- QueueEvent(tsdPtr, evPtr, position);
+ if (QueueEvent(tsdPtr, evPtr, flags)) {
+ Tcl_AlertNotifier(tsdPtr->clientData);
+ }
} else {
ckfree(evPtr);
}
@@ -464,7 +466,8 @@ Tcl_ThreadQueueEvent(
* last-in-first-out order.
*
* Results:
- * None.
+ * For TCL_QUEUE_ALERT_IF_EMPTY the empty state before the
+ * operation is returned.
*
* Side effects:
* None.
@@ -472,7 +475,7 @@ Tcl_ThreadQueueEvent(
*----------------------------------------------------------------------
*/
-static void
+static int
QueueEvent(
ThreadSpecificData *tsdPtr, /* Handle to thread local data that indicates
* which event queue to use. */
@@ -481,11 +484,15 @@ QueueEvent(
* malloc (ckalloc), and it becomes the
* property of the event queue. It will be
* freed after the event has been handled. */
- Tcl_QueuePosition position) /* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD,
- * TCL_QUEUE_MARK. */
+ int flags)
+ /* One of TCL_QUEUE_TAIL_EX,
+ * TCL_QUEUE_HEAD_EX, TCL_QUEUE_MARK_EX,
+ * possibly combined with TCL_QUEUE_ALERT_IF_EMPTY */
{
+ int wasEmpty = 0;
+
Tcl_MutexLock(&(tsdPtr->queueMutex));
- if (position == TCL_QUEUE_TAIL) {
+ if ((flags & 3) == TCL_QUEUE_TAIL) {
/*
* Append the event on the end of the queue.
*/
@@ -493,11 +500,12 @@ QueueEvent(
evPtr->nextPtr = NULL;
if (tsdPtr->firstEventPtr == NULL) {
tsdPtr->firstEventPtr = evPtr;
+ wasEmpty = (flags & TCL_QUEUE_ALERT_IF_EMPTY) ? 1 : 0;
} else {
tsdPtr->lastEventPtr->nextPtr = evPtr;
}
tsdPtr->lastEventPtr = evPtr;
- } else if (position == TCL_QUEUE_HEAD) {
+ } else if ((flags & 3) == TCL_QUEUE_HEAD) {
/*
* Push the event on the head of the queue.
*/
@@ -505,9 +513,10 @@ QueueEvent(
evPtr->nextPtr = tsdPtr->firstEventPtr;
if (tsdPtr->firstEventPtr == NULL) {
tsdPtr->lastEventPtr = evPtr;
+ wasEmpty = (flags & TCL_QUEUE_ALERT_IF_EMPTY) ? 1 : 0;
}
tsdPtr->firstEventPtr = evPtr;
- } else if (position == TCL_QUEUE_MARK) {
+ } else if ((flags & 3) == TCL_QUEUE_MARK) {
/*
* Insert the event after the current marker event and advance the
* marker to the new event.
@@ -526,6 +535,7 @@ QueueEvent(
}
}
Tcl_MutexUnlock(&(tsdPtr->queueMutex));
+ return wasEmpty;
}
/*
diff --git a/generic/tclOO.c b/generic/tclOO.c
index bdceec4..0cd08d2 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -137,7 +137,7 @@ static const Tcl_MethodType classConstructor = {
* file).
*/
-static const char *initScript =
+static const char initScript[] =
#ifndef TCL_NO_DEPRECATED
"package ifneeded TclOO " TCLOO_PATCHLEVEL " {# Already present, OK?};"
#endif
@@ -262,10 +262,10 @@ TclOOInit(
#ifndef TCL_NO_DEPRECATED
Tcl_PkgProvideEx(interp, "TclOO", TCLOO_PATCHLEVEL,
- (void *) &tclOOStubs);
+ &tclOOStubs);
#endif
return Tcl_PkgProvideEx(interp, "tcl::oo", TCLOO_PATCHLEVEL,
- (void *) &tclOOStubs);
+ &tclOOStubs);
}
/*
diff --git a/generic/tclOO.h b/generic/tclOO.h
index 9c1dd1e..4a3398f 100644
--- a/generic/tclOO.h
+++ b/generic/tclOO.h
@@ -60,12 +60,12 @@ typedef struct Tcl_ObjectContext_ *Tcl_ObjectContext;
* and to allow the attachment of arbitrary data to objects and classes.
*/
-typedef int (Tcl_MethodCallProc)(ClientData clientData, Tcl_Interp *interp,
+typedef int (Tcl_MethodCallProc)(void *clientData, Tcl_Interp *interp,
Tcl_ObjectContext objectContext, int objc, Tcl_Obj *const *objv);
-typedef void (Tcl_MethodDeleteProc)(ClientData clientData);
-typedef int (Tcl_CloneProc)(Tcl_Interp *interp, ClientData oldClientData,
- ClientData *newClientData);
-typedef void (Tcl_ObjectMetadataDeleteProc)(ClientData clientData);
+typedef void (Tcl_MethodDeleteProc)(void *clientData);
+typedef int (Tcl_CloneProc)(Tcl_Interp *interp, void *oldClientData,
+ void **newClientData);
+typedef void (Tcl_ObjectMetadataDeleteProc)(void *clientData);
typedef int (Tcl_ObjectMapMethodNameProc)(Tcl_Interp *interp,
Tcl_Object object, Tcl_Class *startClsPtr, Tcl_Obj *methodNameObj);
@@ -95,7 +95,7 @@ typedef struct {
/*
* The correct value for the version field of the Tcl_MethodType structure.
* This allows new versions of the structure to be introduced without breaking
- * binary compatability.
+ * binary compatibility.
*/
#define TCL_OO_METHOD_VERSION_CURRENT 1
@@ -131,7 +131,7 @@ typedef struct {
/*
* The correct value for the version field of the Tcl_ObjectMetadataType
* structure. This allows new versions of the structure to be introduced
- * without breaking binary compatability.
+ * without breaking binary compatibility.
*/
#define TCL_OO_METADATA_VERSION_CURRENT 1
diff --git a/generic/tclObj.c b/generic/tclObj.c
index 8849992..5726596 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -341,12 +341,12 @@ typedef struct ResolvedCmdName {
* it's possible that the cmd's containing
* namespace was deleted and a new one created
* at the same address). */
- unsigned int refNsCmdEpoch; /* Value of the referencing namespace's
+ int refNsCmdEpoch; /* Value of the referencing namespace's
* cmdRefEpoch when the pointer was cached.
* Before using the cached pointer, we check
* if the namespace's epoch was incremented;
* if so, this cached pointer is invalid. */
- unsigned int cmdEpoch; /* Value of the command's cmdEpoch when this
+ int cmdEpoch; /* Value of the command's cmdEpoch when this
* pointer was cached. Before using the cached
* pointer, we check if the cmd's epoch was
* incremented; if so, the cmd was renamed,
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index 13d91d9..86b3937 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -564,7 +564,7 @@ Tcl_NewUnicodeObj(
String *stringPtr = (String *)ckalloc((offsetof(String, unicode)
+ sizeof(unsigned short)) + numChars * sizeof(unsigned short));
- memcpy(stringPtr->unicode, unicode, numChars);
+ memcpy(stringPtr->unicode, unicode, numChars * sizeof(unsigned short));
stringPtr->unicode[numChars] = 0;
stringPtr->numChars = numChars;
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 89ecb8a..5d65b36 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -2193,7 +2193,7 @@ TesteventObjCmd(
"head", "tail", "mark", NULL
};
int posIndex; /* Index of the chosen position */
- static const Tcl_QueuePosition posNum[] = {
+ static const int posNum[] = {
/* Interpretation of the chosen position */
TCL_QUEUE_HEAD,
TCL_QUEUE_TAIL,
diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c
index 49633f2..cf9d0da 100644
--- a/generic/tclThreadTest.c
+++ b/generic/tclThreadTest.c
@@ -878,8 +878,7 @@ ThreadSend(
threadEventPtr->event.proc = ThreadEventProc;
Tcl_ThreadQueueEvent(threadId, (Tcl_Event *) threadEventPtr,
- TCL_QUEUE_TAIL);
- Tcl_ThreadAlert(threadId);
+ TCL_QUEUE_TAIL|TCL_QUEUE_ALERT_IF_EMPTY);
if (!wait) {
Tcl_MutexUnlock(&threadMutex);
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index 2a2f72d..7ab6eae 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -4366,7 +4366,7 @@ TclGetProcessGlobalValue(
Tcl_Obj *value = NULL;
Tcl_HashTable *cacheMap;
Tcl_HashEntry *hPtr;
- unsigned int epoch = pgvPtr->epoch;
+ int epoch = pgvPtr->epoch;
if (pgvPtr->encoding) {
Tcl_Encoding current = Tcl_GetEncoding(NULL, NULL);
diff --git a/generic/tclVar.c b/generic/tclVar.c
index 0ab2c55..2ef51b2 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -381,8 +381,7 @@ CleanupVar(
{
if (TclIsVarUndefined(varPtr) && TclIsVarInHash(varPtr)
&& !TclIsVarTraced(varPtr)
- && (VarHashRefCount(varPtr) == (unsigned)
- !TclIsVarDeadHash(varPtr))) {
+ && (VarHashRefCount(varPtr) == !TclIsVarDeadHash(varPtr))) {
if (VarHashRefCount(varPtr) == 0) {
ckfree(varPtr);
} else {
@@ -391,8 +390,7 @@ CleanupVar(
}
if (arrayPtr != NULL && TclIsVarUndefined(arrayPtr) &&
TclIsVarInHash(arrayPtr) && !TclIsVarTraced(arrayPtr) &&
- (VarHashRefCount(arrayPtr) == (unsigned)
- !TclIsVarDeadHash(arrayPtr))) {
+ (VarHashRefCount(arrayPtr) == !TclIsVarDeadHash(arrayPtr))) {
if (VarHashRefCount(arrayPtr) == 0) {
ckfree(arrayPtr);
} else {
generated by cgit v0.12 at 2024-11-17 14:01:01 (GMT)