summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tcl.h32
-rw-r--r--generic/tclAlloc.c6
-rw-r--r--generic/tclBasic.c66
-rw-r--r--generic/tclCkalloc.c2
-rw-r--r--generic/tclCmdMZ.c14
-rw-r--r--generic/tclCompCmdsGR.c44
-rw-r--r--generic/tclEnsemble.c108
-rw-r--r--generic/tclEvent.c10
-rw-r--r--generic/tclIORChan.c48
-rw-r--r--generic/tclIORTrans.c38
-rw-r--r--generic/tclIOUtil.c4
-rw-r--r--generic/tclInt.h77
-rw-r--r--generic/tclIntPlatDecls.h5
-rw-r--r--generic/tclObj.c22
-rw-r--r--generic/tclPkgConfig.c2
-rw-r--r--generic/tclStrToD.c4
-rw-r--r--generic/tclStringObj.c279
-rw-r--r--generic/tclStubInit.c9
-rw-r--r--generic/tclTest.c8
-rw-r--r--generic/tclThread.c35
-rw-r--r--generic/tclThreadAlloc.c2
-rw-r--r--generic/tclThreadStorage.c2
-rw-r--r--generic/tclThreadTest.c2
-rw-r--r--generic/tclVar.c284
24 files changed, 570 insertions, 533 deletions
diff --git a/generic/tcl.h b/generic/tcl.h
index a5f85df..de314fa 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -89,6 +89,10 @@ extern "C" {
# define JOIN(a,b) JOIN1(a,b)
# define JOIN1(a,b) a##b
#endif
+
+#ifndef TCL_THREADS
+# define TCL_THREADS 1
+#endif
#endif /* !TCL_NO_DEPRECATED */
/*
@@ -103,15 +107,10 @@ extern "C" {
#ifndef RC_INVOKED
/*
- * Special macro to define mutexes, that doesn't do anything if we are not
- * using threads.
+ * Special macro to define mutexes.
*/
-#ifdef TCL_THREADS
#define TCL_DECLARE_MUTEX(name) static Tcl_Mutex name;
-#else
-#define TCL_DECLARE_MUTEX(name)
-#endif
/*
* Tcl's public routine Tcl_FSSeek() uses the values SEEK_SET, SEEK_CUR, and
@@ -2557,27 +2556,6 @@ EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr);
/*
*----------------------------------------------------------------------------
- * Macros that eliminate the overhead of the thread synchronization functions
- * when compiling without thread support.
- */
-
-#ifndef TCL_THREADS
-#undef Tcl_MutexLock
-#define Tcl_MutexLock(mutexPtr)
-#undef Tcl_MutexUnlock
-#define Tcl_MutexUnlock(mutexPtr)
-#undef Tcl_MutexFinalize
-#define Tcl_MutexFinalize(mutexPtr)
-#undef Tcl_ConditionNotify
-#define Tcl_ConditionNotify(condPtr)
-#undef Tcl_ConditionWait
-#define Tcl_ConditionWait(condPtr, mutexPtr, timePtr)
-#undef Tcl_ConditionFinalize
-#define Tcl_ConditionFinalize(condPtr)
-#endif /* TCL_THREADS */
-
-/*
- *----------------------------------------------------------------------------
* Deprecated Tcl functions:
*/
diff --git a/generic/tclAlloc.c b/generic/tclAlloc.c
index 8a4b1c8..df1718b 100644
--- a/generic/tclAlloc.c
+++ b/generic/tclAlloc.c
@@ -22,7 +22,7 @@
*/
#include "tclInt.h"
-#if !defined(TCL_THREADS) || !defined(USE_THREAD_ALLOC)
+#if !TCL_THREADS || !defined(USE_THREAD_ALLOC)
#if USE_TCLALLOC
@@ -121,7 +121,7 @@ static struct block bigBlocks={ /* Big blocks aren't suballocated. */
* variable.
*/
-#ifdef TCL_THREADS
+#if TCL_THREADS
static Tcl_Mutex *allocMutexPtr;
#endif
static int allocInit = 0;
@@ -171,7 +171,7 @@ TclInitAlloc(void)
{
if (!allocInit) {
allocInit = 1;
-#ifdef TCL_THREADS
+#if TCL_THREADS
allocMutexPtr = Tcl_GetAllocMutex();
#endif
}
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 16d7f7c..9c2736c 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -749,7 +749,7 @@ Tcl_CreateInterp(void)
* cache was already initialised by the call to alloc the interp struct.
*/
-#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
+#if TCL_THREADS && defined(USE_THREAD_ALLOC)
iPtr->allocCache = TclpGetAllocCache();
#else
iPtr->allocCache = NULL;
@@ -964,7 +964,7 @@ Tcl_CreateInterp(void)
#endif /* !TCL_NO_DEPRECATED */
TclpSetVariables(interp);
-#ifdef TCL_THREADS
+#if TCL_THREADS
/*
* The existence of the "threaded" element of the tcl_platform array
* indicates that this particular Tcl shell has been compiled with threads
@@ -2295,30 +2295,33 @@ Tcl_CreateObjCommand(
}
Tcl_Command
-TclCreateObjCommandInNs (
+TclCreateObjCommandInNs(
Tcl_Interp *interp,
- const char *cmdName, /* Name of command, without any namespace components */
+ const char *cmdName, /* Name of command, without any namespace
+ * components. */
Tcl_Namespace *namespace, /* The namespace to create the command in */
Tcl_ObjCmdProc *proc, /* Object-based function to associate with
* name. */
ClientData clientData, /* Arbitrary value to pass to object
* function. */
- Tcl_CmdDeleteProc *deleteProc
+ Tcl_CmdDeleteProc *deleteProc)
/* If not NULL, gives a function to call when
* this command is deleted. */
-) {
+{
int deleted = 0, isNew = 0;
Command *cmdPtr;
ImportRef *oldRefPtr = NULL;
ImportedCmdData *dataPtr;
Tcl_HashEntry *hPtr;
Namespace *nsPtr = (Namespace *) namespace;
+
/*
- * If the command name we seek to create already exists, we need to
- * delete that first. That can be tricky in the presence of traces.
- * Loop until we no longer find an existing command in the way, or
- * until we've deleted one command and that didn't finish the job.
+ * If the command name we seek to create already exists, we need to delete
+ * that first. That can be tricky in the presence of traces. Loop until we
+ * no longer find an existing command in the way, or until we've deleted
+ * one command and that didn't finish the job.
*/
+
while (1) {
hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, cmdName, &isNew);
@@ -2330,16 +2333,18 @@ TclCreateObjCommandInNs (
break;
}
+ /*
+ * An existing command conflicts. Try to delete it.
+ */
- /* An existing command conflicts. Try to delete it.. */
cmdPtr = Tcl_GetHashValue(hPtr);
/*
- * [***] This is wrong. See Tcl Bug a16752c252.
- * However, this buggy behavior is kept under particular
- * circumstances to accommodate deployed binaries of the
- * "tclcompiler" program. http://sourceforge.net/projects/tclpro/
- * that crash if the bug is fixed.
+ * [***] This is wrong. See Tcl Bug a16752c252. However, this buggy
+ * behavior is kept under particular circumstances to accommodate
+ * deployed binaries of the "tclcompiler" program
+ * http://sourceforge.net/projects/tclpro/
+ * that crash if the bug is fixed.
*/
if (cmdPtr->objProc == TclInvokeStringCommand
@@ -2363,12 +2368,15 @@ TclCreateObjCommandInNs (
cmdPtr->flags |= CMD_REDEF_IN_PROGRESS;
}
- /* Make sure namespace doesn't get deallocated. */
+ /*
+ * Make sure namespace doesn't get deallocated.
+ */
+
cmdPtr->nsPtr->refCount++;
Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);
nsPtr = (Namespace *) TclEnsureNamespace(interp,
- (Tcl_Namespace *)cmdPtr->nsPtr);
+ (Tcl_Namespace *) cmdPtr->nsPtr);
TclNsDecrRefCount(cmdPtr->nsPtr);
if (cmdPtr->flags & CMD_REDEF_IN_PROGRESS) {
@@ -2380,9 +2388,9 @@ TclCreateObjCommandInNs (
}
if (!isNew) {
/*
- * If the deletion callback recreated the command, just throw away
- * the new command (if we try to delete it again, we could get
- * stuck in an infinite loop).
+ * If the deletion callback recreated the command, just throw away the
+ * new command (if we try to delete it again, we could get stuck in an
+ * infinite loop).
*/
ckfree(Tcl_GetHashValue(hPtr));
@@ -2437,6 +2445,7 @@ TclCreateObjCommandInNs (
cmdPtr->importRefPtr = oldRefPtr;
while (oldRefPtr != NULL) {
Command *refCmdPtr = oldRefPtr->importedCmdPtr;
+
dataPtr = refCmdPtr->objClientData;
dataPtr->realCmdPtr = cmdPtr;
oldRefPtr = oldRefPtr->nextPtr;
@@ -8276,23 +8285,26 @@ Tcl_NRCreateCommand(
* this command is deleted. */
{
Command *cmdPtr = (Command *)
- Tcl_CreateObjCommand(interp,cmdName,proc,clientData,deleteProc);
+ Tcl_CreateObjCommand(interp, cmdName, proc, clientData,
+ deleteProc);
cmdPtr->nreProc = nreProc;
return (Tcl_Command) cmdPtr;
}
Tcl_Command
-TclNRCreateCommandInNs (
+TclNRCreateCommandInNs(
Tcl_Interp *interp,
const char *cmdName,
Tcl_Namespace *nsPtr,
Tcl_ObjCmdProc *proc,
Tcl_ObjCmdProc *nreProc,
ClientData clientData,
- Tcl_CmdDeleteProc *deleteProc) {
+ Tcl_CmdDeleteProc *deleteProc)
+{
Command *cmdPtr = (Command *)
- TclCreateObjCommandInNs(interp,cmdName,nsPtr,proc,clientData,deleteProc);
+ TclCreateObjCommandInNs(interp, cmdName, nsPtr, proc, clientData,
+ deleteProc);
cmdPtr->nreProc = nreProc;
return (Tcl_Command) cmdPtr;
@@ -8396,7 +8408,6 @@ TclPushTailcallPoint(
TclNRAddCallback(interp, NRCommand, NULL, NULL, NULL, NULL);
((Interp *) interp)->numLevels++;
}
-
/*
*----------------------------------------------------------------------
@@ -8432,7 +8443,6 @@ TclSetTailcall(
}
runPtr->data[1] = listPtr;
}
-
/*
*----------------------------------------------------------------------
@@ -8508,7 +8518,6 @@ TclNRTailcallObjCmd(
}
return TCL_RETURN;
}
-
/*
*----------------------------------------------------------------------
@@ -8576,7 +8585,6 @@ TclNRReleaseValues(
}
return result;
}
-
void
Tcl_NRAddCallback(
diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c
index de767f9..e3fb98e 100644
--- a/generic/tclCkalloc.c
+++ b/generic/tclCkalloc.c
@@ -156,7 +156,7 @@ TclInitDbCkalloc(void)
if (!ckallocInit) {
ckallocInit = 1;
ckallocMutexPtr = Tcl_GetAllocMutex();
-#ifndef TCL_THREADS
+#if !TCL_THREADS
/* Silence compiler warning */
(void)ckallocMutexPtr;
#endif
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index d903afd..70d43a5 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -2643,7 +2643,7 @@ StringEqualCmd(
objv += objc-2;
- match = TclStringCmp (objv[0], objv[1], 0, nocase, reqlength);
+ match = TclStringCmp(objv[0], objv[1], 0, nocase, reqlength);
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(match ? 0 : 1));
return TCL_OK;
@@ -2682,25 +2682,23 @@ StringCmpCmd(
int match, nocase, reqlength, status;
- if ((status = TclStringCmpOpts(interp, objc, objv, &nocase, &reqlength))
- != TCL_OK) {
-
+ status = TclStringCmpOpts(interp, objc, objv, &nocase, &reqlength);
+ if (status != TCL_OK) {
return status;
}
objv += objc-2;
- match = TclStringCmp (objv[0], objv[1], 0, nocase, reqlength);
+ match = TclStringCmp(objv[0], objv[1], 0, nocase, reqlength);
Tcl_SetObjResult(interp, Tcl_NewIntObj(match));
return TCL_OK;
}
-int TclStringCmpOpts (
+int TclStringCmpOpts(
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[], /* Argument objects. */
int *nocase,
- int *reqlength
-)
+ int *reqlength)
{
int i, length;
const char *string;
diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c
index 3781b9a..858a0c5 100644
--- a/generic/tclCompCmdsGR.c
+++ b/generic/tclCompCmdsGR.c
@@ -27,7 +27,6 @@ static void CompileReturnInternal(CompileEnv *envPtr,
Tcl_Obj *returnOpts);
static int IndexTailVarIfKnown(Tcl_Interp *interp,
Tcl_Token *varTokenPtr, CompileEnv *envPtr);
-
/*
*----------------------------------------------------------------------
@@ -127,9 +126,12 @@ TclCompileGlobalCmd(
return TCL_ERROR;
}
- /* TODO: Consider what value can pass through the
- * IndexTailVarIfKnown() screen. Full CompileWord()
- * likely does not apply here. Push known value instead. */
+ /*
+ * TODO: Consider what value can pass through the
+ * IndexTailVarIfKnown() screen. Full CompileWord() likely does not
+ * apply here. Push known value instead.
+ */
+
CompileWord(envPtr, varTokenPtr, interp, i);
TclEmitInstInt4( INST_NSUPVAR, localIndex, envPtr);
}
@@ -270,7 +272,7 @@ TclCompileIfCmd(
jumpIndex = jumpFalseFixupArray.next;
jumpFalseFixupArray.next++;
TclEmitForwardJump(envPtr, TCL_FALSE_JUMP,
- jumpFalseFixupArray.fixup+jumpIndex);
+ jumpFalseFixupArray.fixup + jumpIndex);
}
code = TCL_OK;
}
@@ -317,7 +319,7 @@ TclCompileIfCmd(
}
jumpEndFixupArray.next++;
TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
- jumpEndFixupArray.fixup+jumpIndex);
+ jumpEndFixupArray.fixup + jumpIndex);
/*
* Fix the target of the jumpFalse after the test. Generate a 4
@@ -329,7 +331,7 @@ TclCompileIfCmd(
TclAdjustStackDepth(-1, envPtr);
if (TclFixupForwardJumpToHere(envPtr,
- jumpFalseFixupArray.fixup+jumpIndex, 120)) {
+ jumpFalseFixupArray.fixup + jumpIndex, 120)) {
/*
* Adjust the code offset for the proceeding jump to the end
* of the "if" command.
@@ -412,7 +414,7 @@ TclCompileIfCmd(
for (j = jumpEndFixupArray.next; j > 0; j--) {
jumpIndex = (j - 1); /* i.e. process the closest jump first. */
if (TclFixupForwardJumpToHere(envPtr,
- jumpEndFixupArray.fixup+jumpIndex, 127)) {
+ jumpEndFixupArray.fixup + jumpIndex, 127)) {
/*
* Adjust the immediately preceeding "ifFalse" jump. We moved it's
* target (just after this jump) down three bytes.
@@ -920,7 +922,7 @@ TclCompileLappendCmd(
CompileWord(envPtr, valueTokenPtr, interp, i);
valueTokenPtr = TokenAfter(valueTokenPtr);
}
- TclEmitInstInt4( INST_LIST, numWords-2, envPtr);
+ TclEmitInstInt4( INST_LIST, numWords - 2, envPtr);
if (isScalar) {
if (localIndex < 0) {
TclEmitOpcode( INST_LAPPEND_LIST_STK, envPtr);
@@ -997,7 +999,7 @@ TclCompileLassignCmd(
*/
PushVarNameWord(interp, tokenPtr, envPtr, 0, &localIndex,
- &isScalar, idx+2);
+ &isScalar, idx + 2);
/*
* Emit instructions to get the idx'th item out of the list value on
@@ -1414,7 +1416,7 @@ TclCompileLinsertCmd(
tokenPtr = TokenAfter(tokenPtr);
CompileWord(envPtr, tokenPtr, interp, i);
}
- TclEmitInstInt4( INST_LIST, i-3, envPtr);
+ TclEmitInstInt4( INST_LIST, i - 3, envPtr);
if (idx == TCL_INDEX_START) {
TclEmitInstInt4( INST_REVERSE, 2, envPtr);
@@ -1439,7 +1441,7 @@ TclCompileLinsertCmd(
}
TclEmitInstInt4( INST_OVER, 1, envPtr);
TclEmitInstInt4( INST_LIST_RANGE_IMM, 0, envPtr);
- TclEmitInt4( idx-1, envPtr);
+ TclEmitInt4( idx - 1, envPtr);
TclEmitInstInt4( INST_REVERSE, 3, envPtr);
TclEmitInstInt4( INST_LIST_RANGE_IMM, idx, envPtr);
TclEmitInt4( TCL_INDEX_END, envPtr);
@@ -2234,7 +2236,7 @@ TclCompileRegexpCmd(
}
if (!simple) {
- CompileWord(envPtr, varTokenPtr, interp, parsePtr->numWords-2);
+ CompileWord(envPtr, varTokenPtr, interp, parsePtr->numWords - 2);
}
/*
@@ -2242,7 +2244,7 @@ TclCompileRegexpCmd(
*/
varTokenPtr = TokenAfter(varTokenPtr);
- CompileWord(envPtr, varTokenPtr, interp, parsePtr->numWords-1);
+ CompileWord(envPtr, varTokenPtr, interp, parsePtr->numWords - 1);
if (simple) {
if (exact && !nocase) {
@@ -2426,7 +2428,7 @@ TclCompileRegsubCmd(
PushLiteral(envPtr, bytes, len);
bytes = TclGetStringFromObj(replacementObj, &len);
PushLiteral(envPtr, bytes, len);
- CompileWord(envPtr, stringTokenPtr, interp, parsePtr->numWords-2);
+ CompileWord(envPtr, stringTokenPtr, interp, parsePtr->numWords - 2);
TclEmitOpcode( INST_STR_MAP, envPtr);
done:
@@ -2555,7 +2557,7 @@ TclCompileReturnCmd(
*/
if (explicitResult) {
- CompileWord(envPtr, wordTokenPtr, interp, numWords-1);
+ CompileWord(envPtr, wordTokenPtr, interp, numWords - 1);
} else {
/*
* No explict result argument, so default result is empty string.
@@ -2633,7 +2635,7 @@ TclCompileReturnCmd(
*/
if (explicitResult) {
- CompileWord(envPtr, wordTokenPtr, interp, numWords-1);
+ CompileWord(envPtr, wordTokenPtr, interp, numWords - 1);
} else {
PushStringLiteral(envPtr, "");
}
@@ -2864,12 +2866,12 @@ TclCompileVariableCmd(
CompileWord(envPtr, varTokenPtr, interp, i);
TclEmitInstInt4( INST_VARIABLE, localIndex, envPtr);
- if (i+1 < numWords) {
+ if (i + 1 < numWords) {
/*
* A value has been given: set the variable, pop the value
*/
- CompileWord(envPtr, valueTokenPtr, interp, i+1);
+ CompileWord(envPtr, valueTokenPtr, interp, i + 1);
Emit14Inst( INST_STORE_SCALAR, localIndex, envPtr);
TclEmitOpcode( INST_POP, envPtr);
}
@@ -2945,7 +2947,7 @@ IndexTailVarIfKnown(
tailName = TclGetStringFromObj(tailPtr, &len);
if (len) {
- if (*(tailName+len-1) == ')') {
+ if (*(tailName + len - 1) == ')') {
/*
* Possible array: bail out
*/
@@ -2959,7 +2961,7 @@ IndexTailVarIfKnown(
*/
for (p = tailName + len -1; p > tailName; p--) {
- if ((*p == ':') && (*(p-1) == ':')) {
+ if ((*p == ':') && (*(p - 1) == ':')) {
p++;
break;
}
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index e7bfbac..94c0b76 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -87,8 +87,8 @@ static const Tcl_ObjType ensembleCmdType = {
};
/*
- * The internal rep for caching ensemble subcommand lookups and
- * spell corrections.
+ * The internal rep for caching ensemble subcommand lookups and spelling
+ * corrections.
*/
typedef struct {
@@ -98,10 +98,9 @@ typedef struct {
Command *token; /* Reference to the command for which this
* structure is a cache of the resolution. */
Tcl_Obj *fix; /* Corrected spelling, if needed. */
- Tcl_HashEntry *hPtr; /* Direct link to entry in the subcommand
- * hash table. */
+ Tcl_HashEntry *hPtr; /* Direct link to entry in the subcommand hash
+ * table. */
} EnsembleCmdRep;
-
static inline Tcl_Obj *
NewNsObj(
@@ -111,9 +110,8 @@ NewNsObj(
if (namespacePtr == TclGetGlobalNamespace(nsPtr->interp)) {
return Tcl_NewStringObj("::", 2);
- } else {
- return Tcl_NewStringObj(nsPtr->fullName, -1);
}
+ return Tcl_NewStringObj(nsPtr->fullName, -1);
}
/*
@@ -147,7 +145,7 @@ TclNamespaceEnsembleCmd(
{
Tcl_Namespace *namespacePtr;
Namespace *nsPtr = (Namespace *) TclGetCurrentNamespace(interp), *cxtPtr,
- *foundNsPtr, *altFoundNsPtr, *actualCxtPtr;
+ *foundNsPtr, *altFoundNsPtr, *actualCxtPtr;
Tcl_Command token;
Tcl_DictSearch search;
Tcl_Obj *listObj;
@@ -302,7 +300,8 @@ TclNamespaceEnsembleCmd(
Tcl_DictObjPut(NULL, patchedDict, subcmdWordsObj,
newList);
}
- Tcl_DictObjNext(&search, &subcmdWordsObj,&listObj, &done);
+ Tcl_DictObjNext(&search, &subcmdWordsObj, &listObj,
+ &done);
} while (!done);
if (allocatedMapFlag) {
@@ -336,8 +335,8 @@ TclNamespaceEnsembleCmd(
}
TclGetNamespaceForQualName(interp, name, cxtPtr,
- TCL_CREATE_NS_IF_UNKNOWN, &foundNsPtr, &altFoundNsPtr, &actualCxtPtr,
- &simpleName);
+ TCL_CREATE_NS_IF_UNKNOWN, &foundNsPtr, &altFoundNsPtr,
+ &actualCxtPtr, &simpleName);
/*
* Create the ensemble. Note that this might delete another ensemble
@@ -347,8 +346,8 @@ TclNamespaceEnsembleCmd(
*/
token = TclCreateEnsembleInNs(interp, simpleName,
- (Tcl_Namespace *) foundNsPtr, (Tcl_Namespace *) nsPtr,
- (permitPrefix ? TCL_ENSEMBLE_PREFIX : 0));
+ (Tcl_Namespace *) foundNsPtr, (Tcl_Namespace *) nsPtr,
+ (permitPrefix ? TCL_ENSEMBLE_PREFIX : 0));
Tcl_SetEnsembleSubcommandList(interp, token, subcmdObj);
Tcl_SetEnsembleMappingDict(interp, token, mapObj);
Tcl_SetEnsembleUnknownHandler(interp, token, unknownObj);
@@ -576,7 +575,8 @@ TclNamespaceEnsembleCmd(
Tcl_AppendStringsToObj(newCmd, "::", NULL);
}
Tcl_AppendObjToObj(newCmd, listv[0]);
- Tcl_ListObjReplace(NULL, newList, 0,1, 1,&newCmd);
+ Tcl_ListObjReplace(NULL, newList, 0, 1, 1,
+ &newCmd);
if (patchedDict == NULL) {
patchedDict = Tcl_DuplicateObj(objv[1]);
}
@@ -650,15 +650,13 @@ TclNamespaceEnsembleCmd(
Tcl_Command
TclCreateEnsembleInNs(
Tcl_Interp *interp,
-
- const char *name, /* Simple name of command to create (no */
- /* namespace components). */
- Tcl_Namespace /* Name of namespace to create the command in. */
- *nameNsPtr,
- Tcl_Namespace
- *ensembleNsPtr, /* Name of the namespace for the ensemble. */
- int flags
- )
+ const char *name, /* Simple name of command to create (no
+ * namespace components). */
+ Tcl_Namespace *nameNsPtr, /* Name of namespace to create the command
+ * in. */
+ Tcl_Namespace *ensembleNsPtr,
+ /* Name of the namespace for the ensemble. */
+ int flags)
{
Namespace *nsPtr = (Namespace *) ensembleNsPtr;
EnsembleConfig *ensemblePtr;
@@ -666,8 +664,8 @@ TclCreateEnsembleInNs(
ensemblePtr = ckalloc(sizeof(EnsembleConfig));
token = TclNRCreateCommandInNs(interp, name,
- (Tcl_Namespace *) nameNsPtr, NsEnsembleImplementationCmd,
- NsEnsembleImplementationCmdNR, ensemblePtr, DeleteEnsembleConfig);
+ (Tcl_Namespace *) nameNsPtr, NsEnsembleImplementationCmd,
+ NsEnsembleImplementationCmdNR, ensemblePtr, DeleteEnsembleConfig);
if (token == NULL) {
ckfree(ensemblePtr);
return NULL;
@@ -701,18 +699,15 @@ TclCreateEnsembleInNs(
}
return ensemblePtr->token;
-
}
-
-
+
/*
*----------------------------------------------------------------------
*
* Tcl_CreateEnsemble
*
- * Create a simple ensemble attached to the given namespace.
- *
- * Deprecated by TclCreateEnsembleInNs.
+ * Create a simple ensemble attached to the given namespace. Deprecated
+ * (internally) by TclCreateEnsembleInNs.
*
* Value
*
@@ -732,8 +727,8 @@ Tcl_CreateEnsemble(
Tcl_Namespace *namespacePtr,
int flags)
{
- Namespace *nsPtr = (Namespace *)namespacePtr, *foundNsPtr, *altNsPtr,
- *actualNsPtr;
+ Namespace *nsPtr = (Namespace *) namespacePtr, *foundNsPtr, *altNsPtr,
+ *actualNsPtr;
const char * simpleName;
if (nsPtr == NULL) {
@@ -741,11 +736,10 @@ Tcl_CreateEnsemble(
}
TclGetNamespaceForQualName(interp, name, nsPtr, TCL_CREATE_NS_IF_UNKNOWN,
- &foundNsPtr, &altNsPtr, &actualNsPtr, &simpleName);
+ &foundNsPtr, &altNsPtr, &actualNsPtr, &simpleName);
return TclCreateEnsembleInNs(interp, simpleName,
- (Tcl_Namespace *) foundNsPtr, (Tcl_Namespace *) nsPtr, flags);
+ (Tcl_Namespace *) foundNsPtr, (Tcl_Namespace *) nsPtr, flags);
}
-
/*
*----------------------------------------------------------------------
@@ -2117,22 +2111,27 @@ TclSpellFix(
iPtr->ensembleRewrite.numInsertedObjs = 0;
}
- /* Compute the valid length of the ensemble root */
+ /*
+ * Compute the valid length of the ensemble root.
+ */
size = iPtr->ensembleRewrite.numRemovedObjs + objc
- - iPtr->ensembleRewrite.numInsertedObjs;
+ - iPtr->ensembleRewrite.numInsertedObjs;
search = iPtr->ensembleRewrite.sourceObjs;
if (search[0] == NULL) {
- /* Awful casting abuse here */
+ /*
+ * Awful casting abuse here...
+ */
search = (Tcl_Obj *const *) search[1];
}
if (badIdx < iPtr->ensembleRewrite.numInsertedObjs) {
/*
- * Misspelled value was inserted. We cannot directly jump
- * to the bad value, but have to search.
+ * Misspelled value was inserted. We cannot directly jump to the bad
+ * value, but have to search.
*/
+
idx = 1;
while (idx < size) {
if (search[idx] == bad) {
@@ -2156,13 +2155,14 @@ TclSpellFix(
search = iPtr->ensembleRewrite.sourceObjs;
if (search[0] == NULL) {
- store = (Tcl_Obj **)search[2];
- } else {
+ store = (Tcl_Obj **) search[2];
+ } else {
Tcl_Obj **tmp = ckalloc(3 * sizeof(Tcl_Obj *));
+
tmp[0] = NULL;
- tmp[1] = (Tcl_Obj *)iPtr->ensembleRewrite.sourceObjs;
- tmp[2] = (Tcl_Obj *)ckalloc(size * sizeof(Tcl_Obj *));
- memcpy(tmp[2], tmp[1], size*sizeof(Tcl_Obj *));
+ tmp[1] = (Tcl_Obj *) iPtr->ensembleRewrite.sourceObjs;
+ tmp[2] = (Tcl_Obj *) ckalloc(size * sizeof(Tcl_Obj *));
+ memcpy(tmp[2], tmp[1], size * sizeof(Tcl_Obj *));
iPtr->ensembleRewrite.sourceObjs = (Tcl_Obj *const *) tmp;
TclNRAddCallback(interp, FreeER, tmp, NULL, NULL, NULL);
@@ -2589,7 +2589,9 @@ BuildEnsembleConfig(
}
}
} else {
- /* Usual case where we can freely act on the list and dict. */
+ /*
+ * Usual case where we can freely act on the list and dict.
+ */
for (i = 0; i < subc; i++) {
name = TclGetString(subv[i]);
@@ -2598,7 +2600,10 @@ BuildEnsembleConfig(
continue;
}
- /* Lookup target in the dictionary */
+ /*
+ * Lookup target in the dictionary.
+ */
+
if (mapDict) {
Tcl_DictObjGet(NULL, mapDict, subv[i], &target);
if (target) {
@@ -2610,10 +2615,11 @@ BuildEnsembleConfig(
/*
* target was not in the dictionary so map onto the namespace.
- * Note in this case that we do not guarantee that the
- * command is actually there; that is the programmer's
- * responsibility (or [::unknown] of course).
+ * Note in this case that we do not guarantee that the command
+ * is actually there; that is the programmer's responsibility
+ * (or [::unknown] of course).
*/
+
cmdObj = Tcl_NewStringObj(name, -1);
cmdPrefixObj = Tcl_NewListObj(1, &cmdObj);
Tcl_SetHashValue(hPtr, cmdPrefixObj);
diff --git a/generic/tclEvent.c b/generic/tclEvent.c
index 93cf983..913ff0f 100644
--- a/generic/tclEvent.c
+++ b/generic/tclEvent.c
@@ -100,7 +100,7 @@ typedef struct ThreadSpecificData {
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;
-#ifdef TCL_THREADS
+#if TCL_THREADS
typedef struct {
Tcl_ThreadCreateProc *proc; /* Main() function of the thread */
ClientData clientData; /* The one argument to Main() */
@@ -1043,7 +1043,7 @@ TclInitSubsystems(void)
#if USE_TCLALLOC
TclInitAlloc(); /* Process wide mutex init */
#endif
-#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
+#if TCL_THREADS && defined(USE_THREAD_ALLOC)
TclInitThreadAlloc(); /* Setup thread allocator caches */
#endif
#ifdef TCL_MEM_DEBUG
@@ -1220,7 +1220,7 @@ Tcl_Finalize(void)
* Close down the thread-specific object allocator.
*/
-#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
+#if TCL_THREADS && defined(USE_THREAD_ALLOC)
TclFinalizeThreadAlloc();
#endif
@@ -1538,7 +1538,7 @@ Tcl_UpdateObjCmd(
return TCL_OK;
}
-#ifdef TCL_THREADS
+#if TCL_THREADS
/*
*----------------------------------------------------------------------
*
@@ -1601,7 +1601,7 @@ Tcl_CreateThread(
int flags) /* Flags controlling behaviour of the new
* thread. */
{
-#ifdef TCL_THREADS
+#if TCL_THREADS
ThreadClientData *cdPtr = ckalloc(sizeof(ThreadClientData));
int result;
diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index 8e1496d..354f1fb 100644
--- a/generic/tclIORChan.c
+++ b/generic/tclIORChan.c
@@ -39,7 +39,7 @@ static int ReflectOutput(ClientData clientData, const char *buf,
int toWrite, int *errorCodePtr);
static void ReflectWatch(ClientData clientData, int mask);
static int ReflectBlock(ClientData clientData, int mode);
-#ifdef TCL_THREADS
+#if TCL_THREADS
static void ReflectThread(ClientData clientData, int action);
static int ReflectEventRun(Tcl_Event *ev, int flags);
static int ReflectEventDelete(Tcl_Event *ev, ClientData cd);
@@ -76,7 +76,7 @@ static const Tcl_ChannelType tclRChannelType = {
NULL, /* Flush channel. Not used by core. NULL'able */
NULL, /* Handle events. NULL'able */
ReflectSeekWide, /* Move access point (64 bit). NULL'able */
-#ifdef TCL_THREADS
+#if TCL_THREADS
ReflectThread, /* thread action, tracking owner */
#else
NULL, /* thread action */
@@ -97,7 +97,7 @@ typedef struct {
* interpreter/thread containing its Tcl
* command is gone.
*/
-#ifdef TCL_THREADS
+#if TCL_THREADS
Tcl_ThreadId thread; /* Thread the 'interp' belongs to. == Handler thread */
Tcl_ThreadId owner; /* Thread owning the structure. == Channel thread */
#endif
@@ -201,7 +201,7 @@ typedef enum {
#define NEGIMPL(a,b)
#define HAS(x,f) (x & FLAG(f))
-#ifdef TCL_THREADS
+#if TCL_THREADS
/*
* Thread specific types and structures.
*
@@ -451,7 +451,7 @@ static const char *msg_read_toomuch = "{read delivered more than requested}";
static const char *msg_write_toomuch = "{write wrote more than requested}";
static const char *msg_write_nothing = "{write wrote nothing}";
static const char *msg_seek_beforestart = "{Tried to seek before origin}";
-#ifdef TCL_THREADS
+#if TCL_THREADS
static const char *msg_send_originlost = "{Channel thread lost}";
#endif /* TCL_THREADS */
static const char *msg_send_dstlost = "{Owner lost}";
@@ -706,7 +706,7 @@ TclChanCreateObjCmd(
Tcl_Panic("TclChanCreateObjCmd: duplicate channel names");
}
Tcl_SetHashValue(hPtr, chan);
-#ifdef TCL_THREADS
+#if TCL_THREADS
rcmPtr = GetThreadReflectedChannelMap();
hPtr = Tcl_CreateHashEntry(&rcmPtr->map, chanPtr->state->channelName,
&isNew);
@@ -750,7 +750,7 @@ TclChanCreateObjCmd(
*----------------------------------------------------------------------
*/
-#ifdef TCL_THREADS
+#if TCL_THREADS
typedef struct {
Tcl_Event header;
ReflectedChannel *rcPtr;
@@ -917,11 +917,11 @@ TclChanPostEventObjCmd(
* We have the channel and the events to post.
*/
-#ifdef TCL_THREADS
+#if TCL_THREADS
if (rcPtr->owner == rcPtr->thread) {
#endif
Tcl_NotifyChannel(chan, events);
-#ifdef TCL_THREADS
+#if TCL_THREADS
} else {
ReflectEvent *ev = ckalloc(sizeof(ReflectEvent));
@@ -1137,7 +1137,7 @@ ReflectClose(
* if lost?
*/
-#ifdef TCL_THREADS
+#if TCL_THREADS
if (rcPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
@@ -1169,7 +1169,7 @@ ReflectClose(
* Are we in the correct thread?
*/
-#ifdef TCL_THREADS
+#if TCL_THREADS
if (rcPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
@@ -1216,7 +1216,7 @@ ReflectClose(
Tcl_DeleteHashEntry(hPtr);
}
}
-#ifdef TCL_THREADS
+#if TCL_THREADS
rcmPtr = GetThreadReflectedChannelMap();
hPtr = Tcl_FindHashEntry(&rcmPtr->map,
Tcl_GetChannelName(rcPtr->chan));
@@ -1267,7 +1267,7 @@ ReflectInput(
* Are we in the correct thread?
*/
-#ifdef TCL_THREADS
+#if TCL_THREADS
if (rcPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
@@ -1373,7 +1373,7 @@ ReflectOutput(
* Are we in the correct thread?
*/
-#ifdef TCL_THREADS
+#if TCL_THREADS
if (rcPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
@@ -1502,7 +1502,7 @@ ReflectSeekWide(
* Are we in the correct thread?
*/
-#ifdef TCL_THREADS
+#if TCL_THREADS
if (rcPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
@@ -1625,7 +1625,7 @@ ReflectWatch(
* Are we in the correct thread?
*/
-#ifdef TCL_THREADS
+#if TCL_THREADS
if (rcPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
@@ -1683,7 +1683,7 @@ ReflectBlock(
* Are we in the correct thread?
*/
-#ifdef TCL_THREADS
+#if TCL_THREADS
if (rcPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
@@ -1719,7 +1719,7 @@ ReflectBlock(
return errorNum;
}
-#ifdef TCL_THREADS
+#if TCL_THREADS
/*
*----------------------------------------------------------------------
*
@@ -1789,7 +1789,7 @@ ReflectSetOption(
* Are we in the correct thread?
*/
-#ifdef TCL_THREADS
+#if TCL_THREADS
if (rcPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
@@ -1868,7 +1868,7 @@ ReflectGetOption(
* Are we in the correct thread?
*/
-#ifdef TCL_THREADS
+#if TCL_THREADS
if (rcPtr->thread != Tcl_GetCurrentThread()) {
int opcode;
ForwardParam p;
@@ -2131,7 +2131,7 @@ NewReflectedChannel(
rcPtr->chan = NULL;
rcPtr->interp = interp;
rcPtr->dead = 0;
-#ifdef TCL_THREADS
+#if TCL_THREADS
rcPtr->thread = Tcl_GetCurrentThread();
#endif
rcPtr->mode = mode;
@@ -2506,7 +2506,7 @@ DeleteReflectedChannelMap(
Tcl_HashEntry *hPtr; /* Search variable. */
ReflectedChannel *rcPtr;
Tcl_Channel chan;
-#ifdef TCL_THREADS
+#if TCL_THREADS
ForwardingResult *resultPtr;
ForwardingEvent *evPtr;
ForwardParam *paramPtr;
@@ -2536,7 +2536,7 @@ DeleteReflectedChannelMap(
Tcl_DeleteHashTable(&rcmPtr->map);
ckfree(&rcmPtr->map);
-#ifdef TCL_THREADS
+#if TCL_THREADS
/*
* The origin interpreter for one or more reflected channels is gone.
*/
@@ -2622,7 +2622,7 @@ DeleteReflectedChannelMap(
#endif
}
-#ifdef TCL_THREADS
+#if TCL_THREADS
/*
*----------------------------------------------------------------------
*
diff --git a/generic/tclIORTrans.c b/generic/tclIORTrans.c
index fe2e458..1a7b940 100644
--- a/generic/tclIORTrans.c
+++ b/generic/tclIORTrans.c
@@ -127,7 +127,7 @@ typedef struct {
* in the argv, see below. The separate field
* gives us direct access, needed when working
* with the reflection maps. */
-#ifdef TCL_THREADS
+#if TCL_THREADS
Tcl_ThreadId thread; /* Thread the 'interp' belongs to. */
#endif
@@ -220,7 +220,7 @@ typedef enum {
#define NEGIMPL(a,b)
#define HAS(x,f) (x & FLAG(f))
-#ifdef TCL_THREADS
+#if TCL_THREADS
/*
* Thread specific types and structures.
*
@@ -438,7 +438,7 @@ static void DeleteReflectedTransformMap(ClientData clientData,
static const char *msg_read_unsup = "{read not supported by Tcl driver}";
static const char *msg_write_unsup = "{write not supported by Tcl driver}";
-#ifdef TCL_THREADS
+#if TCL_THREADS
static const char *msg_send_originlost = "{Channel thread lost}";
static const char *msg_send_dstlost = "{Owner lost}";
#endif /* TCL_THREADS */
@@ -699,7 +699,7 @@ TclChanPushObjCmd(
Tcl_Panic("TclChanPushObjCmd: duplicate transformation handle");
}
Tcl_SetHashValue(hPtr, rtPtr);
-#ifdef TCL_THREADS
+#if TCL_THREADS
rtmPtr = GetThreadReflectedTransformMap();
hPtr = Tcl_CreateHashEntry(&rtmPtr->map, TclGetString(rtId), &isNew);
Tcl_SetHashValue(hPtr, rtPtr);
@@ -911,7 +911,7 @@ ReflectClose(
* if lost?
*/
-#ifdef TCL_THREADS
+#if TCL_THREADS
if (rtPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
@@ -938,7 +938,7 @@ ReflectClose(
if (HAS(rtPtr->methods, METH_DRAIN) && !rtPtr->readIsDrained) {
if (!TransformDrain(rtPtr, &errorCode)) {
-#ifdef TCL_THREADS
+#if TCL_THREADS
if (rtPtr->thread != Tcl_GetCurrentThread()) {
Tcl_EventuallyFree(rtPtr,
(Tcl_FreeProc *) FreeReflectedTransform);
@@ -952,7 +952,7 @@ ReflectClose(
if (HAS(rtPtr->methods, METH_FLUSH)) {
if (!TransformFlush(rtPtr, &errorCode, FLUSH_WRITE)) {
-#ifdef TCL_THREADS
+#if TCL_THREADS
if (rtPtr->thread != Tcl_GetCurrentThread()) {
Tcl_EventuallyFree(rtPtr,
(Tcl_FreeProc *) FreeReflectedTransform);
@@ -968,7 +968,7 @@ ReflectClose(
* Are we in the correct thread?
*/
-#ifdef TCL_THREADS
+#if TCL_THREADS
if (rtPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
@@ -1025,7 +1025,7 @@ ReflectClose(
* under a channel by deleting the owning thread.
*/
-#ifdef TCL_THREADS
+#if TCL_THREADS
rtmPtr = GetThreadReflectedTransformMap();
hPtr = Tcl_FindHashEntry(&rtmPtr->map, TclGetString(rtPtr->handle));
if (hPtr) {
@@ -1767,7 +1767,7 @@ NewReflectedTransform(
rtPtr->chan = NULL;
rtPtr->methods = 0;
-#ifdef TCL_THREADS
+#if TCL_THREADS
rtPtr->thread = Tcl_GetCurrentThread();
#endif
rtPtr->parent = parentChan;
@@ -2152,7 +2152,7 @@ DeleteReflectedTransformMap(
Tcl_HashSearch hSearch; /* Search variable. */
Tcl_HashEntry *hPtr; /* Search variable. */
ReflectedTransform *rtPtr;
-#ifdef TCL_THREADS
+#if TCL_THREADS
ForwardingResult *resultPtr;
ForwardingEvent *evPtr;
ForwardParam *paramPtr;
@@ -2182,7 +2182,7 @@ DeleteReflectedTransformMap(
Tcl_DeleteHashTable(&rtmPtr->map);
ckfree(&rtmPtr->map);
-#ifdef TCL_THREADS
+#if TCL_THREADS
/*
* The origin interpreter for one or more reflected channels is gone.
*/
@@ -2254,7 +2254,7 @@ DeleteReflectedTransformMap(
#endif /* TCL_THREADS */
}
-#ifdef TCL_THREADS
+#if TCL_THREADS
/*
*----------------------------------------------------------------------
*
@@ -3088,7 +3088,7 @@ TransformRead(
* Are we in the correct thread?
*/
-#ifdef TCL_THREADS
+#if TCL_THREADS
if (rtPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
@@ -3144,7 +3144,7 @@ TransformWrite(
* Are we in the correct thread?
*/
-#ifdef TCL_THREADS
+#if TCL_THREADS
if (rtPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
@@ -3210,7 +3210,7 @@ TransformDrain(
* Are we in the correct thread?
*/
-#ifdef TCL_THREADS
+#if TCL_THREADS
if (rtPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
@@ -3260,7 +3260,7 @@ TransformFlush(
* Are we in the correct thread?
*/
-#ifdef TCL_THREADS
+#if TCL_THREADS
if (rtPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
@@ -3315,7 +3315,7 @@ TransformClear(
* Are we in the correct thread?
*/
-#ifdef TCL_THREADS
+#if TCL_THREADS
if (rtPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
@@ -3347,7 +3347,7 @@ TransformLimit(
* Are we in the correct thread?
*/
-#ifdef TCL_THREADS
+#if TCL_THREADS
if (rtPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index 144bab0..3382825 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -3197,8 +3197,8 @@ TclSkipUnlink(
#ifndef AUFS_SUPER_MAGIC
#define AUFS_SUPER_MAGIC ('a' << 24 | 'u' << 16 | 'f' << 8 | 's')
#endif /* AUFS_SUPER_MAGIC */
- if ((statfs(Tcl_GetString (shlibFile), &fs) == 0) &&
- (fs.f_type == AUFS_SUPER_MAGIC)) {
+ if ((statfs(Tcl_GetString(shlibFile), &fs) == 0)
+ && (fs.f_type == AUFS_SUPER_MAGIC)) {
return 1;
}
}
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 847b0f5..6d7fccc 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -136,6 +136,26 @@ typedef int ptrdiff_t;
# define vsnprintf _vsnprintf
#endif
+#if !defined(TCL_THREADS)
+# define TCL_THREADS 1
+#endif
+#if !TCL_THREADS
+# undef TCL_DECLARE_MUTEX
+# define TCL_DECLARE_MUTEX(name)
+# undef Tcl_MutexLock
+# define Tcl_MutexLock(mutexPtr)
+# undef Tcl_MutexUnlock
+# define Tcl_MutexUnlock(mutexPtr)
+# undef Tcl_MutexFinalize
+# define Tcl_MutexFinalize(mutexPtr)
+# undef Tcl_ConditionNotify
+# define Tcl_ConditionNotify(condPtr)
+# undef Tcl_ConditionWait
+# define Tcl_ConditionWait(condPtr, mutexPtr, timePtr)
+# undef Tcl_ConditionFinalize
+# define Tcl_ConditionFinalize(condPtr)
+#endif
+
/*
* The following procedures allow namespaces to be customized to support
* special name resolution rules for commands/variables.
@@ -2920,19 +2940,13 @@ MODULE_SCOPE void TclContinuationsCopy(Tcl_Obj *objPtr,
Tcl_Obj *originObjPtr);
MODULE_SCOPE int TclConvertElement(const char *src, int length,
char *dst, int flags);
-MODULE_SCOPE Tcl_Command TclCreateObjCommandInNs (
- Tcl_Interp *interp,
- const char *cmdName,
- Tcl_Namespace *nsPtr,
- Tcl_ObjCmdProc *proc,
- ClientData clientData,
+MODULE_SCOPE Tcl_Command TclCreateObjCommandInNs(Tcl_Interp *interp,
+ const char *cmdName, Tcl_Namespace *nsPtr,
+ Tcl_ObjCmdProc *proc, ClientData clientData,
Tcl_CmdDeleteProc *deleteProc);
-MODULE_SCOPE Tcl_Command TclCreateEnsembleInNs(
- Tcl_Interp *interp,
- const char *name,
- Tcl_Namespace *nameNamespacePtr,
- Tcl_Namespace *ensembleNamespacePtr,
- int flags);
+MODULE_SCOPE Tcl_Command TclCreateEnsembleInNs(Tcl_Interp *interp,
+ const char *name, Tcl_Namespace *nameNamespacePtr,
+ Tcl_Namespace *ensembleNamespacePtr, int flags);
MODULE_SCOPE void TclDeleteNamespaceVars(Namespace *nsPtr);
MODULE_SCOPE int TclFindDictElement(Tcl_Interp *interp,
const char *dict, int dictLength,
@@ -2959,9 +2973,9 @@ MODULE_SCOPE char * TclDStringAppendObj(Tcl_DString *dsPtr,
MODULE_SCOPE char * TclDStringAppendDString(Tcl_DString *dsPtr,
Tcl_DString *toAppendPtr);
MODULE_SCOPE Tcl_Obj * TclDStringToObj(Tcl_DString *dsPtr);
-MODULE_SCOPE Tcl_Obj *const * TclFetchEnsembleRoot(Tcl_Interp *interp,
+MODULE_SCOPE Tcl_Obj *const *TclFetchEnsembleRoot(Tcl_Interp *interp,
Tcl_Obj *const *objv, int objc, int *objcPtr);
-MODULE_SCOPE Tcl_Namespace * TclEnsureNamespace(Tcl_Interp *interp,
+MODULE_SCOPE Tcl_Namespace *TclEnsureNamespace(Tcl_Interp *interp,
Tcl_Namespace *namespacePtr);
MODULE_SCOPE void TclFinalizeAllocSubsystem(void);
MODULE_SCOPE void TclFinalizeAsync(void);
@@ -2989,15 +3003,11 @@ MODULE_SCOPE double TclFloor(const mp_int *a);
MODULE_SCOPE void TclFormatNaN(double value, char *buffer);
MODULE_SCOPE int TclFSFileAttrIndex(Tcl_Obj *pathPtr,
const char *attributeName, int *indexPtr);
-MODULE_SCOPE Tcl_Command TclNRCreateCommandInNs (
- Tcl_Interp *interp,
- const char *cmdName,
- Tcl_Namespace *nsPtr,
- Tcl_ObjCmdProc *proc,
- Tcl_ObjCmdProc *nreProc,
+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);
-
MODULE_SCOPE int TclNREvalFile(Tcl_Interp *interp, Tcl_Obj *pathPtr,
const char *encodingName);
MODULE_SCOPE void TclFSUnloadTempFile(Tcl_LoadHandle loadHandle);
@@ -3178,7 +3188,8 @@ MODULE_SCOPE void TclSetBgErrorHandler(Tcl_Interp *interp,
Tcl_Obj *cmdPrefix);
MODULE_SCOPE void TclSetBignumIntRep(Tcl_Obj *objPtr,
mp_int *bignumValue);
-MODULE_SCOPE int TclSetBooleanFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
+MODULE_SCOPE int TclSetBooleanFromAny(Tcl_Interp *interp,
+ Tcl_Obj *objPtr);
MODULE_SCOPE void TclSetCmdNameObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
Command *cmdPtr);
MODULE_SCOPE void TclSetDuplicateObj(Tcl_Obj *dupPtr, Tcl_Obj *objPtr);
@@ -3190,12 +3201,12 @@ MODULE_SCOPE void TclSpellFix(Tcl_Interp *interp,
Tcl_Obj *bad, Tcl_Obj *fix);
MODULE_SCOPE void * TclStackRealloc(Tcl_Interp *interp, void *ptr,
int numBytes);
-
typedef int (*memCmpFn_t)(const void*, const void*, size_t);
-MODULE_SCOPE int TclStringCmp (Tcl_Obj *value1Ptr, Tcl_Obj *value2Ptr,
+MODULE_SCOPE int TclStringCmp(Tcl_Obj *value1Ptr, Tcl_Obj *value2Ptr,
int checkEq, int nocase, int reqlength);
-MODULE_SCOPE int TclStringCmpOpts (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[],
- int *nocase, int *reqlength);
+MODULE_SCOPE int TclStringCmpOpts(Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[], int *nocase,
+ int *reqlength);
MODULE_SCOPE int TclStringMatch(const char *str, int strLen,
const char *pattern, int ptnLen, int flags);
MODULE_SCOPE int TclStringMatchObj(Tcl_Obj *stringObj,
@@ -3244,8 +3255,8 @@ MODULE_SCOPE void * TclpThreadCreateKey(void);
MODULE_SCOPE void TclpThreadDeleteKey(void *keyPtr);
MODULE_SCOPE void TclpThreadSetMasterTSD(void *tsdKeyPtr, void *ptr);
MODULE_SCOPE void * TclpThreadGetMasterTSD(void *tsdKeyPtr);
-
-MODULE_SCOPE void TclErrorStackResetIf(Tcl_Interp *interp, const char *msg, int length);
+MODULE_SCOPE void TclErrorStackResetIf(Tcl_Interp *interp,
+ const char *msg, int length);
/*
*----------------------------------------------------------------
@@ -4101,7 +4112,7 @@ typedef enum TclProcessWaitStatus {
TCL_PROCESS_EXITED = 1, /* Process has exited. */
TCL_PROCESS_SIGNALED = 2, /* Child killed because of a signal. */
TCL_PROCESS_STOPPED = 3, /* Child suspended because of a signal. */
- TCL_PROCESS_UNKNOWN_STATUS = 4
+ TCL_PROCESS_UNKNOWN_STATUS = 4
/* Child wait status didn't make sense. */
} TclProcessWaitStatus;
@@ -4212,6 +4223,10 @@ typedef const char *TclDTraceStr;
} \
}
+#if TCL_THREADS && !defined(USE_THREAD_ALLOC)
+# define USE_THREAD_ALLOC 1
+#endif
+
#if defined(PURIFY)
/*
@@ -4229,7 +4244,7 @@ typedef const char *TclDTraceStr;
#undef USE_THREAD_ALLOC
#undef USE_TCLALLOC
-#elif defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
+#elif TCL_THREADS && defined(USE_THREAD_ALLOC)
/*
* The TCL_THREADS mode is like the regular mode but allocates Tcl_Obj's from
@@ -4294,7 +4309,7 @@ MODULE_SCOPE void TclpFreeAllocCache(void *);
# define USE_TCLALLOC 0
#endif
-#ifdef TCL_THREADS
+#if TCL_THREADS
/* declared in tclObj.c */
MODULE_SCOPE Tcl_Mutex tclObjMutex;
#endif
diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h
index e1fb263..51d2f65 100644
--- a/generic/tclIntPlatDecls.h
+++ b/generic/tclIntPlatDecls.h
@@ -13,11 +13,6 @@
#ifndef _TCLINTPLATDECLS
#define _TCLINTPLATDECLS
-#ifdef _WIN32
-# define Tcl_DirEntry void
-# define TclDIR void
-#endif
-
#undef TCL_STORAGE_CLASS
#ifdef BUILD_tcl
# define TCL_STORAGE_CLASS DLLEXPORT
diff --git a/generic/tclObj.c b/generic/tclObj.c
index 7b9488e..f93f583 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -37,7 +37,7 @@ Tcl_Obj *tclFreeObjList = NULL;
* TclNewObj macro, however, so must be visible.
*/
-#ifdef TCL_THREADS
+#if TCL_THREADS
MODULE_SCOPE Tcl_Mutex tclObjMutex;
Tcl_Mutex tclObjMutex;
#endif
@@ -50,7 +50,7 @@ Tcl_Mutex tclObjMutex;
char tclEmptyString = '\0';
-#if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS)
+#if TCL_THREADS && defined(TCL_MEM_DEBUG)
/*
* Structure for tracking the source file and line number where a given
* Tcl_Obj was allocated. We also track the pointer to the Tcl_Obj itself,
@@ -87,7 +87,7 @@ typedef struct {
* tclCompile.h for the definition of this
* structure, and for references to all
* related places in the core. */
-#if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS)
+#if TCL_THREADS && defined(TCL_MEM_DEBUG)
Tcl_HashTable *objThreadMap;/* Thread local table that is used to check
* that a Tcl_Obj was not allocated by some
* other thread. */
@@ -156,7 +156,7 @@ typedef struct PendingObjData {
/*
* Macro to set up the local reference to the deletion context.
*/
-#ifndef TCL_THREADS
+#if !TCL_THREADS
static PendingObjData pendingObjData;
#define ObjInitDeletionContext(contextPtr) \
PendingObjData *const contextPtr = &pendingObjData
@@ -452,7 +452,7 @@ TclInitObjSubsystem(void)
void
TclFinalizeThreadObjects(void)
{
-#if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS)
+#if TCL_THREADS && defined(TCL_MEM_DEBUG)
Tcl_HashEntry *hPtr;
Tcl_HashSearch hSearch;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -1009,7 +1009,7 @@ void
TclDbDumpActiveObjects(
FILE *outFile)
{
-#if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS)
+#if TCL_THREADS && defined(TCL_MEM_DEBUG)
Tcl_HashSearch hSearch;
Tcl_HashEntry *hPtr;
Tcl_HashTable *tablePtr;
@@ -1069,7 +1069,7 @@ TclDbInitNewObj(
objPtr->length = 0;
objPtr->typePtr = NULL;
-#ifdef TCL_THREADS
+#if TCL_THREADS
/*
* Add entry to a thread local map used to check if a Tcl_Obj was
* allocated by the currently executing thread.
@@ -1305,7 +1305,7 @@ TclFreeObj(
ObjInitDeletionContext(context);
-# ifdef TCL_THREADS
+#if TCL_THREADS
/*
* Check to make sure that the Tcl_Obj was allocated by the current
* thread. Don't do this check when shutting down since thread local
@@ -3598,7 +3598,7 @@ Tcl_DbIncrRefCount(
Tcl_Panic("incrementing refCount of previously disposed object");
}
-# ifdef TCL_THREADS
+#if TCL_THREADS
/*
* Check to make sure that the Tcl_Obj was allocated by the current
* thread. Don't do this check when shutting down since thread local
@@ -3661,7 +3661,7 @@ Tcl_DbDecrRefCount(
Tcl_Panic("decrementing refCount of previously disposed object");
}
-# ifdef TCL_THREADS
+#if TCL_THREADS
/*
* Check to make sure that the Tcl_Obj was allocated by the current
* thread. Don't do this check when shutting down since thread local
@@ -3726,7 +3726,7 @@ Tcl_DbIsShared(
Tcl_Panic("checking whether previously disposed object is shared");
}
-# ifdef TCL_THREADS
+#if TCL_THREADS
/*
* Check to make sure that the Tcl_Obj was allocated by the current
* thread. Don't do this check when shutting down since thread local
diff --git a/generic/tclPkgConfig.c b/generic/tclPkgConfig.c
index 466d535..9e194c8 100644
--- a/generic/tclPkgConfig.c
+++ b/generic/tclPkgConfig.c
@@ -40,7 +40,7 @@
* configuration information.
*/
-#ifdef TCL_THREADS
+#if TCL_THREADS
# define CFG_THREADED "1"
#else
# define CFG_THREADED "0"
diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c
index 0434919..a46b29a 100644
--- a/generic/tclStrToD.c
+++ b/generic/tclStrToD.c
@@ -4543,7 +4543,7 @@ Tcl_InitBignumFromDouble(
return TCL_ERROR;
}
- fract = frexp(d,&expt);
+ fract = frexp(d, &expt);
if (expt <= 0) {
mp_init(b);
mp_zero(b);
@@ -4883,7 +4883,7 @@ Pow10TimesFrExp(
* Multiply by 10**exponent.
*/
- retval = frexp(retval * pow10vals[exponent&0xf], &j);
+ retval = frexp(retval * pow10vals[exponent & 0xf], &j);
expt += j;
for (i=4; i<9; ++i) {
if (exponent & (1<<i)) {
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index 42c4514..f9ac8d7 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -436,7 +436,6 @@ Tcl_GetCharLength(
return length;
}
-
/*
* OK, need to work with the object as a string.
*/
@@ -455,8 +454,6 @@ Tcl_GetCharLength(
}
return numChars;
}
-
-
/*
*----------------------------------------------------------------------
@@ -475,9 +472,9 @@ Tcl_GetCharLength(
*----------------------------------------------------------------------
*/
int
-TclCheckEmptyString (
- Tcl_Obj *objPtr
-) {
+TclCheckEmptyString(
+ Tcl_Obj *objPtr)
+{
int length = -1;
if (objPtr->bytes == &tclEmptyString) {
@@ -570,20 +567,22 @@ Tcl_GetUniChar(
if (index >= stringPtr->numChars) {
return -1;
}
- ch = stringPtr->unicode[index];
+ ch = stringPtr->unicode[index];
#if TCL_UTF_MAX <= 4
- /* See: bug [11ae2be95dac9417] */
- if ((ch&0xF800) == 0xD800) {
- if (ch&0x400) {
- if ((index > 0) && ((stringPtr->unicode[index-1]&0xFC00) == 0xD800)) {
- ch = -1; /* low surrogate preceded by high surrogate */
- }
- } else if ((++index < stringPtr->numChars)
- && ((stringPtr->unicode[index]&0xFC00) == 0xDC00)) {
- /* high surrogate followed by low surrogate */
- ch = (((ch & 0x3FF) << 10) | (stringPtr->unicode[index] & 0x3FF)) + 0x10000;
+ /* See: bug [11ae2be95dac9417] */
+ if ((ch & 0xF800) == 0xD800) {
+ if (ch & 0x400) {
+ if ((index > 0)
+ && ((stringPtr->unicode[index-1] & 0xFC00) == 0xD800)) {
+ ch = -1; /* low surrogate preceded by high surrogate */
}
+ } else if ((++index < stringPtr->numChars)
+ && ((stringPtr->unicode[index] & 0xFC00) == 0xDC00)) {
+ /* high surrogate followed by low surrogate */
+ ch = (((ch & 0x3FF) << 10) |
+ (stringPtr->unicode[index] & 0x3FF)) + 0x10000;
}
+ }
#endif
return ch;
}
@@ -689,7 +688,8 @@ Tcl_GetRange(
if (first < 0) {
first = 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 substring operation.
@@ -697,13 +697,14 @@ Tcl_GetRange(
if (TclIsPureByteArray(objPtr)) {
unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &length);
+
if (last >= length) {
last = length - 1;
}
if (last < first) {
return Tcl_NewObj();
}
- return Tcl_NewByteArrayObj(bytes+first, last-first+1);
+ return Tcl_NewByteArrayObj(bytes + first, last - first + 1);
}
/*
@@ -742,24 +743,25 @@ Tcl_GetRange(
FillUnicodeRep(objPtr);
stringPtr = GET_STRING(objPtr);
}
- if (last > stringPtr->numChars) {
- last = stringPtr->numChars;
- }
- if (last < first) {
- return Tcl_NewObj();
- }
+ if (last > stringPtr->numChars) {
+ last = stringPtr->numChars;
+ }
+ if (last < first) {
+ return Tcl_NewObj();
+ }
#if TCL_UTF_MAX <= 4
- /* See: bug [11ae2be95dac9417] */
- if ((first>0) && ((stringPtr->unicode[first]&0xFC00) == 0xDC00)
- && ((stringPtr->unicode[first-1]&0xFC00) == 0xD800)) {
- ++first;
- }
- if ((last+1<stringPtr->numChars) && ((stringPtr->unicode[last+1]&0xFC00) == 0xDC00)
- && ((stringPtr->unicode[last]&0xFC00) == 0xD800)) {
- ++last;
- }
+ /* See: bug [11ae2be95dac9417] */
+ if ((first > 0) && ((stringPtr->unicode[first] & 0xFC00) == 0xDC00)
+ && ((stringPtr->unicode[first-1] & 0xFC00) == 0xD800)) {
+ ++first;
+ }
+ if ((last + 1 < stringPtr->numChars)
+ && ((stringPtr->unicode[last+1] & 0xFC00) == 0xDC00)
+ && ((stringPtr->unicode[last] & 0xFC00) == 0xD800)) {
+ ++last;
+ }
#endif
- return Tcl_NewUnicodeObj(stringPtr->unicode + first, last-first+1);
+ return Tcl_NewUnicodeObj(stringPtr->unicode + first, last - first + 1);
}
/*
@@ -1317,45 +1319,51 @@ Tcl_AppendObjToObj(
/*
* Handle append of one bytearray object to another as a special case.
* Note that we only do this when the objects are pure so that the
- * bytearray faithfully represent the true value; Otherwise
- * appending the byte arrays together could lose information;
+ * bytearray faithfully represent the true value; Otherwise appending the
+ * byte arrays together could lose information;
*/
if ((TclIsPureByteArray(objPtr) || objPtr->bytes == &tclEmptyString)
&& TclIsPureByteArray(appendObjPtr)) {
-
/*
* You might expect the code here to be
*
* bytes = Tcl_GetByteArrayFromObj(appendObjPtr, &length);
* TclAppendBytesToByteArray(objPtr, bytes, length);
*
- * and essentially all of the time that would be fine. However,
- * it would run into trouble in the case where objPtr and
- * appendObjPtr point to the same thing. That may never be a
- * good idea. It seems to violate Copy On Write, and we don't
- * have any tests for the situation, since making any Tcl commands
- * that call Tcl_AppendObjToObj() do that appears impossible
- * (They honor Copy On Write!). For the sake of extensions that
- * go off into that realm, though, here's a more complex approach
- * that can handle all the cases.
+ * and essentially all of the time that would be fine. However, it
+ * would run into trouble in the case where objPtr and appendObjPtr
+ * point to the same thing. That may never be a good idea. It seems to
+ * violate Copy On Write, and we don't have any tests for the
+ * situation, since making any Tcl commands that call
+ * Tcl_AppendObjToObj() do that appears impossible (They honor Copy On
+ * Write!). For the sake of extensions that go off into that realm,
+ * though, here's a more complex approach that can handle all the
+ * cases.
+ *
+ * First, get the lengths.
*/
- /* Get lengths */
int lengthSrc;
(void) Tcl_GetByteArrayFromObj(objPtr, &length);
(void) Tcl_GetByteArrayFromObj(appendObjPtr, &lengthSrc);
- /* Grow buffer enough for the append */
+ /*
+ * Grow buffer enough for the append.
+ */
+
TclAppendBytesToByteArray(objPtr, NULL, lengthSrc);
- /* Reset objPtr back to the original value */
+ /*
+ * Reset objPtr back to the original value.
+ */
+
Tcl_SetByteArrayLength(objPtr, length);
/*
- * Now do the append knowing that buffer growth cannot cause
- * any trouble.
+ * Now do the append knowing that buffer growth cannot cause any
+ * trouble.
*/
TclAppendBytesToByteArray(objPtr,
@@ -1403,6 +1411,7 @@ Tcl_AppendObjToObj(
numChars = stringPtr->numChars;
if ((numChars >= 0) && (appendObjPtr->typePtr == &tclStringType)) {
String *appendStringPtr = GET_STRING(appendObjPtr);
+
appendNumChars = appendStringPtr->numChars;
}
@@ -1988,7 +1997,8 @@ Tcl_AppendFormatToObj(
format += step;
step = TclUtfToUniChar(format, &ch);
}
- } else if ((ch == 't') || (ch == 'z') || (ch == 'q') || (ch == 'j') || (ch == 'L')) {
+ } else if ((ch == 't') || (ch == 'z') || (ch == 'q') || (ch == 'j')
+ || (ch == 'L')) {
format += step;
step = TclUtfToUniChar(format, &ch);
useBig = 1;
@@ -2513,7 +2523,7 @@ Tcl_AppendFormatToObj(
/*
*---------------------------------------------------------------------------
*
- * Tcl_Format--
+ * Tcl_Format --
*
* Results:
* A refcount zero Tcl_Obj.
@@ -2904,7 +2914,10 @@ TclStringRepeat(
Tcl_GetByteArrayFromObj(objResultPtr, NULL),
(count - done) * length);
} else if (unichar) {
- /* Efficiently produce a pure Tcl_UniChar array result */
+ /*
+ * Efficiently produce a pure Tcl_UniChar array result.
+ */
+
if (!inPlace || Tcl_IsShared(objPtr)) {
objResultPtr = Tcl_NewUnicodeObj(Tcl_GetUnicode(objPtr), length);
} else {
@@ -2930,7 +2943,10 @@ TclStringRepeat(
Tcl_AppendUnicodeToObj(objResultPtr, Tcl_GetUnicode(objResultPtr),
(count - done) * length);
} else {
- /* Efficiently concatenate string reps */
+ /*
+ * Efficiently concatenate string reps.
+ */
+
if (!inPlace || Tcl_IsShared(objPtr)) {
objResultPtr = Tcl_NewStringObj(Tcl_GetString(objPtr), length);
} else {
@@ -3014,9 +3030,10 @@ TclStringCat(
/* Value has a string rep. */
if (objPtr->length) {
/*
- * Non-empty string rep. Not a pure bytearray, so we
- * won't create a pure bytearray
+ * Non-empty string rep. Not a pure bytearray, so we won't
+ * create a pure bytearray.
*/
+
binary = 0;
if ((objPtr->typePtr) && (objPtr->typePtr != &tclStringType)) {
/* Prevent shimmer of non-string types. */
@@ -3037,8 +3054,12 @@ TclStringCat(
} while (--oc && (binary || allowUniChar));
if (binary) {
- /* Result will be pure byte array. Pre-size it */
- ov = objv; oc = objc;
+ /*
+ * Result will be pure byte array. Pre-size it
+ */
+
+ ov = objv;
+ oc = objc;
do {
Tcl_Obj *objPtr = *ov++;
@@ -3058,8 +3079,12 @@ TclStringCat(
}
} while (--oc);
} else if (allowUniChar && requestUniChar) {
- /* Result will be pure Tcl_UniChar array. Pre-size it. */
- ov = objv; oc = objc;
+ /*
+ * Result will be pure Tcl_UniChar array. Pre-size it.
+ */
+
+ ov = objv;
+ oc = objc;
do {
Tcl_Obj *objPtr = *ov++;
@@ -3104,9 +3129,9 @@ TclStringCat(
} while (--oc && (length == 0) && (pendingPtr == NULL));
/*
- * Either we found a possibly non-empty value, and we
- * remember this index as the first and last such value so
- * far seen, or (oc == 0) and all values are known empty,
+ * Either we found a possibly non-empty value, and we remember
+ * this index as the first and last such value so far seen,
+ * or (oc == 0) and all values are known empty,
* so first = last = objc - 1 signals the right quick return.
*/
@@ -3118,10 +3143,9 @@ TclStringCat(
/* assert ( pendingPtr != NULL ) */
/*
- * There's a pending value followed by more values.
- * Loop over remaining values generating strings until
- * a non-empty value is found, or the pending value gets
- * its string generated.
+ * There's a pending value followed by more values. Loop over
+ * remaining values generating strings until a non-empty value
+ * is found, or the pending value gets its string generated.
*/
do {
@@ -3177,10 +3201,10 @@ TclStringCat(
unsigned char *dst;
/*
- * Broken interface! Byte array value routines offer no way
- * to handle failure to allocate enough space. Following
- * stanza may panic.
+ * Broken interface! Byte array value routines offer no way to handle
+ * failure to allocate enough space. Following stanza may panic.
*/
+
if (inPlace && !Tcl_IsShared(*objv)) {
int start;
@@ -3295,6 +3319,7 @@ TclStringCat(
if ((objPtr->bytes == NULL) || (objPtr->length)) {
int more;
char *src = Tcl_GetStringFromObj(objPtr, &more);
+
memcpy(dst, src, (size_t) more);
dst += more;
}
@@ -3320,7 +3345,7 @@ TclStringCat(
* Compare two Tcl_Obj values as strings.
*
* Results:
- * Like memcmp, return -1, 0, or 1.
+ * Like memcmp, return -1, 0, or 1.
*
* Side effects:
* String representations may be generated. Internal representation may
@@ -3329,13 +3354,13 @@ TclStringCat(
*---------------------------------------------------------------------------
*/
-int TclStringCmp (
- Tcl_Obj *value1Ptr,
- Tcl_Obj *value2Ptr,
- int checkEq, /* comparison is only for equality */
- int nocase, /* comparison is not case sensitive */
- int reqlength /* requested length */
-) {
+int TclStringCmp(
+ Tcl_Obj *value1Ptr,
+ Tcl_Obj *value2Ptr,
+ int checkEq, /* comparison is only for equality */
+ int nocase, /* comparison is not case sensitive */
+ int reqlength) /* requested length */
+{
char *s1, *s2;
int empty, length, match, s1len, s2len;
memCmpFn_t memCmpFn;
@@ -3355,6 +3380,7 @@ int TclStringCmp (
* case-sensitive (which is all that really makes sense with byte
* arrays anyway, and we have no memcasecmp() for some reason... :^)
*/
+
s1 = (char *) Tcl_GetByteArrayFromObj(value1Ptr, &s1len);
s2 = (char *) Tcl_GetByteArrayFromObj(value2Ptr, &s2len);
memCmpFn = memcmp;
@@ -3402,31 +3428,31 @@ int TclStringCmp (
} else {
if ((empty = TclCheckEmptyString(value1Ptr)) > 0) {
switch (TclCheckEmptyString(value2Ptr)) {
- case -1:
+ case -1:
s1 = 0;
s1len = 0;
s2 = TclGetStringFromObj(value2Ptr, &s2len);
break;
- case 0:
+ case 0:
match = -1;
goto matchdone;
- case 1:
- default: /* avoid warn: `s2` may be used uninitialized */
+ case 1:
+ default: /* avoid warn: `s2` may be used uninitialized */
match = 0;
goto matchdone;
}
} else if (TclCheckEmptyString(value2Ptr) > 0) {
switch (empty) {
- case -1:
+ case -1:
s2 = 0;
s2len = 0;
s1 = TclGetStringFromObj(value1Ptr, &s1len);
break;
- case 0:
+ case 0:
match = 1;
goto matchdone;
- case 1:
- default: /* avoid warn: `s1` may be used uninitialized */
+ case 1:
+ default: /* avoid warn: `s1` may be used uninitialized */
match = 0;
goto matchdone;
}
@@ -3436,18 +3462,19 @@ int TclStringCmp (
}
if (!nocase && checkEq) {
/*
- * When we have equal-length we can check only for (in)equality.
- * We can use memcmp in all (n)eq cases because we
- * don't need to worry about lexical LE/BE variance.
+ * When we have equal-length we can check only for
+ * (in)equality. We can use memcmp in all (n)eq cases because
+ * we don't need to worry about lexical LE/BE variance.
*/
+
memCmpFn = memcmp;
} else {
-
/*
- * As a catch-all we will work with UTF-8. We cannot use memcmp() as
- * that is unsafe with any string containing NUL (\xC0\x80 in Tcl's
- * utf rep). We can use the more efficient TclpUtfNcmp2 if we are
- * case-sensitive and no specific length was requested.
+ * As a catch-all we will work with UTF-8. We cannot use
+ * memcmp() as that is unsafe with any string containing NUL
+ * (\xC0\x80 in Tcl's utf rep). We can use the more efficient
+ * TclpUtfNcmp2 if we are case-sensitive and no specific
+ * length was requested.
*/
if ((reqlength < 0) && !nocase) {
@@ -3455,7 +3482,8 @@ int TclStringCmp (
} else {
s1len = Tcl_NumUtfChars(s1, s1len);
s2len = Tcl_NumUtfChars(s2, s2len);
- memCmpFn = (memCmpFn_t) (nocase ? Tcl_UtfNcasecmp : Tcl_UtfNcmp);
+ memCmpFn = (memCmpFn_t)
+ (nocase ? Tcl_UtfNcasecmp : Tcl_UtfNcmp);
}
}
}
@@ -3465,8 +3493,8 @@ int TclStringCmp (
length = reqlength;
} else if (reqlength < 0) {
/*
- * The requested length is negative, so we ignore it by setting it to
- * length + 1 so we correct the match var.
+ * The requested length is negative, so we ignore it by setting it
+ * to length + 1 so we correct the match var.
*/
reqlength = length + 1;
@@ -3474,11 +3502,12 @@ int TclStringCmp (
if (checkEq && (s1len != s2len)) {
match = 1; /* This will be reversed below. */
- } else {
+ } else {
/*
- * The comparison function should compare up to the minimum
- * byte length only.
+ * The comparison function should compare up to the minimum byte
+ * length only.
*/
+
match = memCmpFn(s1, s2, (size_t) length);
}
if ((match == 0) && (reqlength > length)) {
@@ -3486,7 +3515,7 @@ int TclStringCmp (
}
match = (match > 0) ? 1 : (match < 0) ? -1 : 0;
}
- matchdone:
+ matchdone:
return match;
}
@@ -3684,18 +3713,20 @@ static void
ReverseBytes(
unsigned char *to, /* Copy bytes into here... */
unsigned char *from, /* ...from here... */
- int count) /* Until this many are copied, */
+ int count) /* Until this many are copied, */
/* reversing as you go. */
{
unsigned char *src = from + count;
+
if (to == from) {
/* Reversing in place */
while (--src > to) {
unsigned char c = *src;
+
*src = *to;
*to++ = c;
}
- } else {
+ } else {
while (--src >= from) {
*to++ = *src;
}
@@ -3744,7 +3775,10 @@ TclStringReverse(
*to++ = *src;
}
} else {
- /* Reversing in place */
+ /*
+ * Reversing in place.
+ */
+
while (--src > from) {
ch = *src;
*src = *from;
@@ -3768,20 +3802,22 @@ TclStringReverse(
/*
* Either numChars == -1 and we don't know how many chars are
* represented by objPtr->bytes and we need Pass 1 just in case,
- * or numChars >= 0 and we know we have fewer chars than bytes,
- * so we know there's a multibyte character needing Pass 1.
+ * or numChars >= 0 and we know we have fewer chars than bytes, so
+ * we know there's a multibyte character needing Pass 1.
*
* Pass 1. Reverse the bytes of each multi-byte character.
*/
+
int charCount = 0;
int bytesLeft = numBytes;
while (bytesLeft) {
/*
- * NOTE: We know that the from buffer is NUL-terminated.
- * It's part of the contract for objPtr->bytes values.
- * Thus, we can skip calling Tcl_UtfCharComplete() here.
+ * NOTE: We know that the from buffer is NUL-terminated. It's
+ * part of the contract for objPtr->bytes values. Thus, we can
+ * skip calling Tcl_UtfCharComplete() here.
*/
+
int bytesInChar = TclUtfToUniChar(from, &ch);
ReverseBytes((unsigned char *)to, (unsigned char *)from,
@@ -3811,19 +3847,18 @@ TclStringReverse(
*
* The result is a concatenation of a prefix from objPtr, characters
* 0 through first-1, the insertPtr string value, and a suffix from
- * objPtr, characters from first + count to the end. The effect is
- * as if the inner substring of characters first through first+count-1
- * are removed and replaced with insertPtr.
- * If insertPtr is NULL, it is treated as an empty string.
- * When passed the flag TCL_STRING_IN_PLACE, this routine will try
- * to do the work within objPtr, so long as no sharing forbids it.
- * Without that request, or as needed, a new Tcl value will be allocated
- * to be the result.
+ * objPtr, characters from first + count to the end. The effect is as if
+ * the inner substring of characters first through first+count-1 are
+ * removed and replaced with insertPtr. If insertPtr is NULL, it is
+ * treated as an empty string. When passed the flag TCL_STRING_IN_PLACE,
+ * this routine will try to do the work within objPtr, so long as no
+ * sharing forbids it. Without that request, or as needed, a new Tcl
+ * value will be allocated to be the result.
*
* Results:
- * A Tcl value that is the result of the substring replacement.
- * May return NULL in case of an error. When NULL is returned and
- * interp is non-NULL, error information is left in interp
+ * A Tcl value that is the result of the substring replacement. May
+ * return NULL in case of an error. When NULL is returned and interp is
+ * non-NULL, error information is left in interp
*
*---------------------------------------------------------------------------
*/
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index be37bc0..5057b05 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -454,6 +454,15 @@ tellOld(
MODULE_SCOPE const TclStubs tclStubs;
MODULE_SCOPE const TclTomMathStubs tclTomMathStubs;
+#ifdef __GNUC__
+/*
+ * The rest of this file shouldn't warn about deprecated functions; they're
+ * there because we intend them to be so and know that this file is OK to
+ * touch those fields.
+ */
+#pragma GCC diagnostic ignored "-Wdeprecated-declarations"
+#endif
+
/* !BEGIN!: Do not edit below this line. */
static const TclIntStubs tclIntStubs = {
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 2ddb595..ac01ecf 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -161,7 +161,7 @@ static TestChannel *firstDetached;
static int AsyncHandlerProc(ClientData clientData,
Tcl_Interp *interp, int code);
-#ifdef TCL_THREADS
+#if TCL_THREADS
static Tcl_ThreadCreateType AsyncThreadProc(ClientData);
#endif
static void CleanupTestSetassocdataTests(
@@ -722,7 +722,7 @@ Tcltest_Init(
if (Procbodytest_Init(interp) != TCL_OK) {
return TCL_ERROR;
}
-#ifdef TCL_THREADS
+#if TCL_THREADS
if (TclThread_Init(interp) != TCL_OK) {
return TCL_ERROR;
}
@@ -902,7 +902,7 @@ TestasyncCmd(
Tcl_SetObjResult(interp, Tcl_NewStringObj(argv[3], -1));
Tcl_MutexUnlock(&asyncTestMutex);
return code;
-#ifdef TCL_THREADS
+#if TCL_THREADS
} else if (strcmp(argv[1], "marklater") == 0) {
if (argc != 3) {
goto wrongNumArgs;
@@ -999,7 +999,7 @@ AsyncHandlerProc(
*----------------------------------------------------------------------
*/
-#ifdef TCL_THREADS
+#if TCL_THREADS
static Tcl_ThreadCreateType
AsyncThreadProc(
ClientData clientData) /* Parameter is the id of a
diff --git a/generic/tclThread.c b/generic/tclThread.c
index 198fa6a..cafd824 100644
--- a/generic/tclThread.c
+++ b/generic/tclThread.c
@@ -41,21 +41,6 @@ static void RememberSyncObject(void *objPtr,
SyncObjRecord *recPtr);
/*
- * Several functions are #defined to nothing in tcl.h if TCL_THREADS is not
- * specified. Here we undo that so the functions are defined in the stubs
- * table.
- */
-
-#ifndef TCL_THREADS
-#undef Tcl_MutexLock
-#undef Tcl_MutexUnlock
-#undef Tcl_MutexFinalize
-#undef Tcl_ConditionNotify
-#undef Tcl_ConditionWait
-#undef Tcl_ConditionFinalize
-#endif
-
-/*
*----------------------------------------------------------------------
*
* Tcl_GetThreadData --
@@ -79,7 +64,7 @@ Tcl_GetThreadData(
int size) /* Size of storage block */
{
void *result;
-#ifdef TCL_THREADS
+#if TCL_THREADS
/*
* Initialize the key for this thread.
*/
@@ -126,7 +111,7 @@ TclThreadDataKeyGet(
Tcl_ThreadDataKey *keyPtr) /* Identifier for the data chunk. */
{
-#ifdef TCL_THREADS
+#if TCL_THREADS
return TclThreadStorageKeyGet(keyPtr);
#else /* TCL_THREADS */
return *keyPtr;
@@ -269,11 +254,12 @@ TclRememberMutex(
*----------------------------------------------------------------------
*/
+#undef Tcl_MutexFinalize
void
Tcl_MutexFinalize(
Tcl_Mutex *mutexPtr)
{
-#ifdef TCL_THREADS
+#if TCL_THREADS
TclpFinalizeMutex(mutexPtr);
#endif
TclpMasterLock();
@@ -322,11 +308,12 @@ TclRememberCondition(
*----------------------------------------------------------------------
*/
+#undef Tcl_ConditionFinalize
void
Tcl_ConditionFinalize(
Tcl_Condition *condPtr)
{
-#ifdef TCL_THREADS
+#if TCL_THREADS
TclpFinalizeCondition(condPtr);
#endif
TclpMasterLock();
@@ -356,7 +343,7 @@ void
TclFinalizeThreadData(int quick)
{
TclFinalizeThreadDataThread();
-#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
+#if TCL_THREADS && defined(USE_THREAD_ALLOC)
if (!quick) {
/*
* Quick exit principle makes it useless to terminate allocators
@@ -389,7 +376,7 @@ TclFinalizeSynchronization(void)
int i;
void *blockPtr;
Tcl_ThreadDataKey *keyPtr;
-#ifdef TCL_THREADS
+#if TCL_THREADS
Tcl_Mutex *mutexPtr;
Tcl_Condition *condPtr;
@@ -413,7 +400,7 @@ TclFinalizeSynchronization(void)
keyRecord.max = 0;
keyRecord.num = 0;
-#ifdef TCL_THREADS
+#if TCL_THREADS
/*
* Call thread storage master cleanup.
*/
@@ -473,12 +460,10 @@ Tcl_ExitThread(
int status)
{
Tcl_FinalizeThread();
-#ifdef TCL_THREADS
TclpThreadExit(status);
-#endif
}
-#ifndef TCL_THREADS
+#if !TCL_THREADS
/*
*----------------------------------------------------------------------
diff --git a/generic/tclThreadAlloc.c b/generic/tclThreadAlloc.c
index 8077de4..3f1abc2 100644
--- a/generic/tclThreadAlloc.c
+++ b/generic/tclThreadAlloc.c
@@ -13,7 +13,7 @@
*/
#include "tclInt.h"
-#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
+#if TCL_THREADS && defined(USE_THREAD_ALLOC)
/*
* If range checking is enabled, an additional byte will be allocated to store
diff --git a/generic/tclThreadStorage.c b/generic/tclThreadStorage.c
index 755a461..b56ec80 100644
--- a/generic/tclThreadStorage.c
+++ b/generic/tclThreadStorage.c
@@ -13,7 +13,7 @@
#include "tclInt.h"
-#ifdef TCL_THREADS
+#if TCL_THREADS
#include <signal.h>
/*
diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c
index a008799..3a6fc43 100644
--- a/generic/tclThreadTest.c
+++ b/generic/tclThreadTest.c
@@ -18,7 +18,7 @@
#endif
#include "tclInt.h"
-#ifdef TCL_THREADS
+#if TCL_THREADS
/*
* Each thread has an single instance of the following structure. There is one
* instance of this structure per thread even if that thread contains multiple
diff --git a/generic/tclVar.c b/generic/tclVar.c
index f22815c..d5e0fa1 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -60,14 +60,12 @@ VarHashCreateVar(
Tcl_Obj *key,
int *newPtr)
{
- Tcl_HashEntry *hPtr = Tcl_CreateHashEntry(&tablePtr->table,
- key, newPtr);
+ Tcl_HashEntry *hPtr = Tcl_CreateHashEntry(&tablePtr->table, key, newPtr);
- if (hPtr) {
- return VarHashGetValue(hPtr);
- } else {
+ if (!hPtr) {
return NULL;
}
+ return VarHashGetValue(hPtr);
}
#define VarHashFindVar(tablePtr, key) \
@@ -92,11 +90,10 @@ VarHashFirstVar(
{
Tcl_HashEntry *hPtr = VarHashFirstEntry(tablePtr, searchPtr);
- if (hPtr) {
- return VarHashGetValue(hPtr);
- } else {
+ if (!hPtr) {
return NULL;
}
+ return VarHashGetValue(hPtr);
}
static inline Var *
@@ -105,11 +102,10 @@ VarHashNextVar(
{
Tcl_HashEntry *hPtr = VarHashNextEntry(searchPtr);
- if (hPtr) {
- return VarHashGetValue(hPtr);
- } else {
+ if (!hPtr) {
return NULL;
}
+ return VarHashGetValue(hPtr);
}
#define VarHashGetKey(varPtr) \
@@ -174,10 +170,14 @@ typedef struct ArraySearch {
static void AppendLocals(Tcl_Interp *interp, Tcl_Obj *listPtr,
Tcl_Obj *patternPtr, int includeLinks);
-static void ArrayPopulateSearch(Tcl_Interp *interp, Tcl_Obj *arrayNameObj, Var *varPtr, ArraySearch *searchPtr);
-static void ArrayDoneSearch (Interp *iPtr, Var *varPtr, ArraySearch *searchPtr);
+static void ArrayPopulateSearch(Tcl_Interp *interp,
+ Tcl_Obj *arrayNameObj, Var *varPtr,
+ ArraySearch *searchPtr);
+static void ArrayDoneSearch(Interp *iPtr, Var *varPtr,
+ ArraySearch *searchPtr);
static Tcl_NRPostProc ArrayForLoopCallback;
-static int ArrayForNRCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv);
+static int ArrayForNRCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const *objv);
static void DeleteSearches(Interp *iPtr, Var *arrayVarPtr);
static void DeleteArray(Interp *iPtr, Tcl_Obj *arrayNamePtr,
Var *varPtr, int flags, int index);
@@ -322,7 +322,8 @@ CleanupVar(
{
if (TclIsVarUndefined(varPtr) && TclIsVarInHash(varPtr)
&& !TclIsVarTraced(varPtr)
- && (VarHashRefCount(varPtr) == (unsigned)!TclIsVarDeadHash(varPtr))) {
+ && (VarHashRefCount(varPtr) == (unsigned)
+ !TclIsVarDeadHash(varPtr))) {
if (VarHashRefCount(varPtr) == 0) {
ckfree(varPtr);
} else {
@@ -331,7 +332,8 @@ CleanupVar(
}
if (arrayPtr != NULL && TclIsVarUndefined(arrayPtr) &&
TclIsVarInHash(arrayPtr) && !TclIsVarTraced(arrayPtr) &&
- (VarHashRefCount(arrayPtr) == (unsigned)!TclIsVarDeadHash(arrayPtr))) {
+ (VarHashRefCount(arrayPtr) == (unsigned)
+ !TclIsVarDeadHash(arrayPtr))) {
if (VarHashRefCount(arrayPtr) == 0) {
ckfree(arrayPtr);
} else {
@@ -607,7 +609,6 @@ TclObjLookupVarEx(
}
if (!parsed) {
-
/*
* part1Ptr is possibly an unparsed array element.
*/
@@ -615,12 +616,11 @@ TclObjLookupVarEx(
int len;
const char *part1 = TclGetStringFromObj(part1Ptr, &len);
- if (len > 1 && (part1[len - 1] == ')')) {
+ if ((len > 1) && (part1[len - 1] == ')')) {
+ const char *part2 = strchr(part1, '(');
- const char *part2 = strchr(part1, '(');
-
- if (part2) {
- Tcl_Obj *arrayPtr;
+ if (part2) {
+ Tcl_Obj *arrayPtr;
if (part2Ptr != NULL) {
if (flags & TCL_LEAVE_ERR_MSG) {
@@ -632,19 +632,20 @@ TclObjLookupVarEx(
return NULL;
}
- arrayPtr = Tcl_NewStringObj(part1, (part2 - part1));
- part2Ptr = Tcl_NewStringObj(part2 + 1, len - (part2 - part1) - 2);
+ arrayPtr = Tcl_NewStringObj(part1, (part2 - part1));
+ part2Ptr = Tcl_NewStringObj(part2 + 1,
+ len - (part2 - part1) - 2);
- TclFreeIntRep(part1Ptr);
+ TclFreeIntRep(part1Ptr);
- Tcl_IncrRefCount(arrayPtr);
- part1Ptr->internalRep.twoPtrValue.ptr1 = arrayPtr;
- Tcl_IncrRefCount(part2Ptr);
- part1Ptr->internalRep.twoPtrValue.ptr2 = part2Ptr;
- part1Ptr->typePtr = &tclParsedVarNameType;
+ Tcl_IncrRefCount(arrayPtr);
+ part1Ptr->internalRep.twoPtrValue.ptr1 = arrayPtr;
+ Tcl_IncrRefCount(part2Ptr);
+ part1Ptr->internalRep.twoPtrValue.ptr2 = part2Ptr;
+ part1Ptr->typePtr = &tclParsedVarNameType;
- part1Ptr = arrayPtr;
- }
+ part1Ptr = arrayPtr;
+ }
}
}
@@ -674,6 +675,7 @@ TclObjLookupVarEx(
/*
* An indexed local variable.
*/
+
Tcl_Obj *cachedNamePtr = localName(varFramePtr, index);
part1Ptr->typePtr = &localVarNameType;
@@ -682,7 +684,7 @@ TclObjLookupVarEx(
Tcl_IncrRefCount(cachedNamePtr);
if (cachedNamePtr->typePtr != &localVarNameType
|| cachedNamePtr->internalRep.twoPtrValue.ptr1 != NULL) {
- TclFreeIntRep(cachedNamePtr);
+ TclFreeIntRep(cachedNamePtr);
}
} else {
part1Ptr->internalRep.twoPtrValue.ptr1 = NULL;
@@ -877,38 +879,41 @@ TclLookupSimpleVar(
if (varPtr == NULL) {
Tcl_Obj *tailPtr;
- if (create) { /* Var wasn't found so create it. */
- TclGetNamespaceForQualName(interp, varName, cxtNsPtr,
- flags, &varNsPtr, &dummy1Ptr, &dummy2Ptr, &tail);
- if (varNsPtr == NULL) {
- *errMsgPtr = badNamespace;
- return NULL;
- } else if (tail == NULL) {
- *errMsgPtr = missingName;
- return NULL;
- }
- if (tail != varName) {
- tailPtr = Tcl_NewStringObj(tail, -1);
- } else {
- tailPtr = varNamePtr;
- }
- varPtr = VarHashCreateVar(&varNsPtr->varTable, tailPtr,
- &isNew);
- if (lookGlobal) {
- /*
- * The variable was created starting from the global
- * namespace: a global reference is returned even if it
- * wasn't explicitly requested.
- */
-
- *indexPtr = -1;
- } else {
- *indexPtr = -2;
- }
- } else { /* Var wasn't found and not to create it. */
+ if (!create) { /* Var wasn't found and not to create it. */
*errMsgPtr = noSuchVar;
return NULL;
}
+
+ /*
+ * Var wasn't found so create it.
+ */
+
+ TclGetNamespaceForQualName(interp, varName, cxtNsPtr, flags,
+ &varNsPtr, &dummy1Ptr, &dummy2Ptr, &tail);
+ if (varNsPtr == NULL) {
+ *errMsgPtr = badNamespace;
+ return NULL;
+ } else if (tail == NULL) {
+ *errMsgPtr = missingName;
+ return NULL;
+ }
+ if (tail != varName) {
+ tailPtr = Tcl_NewStringObj(tail, -1);
+ } else {
+ tailPtr = varNamePtr;
+ }
+ varPtr = VarHashCreateVar(&varNsPtr->varTable, tailPtr, &isNew);
+ if (lookGlobal) {
+ /*
+ * The variable was created starting from the global
+ * namespace: a global reference is returned even if it wasn't
+ * explicitly requested.
+ */
+
+ *indexPtr = -1;
+ } else {
+ *indexPtr = -2;
+ }
}
} else { /* Local var: look in frame varFramePtr. */
int localLen, localCt = varFramePtr->numCompiledLocals;
@@ -2167,7 +2172,6 @@ TclPtrIncrObjVarIdx(
} else {
/* Unshared - can Incr in place */
if (TCL_OK == TclIncrObj(interp, varValuePtr, incrPtr)) {
-
/*
* This seems dumb to write the incremeted value into the var
* after we just adjusted the value in place, but the spec for
@@ -2909,27 +2913,24 @@ Tcl_LappendObjCmd(
/*
*----------------------------------------------------------------------
*
- * ArrayForObjCmd
- * ArrayForNRCmd
- * ArrayForLoopCallback
- * ArrayObjNext
+ * ArrayForObjCmd, ArrayForNRCmd, ArrayForLoopCallback, ArrayObjNext --
*
- * These functions implement the "array for" Tcl command.
- * array for {k v} a {}
- * The array for command iterates over the array, setting the
- * the specified loop variables, and executing the body each iteration.
+ * These functions implement the "array for" Tcl command.
+ * array for {k v} a {}
+ * The array for command iterates over the array, setting the the
+ * specified loop variables, and executing the body each iteration.
*
- * ArrayForObjCmd() is the standard wrapper around ArrayForNRCmd().
+ * ArrayForObjCmd() is the standard wrapper around ArrayForNRCmd().
*
- * ArrayForNRCmd() sets up the ArraySearch structure, sets arrayNamePtr
- * inside the structure and calls VarHashFirstEntry to start the hash
- * iteration.
+ * ArrayForNRCmd() sets up the ArraySearch structure, sets arrayNamePtr
+ * inside the structure and calls VarHashFirstEntry to start the hash
+ * iteration.
*
- * ArrayForNRCmd() does not execute the body or set the loop variables,
- * it only initializes the iterator.
+ * ArrayForNRCmd() does not execute the body or set the loop variables,
+ * it only initializes the iterator.
*
- * ArrayForLoopCallback() iterates over the entire array, executing
- * the body each time.
+ * ArrayForLoopCallback() iterates over the entire array, executing the
+ * body each time.
*
*----------------------------------------------------------------------
*/
@@ -2937,39 +2938,39 @@ Tcl_LappendObjCmd(
static int
ArrayObjNext(
Tcl_Interp *interp,
- Tcl_Obj *arrayNameObj, /* array */
- Var *varPtr, /* array */
+ Tcl_Obj *arrayNameObj, /* array */
+ Var *varPtr, /* array */
ArraySearch *searchPtr,
Tcl_Obj **keyPtrPtr, /* Pointer to a variable to have the key
* written into, or NULL. */
- Tcl_Obj **valuePtrPtr /* Pointer to a variable to have the
+ Tcl_Obj **valuePtrPtr) /* Pointer to a variable to have the
* value written into, or NULL.*/
- )
{
Tcl_Obj *keyObj;
Tcl_Obj *valueObj = NULL;
- int gotValue;
- int donerc;
+ int gotValue;
+ int donerc;
donerc = TCL_BREAK;
if ((varPtr->flags & VAR_SEARCH_ACTIVE) != VAR_SEARCH_ACTIVE) {
- donerc = TCL_ERROR;
- return donerc;
+ donerc = TCL_ERROR;
+ return donerc;
}
gotValue = 0;
while (1) {
Tcl_HashEntry *hPtr = searchPtr->nextEntry;
- if (hPtr != NULL) {
- searchPtr->nextEntry = NULL;
- } else {
- hPtr = Tcl_NextHashEntry(&searchPtr->search);
- if (hPtr == NULL) {
- gotValue = 0;
- break;
- }
- }
+
+ if (hPtr != NULL) {
+ searchPtr->nextEntry = NULL;
+ } else {
+ hPtr = Tcl_NextHashEntry(&searchPtr->search);
+ if (hPtr == NULL) {
+ gotValue = 0;
+ break;
+ }
+ }
varPtr = VarHashGetValue(hPtr);
if (!TclIsVarUndefined(varPtr)) {
gotValue = 1;
@@ -2977,7 +2978,7 @@ ArrayObjNext(
}
}
- if (! gotValue) {
+ if (!gotValue) {
return donerc;
}
@@ -2985,8 +2986,8 @@ ArrayObjNext(
keyObj = VarHashGetKey(varPtr);
*keyPtrPtr = keyObj;
- valueObj = Tcl_ObjGetVar2(interp, arrayNameObj,
- keyObj, TCL_LEAVE_ERR_MSG);
+ valueObj = Tcl_ObjGetVar2(interp, arrayNameObj, keyObj,
+ TCL_LEAVE_ERR_MSG);
*valuePtrPtr = valueObj;
return donerc;
@@ -3019,8 +3020,7 @@ ArrayForNRCmd(
*/
if (objc != 4) {
- Tcl_WrongNumArgs(interp, 1, objv,
- "{key value} arrayName script");
+ Tcl_WrongNumArgs(interp, 1, objv, "{key value} arrayName script");
return TCL_ERROR;
}
@@ -3054,7 +3054,7 @@ ArrayForNRCmd(
*/
searchPtr = ckalloc(sizeof(ArraySearch));
- ArrayPopulateSearch (interp, arrayNameObj, varPtr, searchPtr);
+ ArrayPopulateSearch(interp, arrayNameObj, varPtr, searchPtr);
/*
* Make sure that these objects (which we need throughout the body of the
@@ -3120,35 +3120,37 @@ ArrayForLoopCallback(
varPtr = TclObjLookupVarEx(interp, arrayNameObj, NULL, /*flags*/ 0,
/*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
if (varPtr == NULL) {
- done = TCL_ERROR;
+ done = TCL_ERROR;
} else {
- done = ArrayObjNext (interp, arrayNameObj, varPtr,
- searchPtr, &keyObj, &valueObj);
+ done = ArrayObjNext(interp, arrayNameObj, varPtr, searchPtr, &keyObj,
+ &valueObj);
}
result = TCL_OK;
if (done != TCL_CONTINUE) {
Tcl_ResetResult(interp);
- if (done == TCL_ERROR) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "array changed during iteration", -1));
- Tcl_SetErrorCode(interp, "TCL", "READ", "array", "for", NULL);
- varPtr->flags |= TCL_LEAVE_ERR_MSG;
- result = done;
- }
+ if (done == TCL_ERROR) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "array changed during iteration", -1));
+ Tcl_SetErrorCode(interp, "TCL", "READ", "array", "for", NULL);
+ varPtr->flags |= TCL_LEAVE_ERR_MSG;
+ result = done;
+ }
goto arrayfordone;
}
Tcl_ListObjGetElements(NULL, varListObj, &varc, &varv);
- if (Tcl_ObjSetVar2(interp, varv[0], NULL, keyObj, TCL_LEAVE_ERR_MSG) == NULL) {
- result = TCL_ERROR;
- goto arrayfordone;
+ if (Tcl_ObjSetVar2(interp, varv[0], NULL, keyObj,
+ TCL_LEAVE_ERR_MSG) == NULL) {
+ result = TCL_ERROR;
+ goto arrayfordone;
}
if (valueObj != NULL) {
- if (Tcl_ObjSetVar2(interp, varv[1], NULL, valueObj, TCL_LEAVE_ERR_MSG) == NULL) {
- result = TCL_ERROR;
- goto arrayfordone;
- }
+ if (Tcl_ObjSetVar2(interp, varv[1], NULL, valueObj,
+ TCL_LEAVE_ERR_MSG) == NULL) {
+ result = TCL_ERROR;
+ goto arrayfordone;
+ }
}
/*
@@ -3164,13 +3166,15 @@ ArrayForLoopCallback(
*/
arrayfordone:
- /* if the search was terminated by an array change, the
- * VAR_SEARCH_ACTIVE flag will no longer be set
- */
if (done != TCL_ERROR) {
- ArrayDoneSearch (iPtr, varPtr, searchPtr);
+ /*
+ * If the search was terminated by an array change, the
+ * VAR_SEARCH_ACTIVE flag will no longer be set.
+ */
+
+ ArrayDoneSearch(iPtr, varPtr, searchPtr);
Tcl_DecrRefCount(searchPtr->name);
- ckfree(searchPtr);
+ ckfree(searchPtr);
}
TclDecrRefCount(varListObj);
@@ -3181,14 +3185,15 @@ ArrayForLoopCallback(
/*
* ArrayPopulateSearch
*/
+
static void
ArrayPopulateSearch(
- Tcl_Interp *interp,
- Tcl_Obj *arrayNameObj,
- Var *varPtr,
+ Tcl_Interp *interp,
+ Tcl_Obj *arrayNameObj,
+ Var *varPtr,
ArraySearch *searchPtr)
{
- Interp *iPtr = (Interp *)interp;
+ Interp *iPtr = (Interp *) interp;
Tcl_HashEntry *hPtr;
int isNew;
@@ -3206,7 +3211,7 @@ ArrayPopulateSearch(
&searchPtr->search);
Tcl_SetHashValue(hPtr, searchPtr);
searchPtr->name = Tcl_ObjPrintf("s-%d-%s", searchPtr->id,
- TclGetString(arrayNameObj));
+ TclGetString(arrayNameObj));
Tcl_IncrRefCount(searchPtr->name);
}
/*
@@ -3258,7 +3263,7 @@ ArrayStartSearchCmd(
*/
searchPtr = ckalloc(sizeof(ArraySearch));
- ArrayPopulateSearch (interp, objv[1], varPtr, searchPtr);
+ ArrayPopulateSearch(interp, objv[1], varPtr, searchPtr);
Tcl_SetObjResult(interp, searchPtr->name);
return TCL_OK;
}
@@ -3268,12 +3273,12 @@ ArrayStartSearchCmd(
*
* ArrayDoneSearch --
*
- * Removes the search from the hash of active searches.
+ * Removes the search from the hash of active searches.
*
*----------------------------------------------------------------------
*/
static void
-ArrayDoneSearch (
+ArrayDoneSearch(
Interp *iPtr,
Var *varPtr,
ArraySearch *searchPtr)
@@ -3288,7 +3293,7 @@ ArrayDoneSearch (
hPtr = Tcl_FindHashEntry(&iPtr->varSearches, varPtr);
if (hPtr == NULL) {
- return;
+ return;
}
if (searchPtr == Tcl_GetHashValue(hPtr)) {
if (searchPtr->nextPtr) {
@@ -3522,7 +3527,7 @@ ArrayDoneSearchCmd(
return TCL_ERROR;
}
- ArrayDoneSearch (iPtr, varPtr, searchPtr);
+ ArrayDoneSearch(iPtr, varPtr, searchPtr);
Tcl_DecrRefCount(searchPtr->name);
ckfree(searchPtr);
return TCL_OK;
@@ -4034,7 +4039,8 @@ ArraySetCmd(
if ((elemVarPtr == NULL) ||
(TclPtrSetVarIdx(interp, elemVarPtr, varPtr, arrayNameObj,
- elemPtrs[i],elemPtrs[i+1],TCL_LEAVE_ERR_MSG,-1) == NULL)){
+ elemPtrs[i], elemPtrs[i+1], TCL_LEAVE_ERR_MSG,
+ -1) == NULL)) {
result = TCL_ERROR;
break;
}
@@ -6024,7 +6030,7 @@ TclInfoVarsCmd(
*/
if ((nsPtr != globalNsPtr) && !specificNsInPattern) {
- varPtr = VarHashFirstVar(&globalNsPtr->varTable,&search);
+ varPtr = VarHashFirstVar(&globalNsPtr->varTable, &search);
while (varPtr) {
if (!TclIsVarUndefined(varPtr)
|| TclIsVarNamespaceVar(varPtr)) {
@@ -6408,9 +6414,9 @@ CompareVarKeys(
/*
* If the object pointers are the same then they match.
* OPT: this comparison was moved to the caller
-
- if (objPtr1 == objPtr2) return 1;
- */
+ *
+ * if (objPtr1 == objPtr2) return 1;
+ */
/*
* Don't use Tcl_GetStringFromObj as it would prevent l1 and l2 being in a
generated by cgit v0.12 at 2025-04-15 13:41:36 (GMT)