summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2024-08-01 15:38:25 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2024-08-01 15:38:25 (GMT)
commit2ec6708224853911b1636d5ff3976a6a60ab331b (patch)
tree46db0e6a29b8cecaac15128ccdbcd055afcec38e /generic
parentb96569028387bed872c2070fc1b25583ec62074a (diff)
downloadtcl-2ec6708224853911b1636d5ff3976a6a60ab331b.zip
tcl-2ec6708224853911b1636d5ff3976a6a60ab331b.tar.gz
tcl-2ec6708224853911b1636d5ff3976a6a60ab331b.tar.bz2
Use Tcl's internal API a bit better
Diffstat (limited to 'generic')
-rw-r--r--generic/tclOO.c269
-rw-r--r--generic/tclOO.h29
-rw-r--r--generic/tclOOBasic.c70
-rw-r--r--generic/tclOOCall.c170
-rw-r--r--generic/tclOODefineCmds.c105
-rw-r--r--generic/tclOOInfo.c126
-rw-r--r--generic/tclOOInt.h243
-rw-r--r--generic/tclOOMethod.c128
8 files changed, 620 insertions, 520 deletions
diff --git a/generic/tclOO.c b/generic/tclOO.c
index b6f9497..288b7f2 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -67,8 +67,6 @@ static int CloneClassMethod(Tcl_Interp *interp, Class *clsPtr,
Method **newMPtrPtr);
static int CloneObjectMethod(Tcl_Interp *interp, Object *oPtr,
Method *mPtr, Tcl_Obj *namePtr);
-static void DeletedDefineNamespace(void *clientData);
-static void DeletedObjdefNamespace(void *clientData);
static void DeletedHelpersNamespace(void *clientData);
static Tcl_NRPostProc FinalizeAlloc;
static Tcl_NRPostProc FinalizeNext;
@@ -291,6 +289,37 @@ TclOOGetFoundation(
/*
* ----------------------------------------------------------------------
*
+ * CreateCmdInNS --
+ *
+ * Create a command in a namespace. Supports setting various
+ * implementation functions, but not a deletion callback or a clientData;
+ * it's suitable for use-cases in this file, no more.
+ *
+ * ----------------------------------------------------------------------
+ */
+static inline void
+CreateCmdInNS(
+ Tcl_Interp *interp,
+ Tcl_Namespace *namespacePtr,
+ const char *name,
+ Tcl_ObjCmdProc *cmdProc,
+ Tcl_ObjCmdProc *nreProc,
+ CompileProc *compileProc)
+{
+ Command *cmdPtr;
+
+ if (cmdProc == NULL && nreProc == NULL) {
+ Tcl_Panic("must supply at least one implementation function");
+ }
+ cmdPtr = (Command *) TclCreateObjCommandInNs(interp, name,
+ namespacePtr, cmdProc, NULL, NULL);
+ cmdPtr->nreProc = nreProc;
+ cmdPtr->compileProc = compileProc;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
* InitFoundation --
*
* Set up the core of the OO core class system. This is a structure
@@ -305,12 +334,11 @@ InitFoundation(
Tcl_Interp *interp)
{
static Tcl_ThreadDataKey tsdKey;
- ThreadLocalData *tsdPtr =
- (ThreadLocalData *)Tcl_GetThreadData(&tsdKey, sizeof(ThreadLocalData));
- Foundation *fPtr = (Foundation *)Tcl_Alloc(sizeof(Foundation));
+ ThreadLocalData *tsdPtr = (ThreadLocalData *)
+ Tcl_GetThreadData(&tsdKey, sizeof(ThreadLocalData));
+ Foundation *fPtr = (Foundation *) Tcl_Alloc(sizeof(Foundation));
+ Tcl_Namespace *define, *objdef, *cfg;
Tcl_Obj *namePtr;
- Tcl_DString buffer;
- Command *cmdPtr;
size_t i;
/*
@@ -324,15 +352,14 @@ InitFoundation(
fPtr->interp = interp;
fPtr->ooNs = Tcl_CreateNamespace(interp, "::oo", fPtr, NULL);
Tcl_Export(interp, fPtr->ooNs, "[a-z]*", 1);
- fPtr->defineNs = Tcl_CreateNamespace(interp, "::oo::define", fPtr,
- DeletedDefineNamespace);
- fPtr->objdefNs = Tcl_CreateNamespace(interp, "::oo::objdefine", fPtr,
- DeletedObjdefNamespace);
+ define = Tcl_CreateNamespace(interp, "::oo::define", fPtr, NULL);
+ objdef = Tcl_CreateNamespace(interp, "::oo::objdefine", fPtr, NULL);
fPtr->helpersNs = Tcl_CreateNamespace(interp, "::oo::Helpers", fPtr,
DeletedHelpersNamespace);
- Tcl_CreateNamespace(interp, "::oo::configuresupport", NULL, NULL);
+ cfg = Tcl_CreateNamespace(interp, "::oo::configuresupport", NULL, NULL);
fPtr->epoch = 1;
fPtr->tsdPtr = tsdPtr;
+
TclNewLiteralStringObj(fPtr->unknownMethodNameObj, "unknown");
TclNewLiteralStringObj(fPtr->constructorName, "<constructor>");
TclNewLiteralStringObj(fPtr->destructorName, "<destructor>");
@@ -345,30 +372,25 @@ InitFoundation(
Tcl_IncrRefCount(fPtr->clonedName);
Tcl_IncrRefCount(fPtr->defineName);
Tcl_IncrRefCount(fPtr->myName);
- Tcl_CreateObjCommand(interp, "::oo::UnknownDefinition",
+
+ TclCreateObjCommandInNs(interp, "UnknownDefinition", fPtr->ooNs,
TclOOUnknownDefinition, NULL, NULL);
TclNewLiteralStringObj(namePtr, "::oo::UnknownDefinition");
- Tcl_SetNamespaceUnknownHandler(interp, fPtr->defineNs, namePtr);
- Tcl_SetNamespaceUnknownHandler(interp, fPtr->objdefNs, namePtr);
+ Tcl_SetNamespaceUnknownHandler(interp, define, namePtr);
+ Tcl_SetNamespaceUnknownHandler(interp, objdef, namePtr);
+ Tcl_BounceRefCount(namePtr);
/*
* Create the subcommands in the oo::define and oo::objdefine spaces.
*/
- Tcl_DStringInit(&buffer);
for (i = 0 ; defineCmds[i].name ; i++) {
- TclDStringAppendLiteral(&buffer, "::oo::define::");
- Tcl_DStringAppend(&buffer, defineCmds[i].name, -1);
- Tcl_CreateObjCommand(interp, Tcl_DStringValue(&buffer),
+ TclCreateObjCommandInNs(interp, defineCmds[i].name, define,
defineCmds[i].objProc, INT2PTR(defineCmds[i].flag), NULL);
- Tcl_DStringFree(&buffer);
}
for (i = 0 ; objdefCmds[i].name ; i++) {
- TclDStringAppendLiteral(&buffer, "::oo::objdefine::");
- Tcl_DStringAppend(&buffer, objdefCmds[i].name, -1);
- Tcl_CreateObjCommand(interp, Tcl_DStringValue(&buffer),
+ TclCreateObjCommandInNs(interp, objdefCmds[i].name, objdef,
objdefCmds[i].objProc, INT2PTR(objdefCmds[i].flag), NULL);
- Tcl_DStringFree(&buffer);
}
Tcl_CallWhenDeleted(interp, KillFoundation, NULL);
@@ -384,10 +406,10 @@ InitFoundation(
*/
for (i = 0 ; objMethods[i].name ; i++) {
- TclOONewBasicMethod(interp, fPtr->objectCls, &objMethods[i]);
+ TclOONewBasicMethod(fPtr->objectCls, &objMethods[i]);
}
for (i = 0 ; clsMethods[i].name ; i++) {
- TclOONewBasicMethod(interp, fPtr->classCls, &clsMethods[i]);
+ TclOONewBasicMethod(fPtr->classCls, &clsMethods[i]);
}
/*
@@ -399,7 +421,8 @@ InitFoundation(
TclNewLiteralStringObj(namePtr, "new");
TclNewInstanceMethod(interp, (Tcl_Object) fPtr->classCls->thisPtr,
namePtr /* keeps ref */, 0 /* private */, NULL, NULL);
- fPtr->classCls->constructorPtr = (Method *) TclNewMethod(interp,
+ Tcl_BounceRefCount(namePtr);
+ fPtr->classCls->constructorPtr = (Method *) TclNewMethod(
(Tcl_Class) fPtr->classCls, NULL, 0, &classConstructor, NULL);
/*
@@ -407,20 +430,17 @@ InitFoundation(
* ensemble.
*/
- cmdPtr = (Command *) Tcl_NRCreateCommand(interp, "::oo::Helpers::next",
- NULL, TclOONextObjCmd, NULL, NULL);
- cmdPtr->compileProc = TclCompileObjectNextCmd;
- cmdPtr = (Command *) Tcl_NRCreateCommand(interp, "::oo::Helpers::nextto",
- NULL, TclOONextToObjCmd, NULL, NULL);
- cmdPtr->compileProc = TclCompileObjectNextToCmd;
- cmdPtr = (Command *) Tcl_CreateObjCommand(interp, "::oo::Helpers::self",
- TclOOSelfObjCmd, NULL, NULL);
- cmdPtr->compileProc = TclCompileObjectSelfCmd;
- Tcl_CreateObjCommand(interp, "::oo::define", TclOODefineObjCmd, NULL,
- NULL);
- Tcl_CreateObjCommand(interp, "::oo::objdefine", TclOOObjDefObjCmd, NULL,
- NULL);
- Tcl_CreateObjCommand(interp, "::oo::copy", TclOOCopyObjectCmd, NULL,NULL);
+ CreateCmdInNS(interp, fPtr->helpersNs, "next",
+ NULL, TclOONextObjCmd, TclCompileObjectNextCmd);
+ CreateCmdInNS(interp, fPtr->helpersNs, "nextto",
+ NULL, TclOONextToObjCmd, TclCompileObjectNextToCmd);
+ CreateCmdInNS(interp, fPtr->helpersNs, "self",
+ TclOOSelfObjCmd, NULL, TclCompileObjectSelfCmd);
+
+ CreateCmdInNS(interp, fPtr->ooNs, "define", TclOODefineObjCmd, NULL, NULL);
+ CreateCmdInNS(interp, fPtr->ooNs, "objdefine", TclOOObjDefObjCmd, NULL, NULL);
+ CreateCmdInNS(interp, fPtr->ooNs, "copy", TclOOCopyObjectCmd, NULL, NULL);
+
TclOOInitInfo(interp);
/*
@@ -439,13 +459,17 @@ InitFoundation(
(Tcl_Class) fPtr->classCls,
"::oo::configuresupport::configurable", NULL, -1, NULL, 0);
for (i = 0 ; cfgMethods[i].name ; i++) {
- TclOONewBasicMethod(interp, ((Object *) cfgCls)->classPtr,
- &cfgMethods[i]);
+ TclOONewBasicMethod(((Object *) cfgCls)->classPtr, &cfgMethods[i]);
}
- Tcl_CreateObjCommand(interp, "::oo::configuresupport::StdObjectProperties",
+ TclCreateObjCommandInNs(interp, "StdObjectProperties", cfg,
TclOOInstallStdPropertyImplsCmd, (void *) 1, NULL);
- Tcl_CreateObjCommand(interp, "::oo::configuresupport::StdClassProperties",
+ TclCreateObjCommandInNs(interp, "StdClassProperties", cfg,
TclOOInstallStdPropertyImplsCmd, (void *) 0, NULL);
+
+ /*
+ * Don't have handles to these namespaces, so use Tcl_CreateObjCommand.
+ */
+
Tcl_CreateObjCommand(interp,
"::oo::configuresupport::configurableobject::property",
TclOOPropertyDefinitionCmd, (void *) 1, NULL);
@@ -487,7 +511,7 @@ InitClassSystemRoots(
fakeObject.refCount = 0; // Do not increment an uninitialized value.
fPtr->objectCls = TclOOAllocClass(interp,
- AllocObject(interp, "object", (Namespace *)fPtr->ooNs, NULL));
+ AllocObject(interp, "object", (Namespace *) fPtr->ooNs, NULL));
// Corresponding TclOODecrRefCount in KillFoundation
AddRef(fPtr->objectCls->thisPtr);
@@ -512,7 +536,7 @@ InitClassSystemRoots(
Tcl_IncrRefCount(defNsName);
fPtr->classCls = TclOOAllocClass(interp,
- AllocObject(interp, "class", (Namespace *)fPtr->ooNs, NULL));
+ AllocObject(interp, "class", (Namespace *) fPtr->ooNs, NULL));
// Corresponding TclOODecrRefCount in KillFoundation
AddRef(fPtr->classCls->thisPtr);
@@ -554,37 +578,19 @@ InitClassSystemRoots(
/*
* ----------------------------------------------------------------------
*
- * DeletedDefineNamespace, DeletedObjdefNamespace, DeletedHelpersNamespace --
+ * DeletedHelpersNamespace --
*
- * Simple helpers used to clear fields of the foundation when they no
+ * Simple helper used to clear fields of the foundation when they no
* longer hold useful information.
*
* ----------------------------------------------------------------------
*/
static void
-DeletedDefineNamespace(
- void *clientData)
-{
- Foundation *fPtr = (Foundation *)clientData;
-
- fPtr->defineNs = NULL;
-}
-
-static void
-DeletedObjdefNamespace(
- void *clientData)
-{
- Foundation *fPtr = (Foundation *)clientData;
-
- fPtr->objdefNs = NULL;
-}
-
-static void
DeletedHelpersNamespace(
void *clientData)
{
- Foundation *fPtr = (Foundation *)clientData;
+ Foundation *fPtr = (Foundation *) clientData;
fPtr->helpersNs = NULL;
}
@@ -618,6 +624,12 @@ KillFoundation(
TclOODecrRefCount(fPtr->classCls->thisPtr);
Tcl_Free(fPtr);
+
+ /*
+ * Don't leave the interpreter field pointing to freed data.
+ */
+
+ ((Interp *) interp)->objectFoundation = NULL;
}
/*
@@ -657,7 +669,7 @@ AllocObject(
CommandTrace *tracePtr;
size_t creationEpoch;
- oPtr = (Object *)Tcl_Alloc(sizeof(Object));
+ oPtr = (Object *) Tcl_Alloc(sizeof(Object));
memset(oPtr, 0, sizeof(Object));
/*
@@ -684,7 +696,8 @@ AllocObject(
while (1) {
char objName[10 + TCL_INTEGER_SPACE];
- snprintf(objName, sizeof(objName), "::oo::Obj%" TCL_Z_MODIFIER "u", ++fPtr->tsdPtr->nsCount);
+ snprintf(objName, sizeof(objName), "::oo::Obj%" TCL_Z_MODIFIER "u",
+ ++fPtr->tsdPtr->nsCount);
oPtr->namespacePtr = Tcl_CreateNamespace(interp, objName, oPtr, NULL);
if (oPtr->namespacePtr != NULL) {
creationEpoch = fPtr->tsdPtr->nsCount;
@@ -753,13 +766,13 @@ AllocObject(
if (!nameStr) {
nameStr = oPtr->namespacePtr->name;
- nsPtr = (Namespace *)oPtr->namespacePtr;
+ nsPtr = (Namespace *) oPtr->namespacePtr;
if (nsPtr->parentPtr != NULL) {
nsPtr = nsPtr->parentPtr;
}
}
oPtr->command = TclCreateObjCommandInNs(interp, nameStr,
- (Tcl_Namespace *)nsPtr, TclOOPublicObjectCmd, oPtr, NULL);
+ (Tcl_Namespace *) nsPtr, TclOOPublicObjectCmd, oPtr, NULL);
/*
* Add the NRE command and trace directly. While this breaks a number of
@@ -768,7 +781,8 @@ AllocObject(
cmdPtr = (Command *) oPtr->command;
cmdPtr->nreProc = PublicNRObjectCmd;
- cmdPtr->tracePtr = tracePtr = (CommandTrace *)Tcl_Alloc(sizeof(CommandTrace));
+ cmdPtr->tracePtr = tracePtr = (CommandTrace *)
+ Tcl_Alloc(sizeof(CommandTrace));
tracePtr->traceProc = ObjectRenamedTrace;
tracePtr->clientData = oPtr;
tracePtr->flags = TCL_TRACE_RENAME|TCL_TRACE_DELETE;
@@ -822,7 +836,7 @@ MyDeleted(
void *clientData) /* Reference to the object whose [my] has been
* squelched. */
{
- Object *oPtr = (Object *)clientData;
+ Object *oPtr = (Object *) clientData;
oPtr->myCommand = NULL;
}
@@ -831,7 +845,7 @@ static void
MyClassDeleted(
void *clientData)
{
- Object *oPtr = (Object *)clientData;
+ Object *oPtr = (Object *) clientData;
oPtr->myclassCommand = NULL;
}
@@ -856,7 +870,7 @@ ObjectRenamedTrace(
TCL_UNUSED(const char *) /*newName*/,
int flags) /* Why was the object deleted? */
{
- Object *oPtr = (Object *)clientData;
+ Object *oPtr = (Object *) clientData;
/*
* If this is a rename and not a delete of the object, we just flush the
@@ -1166,7 +1180,7 @@ ObjectNamespaceDeleted(
void *clientData) /* Pointer to the class whose namespace is
* being deleted. */
{
- Object *oPtr = (Object *)clientData;
+ Object *oPtr = (Object *) clientData;
Foundation *fPtr = oPtr->fPtr;
FOREACH_HASH_DECLS;
Class *mixinPtr;
@@ -1248,14 +1262,14 @@ ObjectNamespaceDeleted(
* as well.
*/
- Tcl_DeleteCommandFromToken(oPtr->fPtr->interp, oPtr->command);
+ Tcl_DeleteCommandFromToken(interp, oPtr->command);
}
if (oPtr->myclassCommand) {
- Tcl_DeleteCommandFromToken(oPtr->fPtr->interp, oPtr->myclassCommand);
+ Tcl_DeleteCommandFromToken(interp, oPtr->myclassCommand);
}
if (oPtr->myCommand) {
- Tcl_DeleteCommandFromToken(oPtr->fPtr->interp, oPtr->myCommand);
+ Tcl_DeleteCommandFromToken(interp, oPtr->myCommand);
}
/*
@@ -1372,7 +1386,7 @@ ObjectNamespaceDeleted(
* Delete the object structure itself.
*/
- TclNsDecrRefCount((Namespace *)oPtr->namespacePtr);
+ TclNsDecrRefCount((Namespace *) oPtr->namespacePtr);
oPtr->namespacePtr = NULL;
TclOODecrRefCount(oPtr->selfCls->thisPtr);
oPtr->selfCls = NULL;
@@ -1477,10 +1491,12 @@ TclOOAddToInstances(
if (clsPtr->instances.num >= clsPtr->instances.size) {
clsPtr->instances.size += ALLOC_CHUNK;
if (clsPtr->instances.size == ALLOC_CHUNK) {
- clsPtr->instances.list = (Object **)Tcl_Alloc(sizeof(Object *) * ALLOC_CHUNK);
+ clsPtr->instances.list = (Object **)
+ Tcl_Alloc(sizeof(Object *) * ALLOC_CHUNK);
} else {
- clsPtr->instances.list = (Object **)Tcl_Realloc(clsPtr->instances.list,
- sizeof(Object *) * clsPtr->instances.size);
+ clsPtr->instances.list = (Object **)
+ Tcl_Realloc(clsPtr->instances.list,
+ sizeof(Object *) * clsPtr->instances.size);
}
}
clsPtr->instances.list[clsPtr->instances.num++] = oPtr;
@@ -1578,10 +1594,12 @@ TclOOAddToSubclasses(
if (superPtr->subclasses.num >= superPtr->subclasses.size) {
superPtr->subclasses.size += ALLOC_CHUNK;
if (superPtr->subclasses.size == ALLOC_CHUNK) {
- superPtr->subclasses.list = (Class **)Tcl_Alloc(sizeof(Class *) * ALLOC_CHUNK);
+ superPtr->subclasses.list = (Class **)
+ Tcl_Alloc(sizeof(Class *) * ALLOC_CHUNK);
} else {
- superPtr->subclasses.list = (Class **)Tcl_Realloc(superPtr->subclasses.list,
- sizeof(Class *) * superPtr->subclasses.size);
+ superPtr->subclasses.list = (Class **)
+ Tcl_Realloc(superPtr->subclasses.list,
+ sizeof(Class *) * superPtr->subclasses.size);
}
}
superPtr->subclasses.list[superPtr->subclasses.num++] = subPtr;
@@ -1644,10 +1662,12 @@ TclOOAddToMixinSubs(
if (superPtr->mixinSubs.num >= superPtr->mixinSubs.size) {
superPtr->mixinSubs.size += ALLOC_CHUNK;
if (superPtr->mixinSubs.size == ALLOC_CHUNK) {
- superPtr->mixinSubs.list = (Class **)Tcl_Alloc(sizeof(Class *) * ALLOC_CHUNK);
+ superPtr->mixinSubs.list = (Class **)
+ Tcl_Alloc(sizeof(Class *) * ALLOC_CHUNK);
} else {
- superPtr->mixinSubs.list = (Class **)Tcl_Realloc(superPtr->mixinSubs.list,
- sizeof(Class *) * superPtr->mixinSubs.size);
+ superPtr->mixinSubs.list = (Class **)
+ Tcl_Realloc(superPtr->mixinSubs.list,
+ sizeof(Class *) * superPtr->mixinSubs.size);
}
}
superPtr->mixinSubs.list[superPtr->mixinSubs.num++] = subPtr;
@@ -1692,7 +1712,7 @@ TclOOAllocClass(
* representation. */
{
Foundation *fPtr = GetFoundation(interp);
- Class *clsPtr = (Class *)Tcl_Alloc(sizeof(Class));
+ Class *clsPtr = (Class *) Tcl_Alloc(sizeof(Class));
memset(clsPtr, 0, sizeof(Class));
clsPtr->thisPtr = useThisObj;
@@ -1709,7 +1729,7 @@ TclOOAllocClass(
*/
clsPtr->superclasses.num = 1;
- clsPtr->superclasses.list = (Class **)Tcl_Alloc(sizeof(Class *));
+ clsPtr->superclasses.list = (Class **) Tcl_Alloc(sizeof(Class *));
clsPtr->superclasses.list[0] = fPtr->objectCls;
AddRef(fPtr->objectCls->thisPtr);
@@ -1937,10 +1957,10 @@ FinalizeAlloc(
Tcl_Interp *interp,
int result)
{
- CallContext *contextPtr = (CallContext *)data[0];
- Object *oPtr = (Object *)data[1];
- Tcl_InterpState state = (Tcl_InterpState)data[2];
- Tcl_Object *objectPtr = (Tcl_Object *)data[3];
+ CallContext *contextPtr = (CallContext *) data[0];
+ Object *oPtr = (Object *) data[1];
+ Tcl_InterpState state = (Tcl_InterpState) data[2];
+ Tcl_Object *objectPtr = (Tcl_Object *) data[3];
/*
* Ensure an error if the object was deleted in the constructor. Don't
@@ -2161,11 +2181,12 @@ Tcl_CopyObjectInstance(
TclOODecrRefCount(superPtr->thisPtr);
}
if (cls2Ptr->superclasses.num) {
- cls2Ptr->superclasses.list = (Class **)Tcl_Realloc(cls2Ptr->superclasses.list,
- sizeof(Class *) * clsPtr->superclasses.num);
+ cls2Ptr->superclasses.list = (Class **)
+ Tcl_Realloc(cls2Ptr->superclasses.list,
+ sizeof(Class *) * clsPtr->superclasses.num);
} else {
- cls2Ptr->superclasses.list =
- (Class **)Tcl_Alloc(sizeof(Class *) * clsPtr->superclasses.num);
+ cls2Ptr->superclasses.list = (Class **)
+ Tcl_Alloc(sizeof(Class *) * clsPtr->superclasses.num);
}
memcpy(cls2Ptr->superclasses.list, clsPtr->superclasses.list,
sizeof(Class *) * clsPtr->superclasses.num);
@@ -2359,7 +2380,7 @@ CloneClassMethod(
Method *m2Ptr;
if (mPtr->typePtr == NULL) {
- m2Ptr = (Method *) TclNewMethod(interp, (Tcl_Class) clsPtr,
+ m2Ptr = (Method *) TclNewMethod((Tcl_Class) clsPtr,
namePtr, mPtr->flags & PUBLIC_METHOD, NULL, NULL);
} else if (mPtr->typePtr->cloneProc) {
void *newClientData;
@@ -2368,11 +2389,11 @@ CloneClassMethod(
&newClientData) != TCL_OK) {
return TCL_ERROR;
}
- m2Ptr = (Method *) TclNewMethod(interp, (Tcl_Class) clsPtr,
+ m2Ptr = (Method *) TclNewMethod((Tcl_Class) clsPtr,
namePtr, mPtr->flags & PUBLIC_METHOD, mPtr->typePtr,
newClientData);
} else {
- m2Ptr = (Method *) TclNewMethod(interp, (Tcl_Class) clsPtr,
+ m2Ptr = (Method *) TclNewMethod((Tcl_Class) clsPtr,
namePtr, mPtr->flags & PUBLIC_METHOD, mPtr->typePtr,
mPtr->clientData);
}
@@ -2459,7 +2480,8 @@ Tcl_ClassSetMetadata(
if (metadata == NULL) {
return;
}
- clsPtr->metadataPtr = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable));
+ clsPtr->metadataPtr = (Tcl_HashTable *)
+ Tcl_Alloc(sizeof(Tcl_HashTable));
Tcl_InitHashTable(clsPtr->metadataPtr, TCL_ONE_WORD_KEYS);
}
@@ -2539,7 +2561,7 @@ Tcl_ObjectSetMetadata(
if (metadata == NULL) {
return;
}
- oPtr->metadataPtr = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable));
+ oPtr->metadataPtr = (Tcl_HashTable *) Tcl_Alloc(sizeof(Tcl_HashTable));
Tcl_InitHashTable(oPtr->metadataPtr, TCL_ONE_WORD_KEYS);
}
@@ -2588,7 +2610,7 @@ TclOOPublicObjectCmd(
int objc,
Tcl_Obj *const *objv)
{
- return Tcl_NRCallObjProc(interp, PublicNRObjectCmd, clientData,objc,objv);
+ return Tcl_NRCallObjProc(interp, PublicNRObjectCmd, clientData, objc, objv);
}
static int
@@ -2598,8 +2620,8 @@ PublicNRObjectCmd(
int objc,
Tcl_Obj *const *objv)
{
- return TclOOObjectCmdCore((Object *)clientData, interp, objc, objv, PUBLIC_METHOD,
- NULL);
+ return TclOOObjectCmdCore((Object *) clientData, interp, objc, objv,
+ PUBLIC_METHOD, NULL);
}
int
@@ -2609,7 +2631,7 @@ TclOOPrivateObjectCmd(
int objc,
Tcl_Obj *const *objv)
{
- return Tcl_NRCallObjProc(interp, PrivateNRObjectCmd,clientData,objc,objv);
+ return Tcl_NRCallObjProc(interp, PrivateNRObjectCmd, clientData, objc, objv);
}
static int
@@ -2619,7 +2641,7 @@ PrivateNRObjectCmd(
int objc,
Tcl_Obj *const *objv)
{
- return TclOOObjectCmdCore((Object *)clientData, interp, objc, objv, 0, NULL);
+ return TclOOObjectCmdCore((Object *) clientData, interp, objc, objv, 0, NULL);
}
int
@@ -2680,7 +2702,7 @@ MyClassNRObjCmd(
int objc,
Tcl_Obj *const *objv)
{
- Object *oPtr = (Object *)clientData;
+ Object *oPtr = (Object *) clientData;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "methodName ?arg ...?");
@@ -2739,7 +2761,7 @@ TclOOObjectCmdCore(
*/
if (framePtr->isProcCallFrame & FRAME_IS_METHOD) {
- CallContext *callerContextPtr = (CallContext *)framePtr->clientData;
+ CallContext *callerContextPtr = (CallContext *) framePtr->clientData;
Method *callerMethodPtr =
callerContextPtr->callPtr->chain[callerContextPtr->index].mPtr;
@@ -2816,8 +2838,7 @@ TclOOObjectCmdCore(
if (startCls != NULL) {
for (; contextPtr->index < contextPtr->callPtr->numChain;
contextPtr->index++) {
- struct MInvoke *miPtr =
- &contextPtr->callPtr->chain[contextPtr->index];
+ MInvoke *miPtr = &contextPtr->callPtr->chain[contextPtr->index];
if (miPtr->isFilter) {
continue;
@@ -2856,7 +2877,7 @@ FinalizeObjectCall(
* structure.
*/
- TclOODeleteContext((CallContext *)data[0]);
+ TclOODeleteContext((CallContext *) data[0]);
return result;
}
@@ -3012,7 +3033,7 @@ FinalizeNext(
TCL_UNUSED(Tcl_Interp *),
int result)
{
- CallContext *contextPtr = (CallContext *)data[0];
+ CallContext *contextPtr = (CallContext *) data[0];
/*
* Restore the call chain context index as we've finished the inner invoke
@@ -3053,7 +3074,7 @@ Tcl_GetObjectFromObj(
goto notAnObject;
}
}
- return (Tcl_Object)cmdPtr->objClientData;
+ return (Tcl_Object) cmdPtr->objClientData;
notAnObject:
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
@@ -3169,49 +3190,49 @@ Tcl_Object
Tcl_ObjectContextObject(
Tcl_ObjectContext context)
{
- return (Tcl_Object) ((CallContext *)context)->oPtr;
+ return (Tcl_Object) ((CallContext *) context)->oPtr;
}
Tcl_Size
Tcl_ObjectContextSkippedArgs(
Tcl_ObjectContext context)
{
- return ((CallContext *)context)->skip;
+ return ((CallContext *) context)->skip;
}
Tcl_Namespace *
Tcl_GetObjectNamespace(
Tcl_Object object)
{
- return ((Object *)object)->namespacePtr;
+ return ((Object *) object)->namespacePtr;
}
Tcl_Command
Tcl_GetObjectCommand(
Tcl_Object object)
{
- return ((Object *)object)->command;
+ return ((Object *) object)->command;
}
Tcl_Class
Tcl_GetObjectAsClass(
Tcl_Object object)
{
- return (Tcl_Class) ((Object *)object)->classPtr;
+ return (Tcl_Class) ((Object *) object)->classPtr;
}
int
Tcl_ObjectDeleted(
Tcl_Object object)
{
- return ((Object *)object)->command == NULL;
+ return ((Object *) object)->command == NULL;
}
Tcl_Object
Tcl_GetClassAsObject(
Tcl_Class clazz)
{
- return (Tcl_Object) ((Class *)clazz)->thisPtr;
+ return (Tcl_Object) ((Class *) clazz)->thisPtr;
}
Tcl_ObjectMapMethodNameProc *
diff --git a/generic/tclOO.h b/generic/tclOO.h
index 7cda876..7adf559 100644
--- a/generic/tclOO.h
+++ b/generic/tclOO.h
@@ -81,7 +81,7 @@ typedef int (Tcl_ObjectMapMethodNameProc)(Tcl_Interp *interp,
* how to create a clone of it (when the object or class is copied).
*/
-typedef struct {
+typedef struct Tcl_MethodType {
int version; /* Structure version field. Always to be equal
* to TCL_OO_METHOD_VERSION_(1|CURRENT) in
* declarations. */
@@ -99,7 +99,7 @@ typedef struct {
} Tcl_MethodType;
#if TCL_MAJOR_VERSION > 8
-typedef struct {
+typedef struct Tcl_MethodType2 {
int version; /* Structure version field. Always to be equal
* to TCL_OO_METHOD_VERSION_2 in
* declarations. */
@@ -124,19 +124,21 @@ typedef struct {
* This allows new versions of the structure to be introduced without breaking
* binary compatibility.
*/
-
-#define TCL_OO_METHOD_VERSION_1 1
-#define TCL_OO_METHOD_VERSION_2 2
-#define TCL_OO_METHOD_VERSION_CURRENT 1
+enum TclOOMethodVersion {
+ TCL_OO_METHOD_VERSION_1 = 1,
+ TCL_OO_METHOD_VERSION_2 = 2
+};
+#define TCL_OO_METHOD_VERSION_CURRENT TCL_OO_METHOD_VERSION_1
/*
* Visibility constants for the flags parameter to Tcl_NewMethod and
* Tcl_NewInstanceMethod.
*/
-
-#define TCL_OO_METHOD_PUBLIC 1
-#define TCL_OO_METHOD_UNEXPORTED 0
-#define TCL_OO_METHOD_PRIVATE 0x20
+enum TclOOMethodVisibilityFlags {
+ TCL_OO_METHOD_PUBLIC = 1,
+ TCL_OO_METHOD_UNEXPORTED = 0,
+ TCL_OO_METHOD_PRIVATE = 0x20
+};
/*
* The type of some object (or class) metadata. This describes how to delete
@@ -144,7 +146,7 @@ typedef struct {
* clone of it (when the object or class is copied).
*/
-typedef struct {
+typedef struct Tcl_ObjectMetadataType {
int version; /* Structure version field. Always to be equal
* to TCL_OO_METADATA_VERSION_CURRENT in
* declarations. */
@@ -163,7 +165,10 @@ typedef struct {
* without breaking binary compatibility.
*/
-#define TCL_OO_METADATA_VERSION_CURRENT 1
+enum TclOOMetadataVersion {
+ TCL_OO_METADATA_VERSION_1 = 1
+};
+#define TCL_OO_METADATA_VERSION_CURRENT TCL_OO_METADATA_VERSION_1
/*
* Include all the public API, generated from tclOO.decls.
diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c
index 2f2583d..cfb7cb5 100644
--- a/generic/tclOOBasic.c
+++ b/generic/tclOOBasic.c
@@ -68,7 +68,7 @@ FinalizeConstruction(
Tcl_Interp *interp,
int result)
{
- Object *oPtr = (Object *)data[0];
+ Object *oPtr = (Object *) data[0];
if (result != TCL_OK) {
return result;
@@ -99,11 +99,11 @@ TclOO_Class_Constructor(
Tcl_Obj **invoke, *nameObj;
size_t skip = Tcl_ObjectContextSkippedArgs(context);
- if ((size_t)objc > skip + 1) {
+ if ((size_t) objc > skip + 1) {
Tcl_WrongNumArgs(interp, skip, objv,
"?definitionScript?");
return TCL_ERROR;
- } else if ((size_t)objc == skip) {
+ } else if ((size_t) objc == skip) {
return TCL_OK;
}
@@ -112,17 +112,17 @@ TclOO_Class_Constructor(
* here (and the class definition delegate doesn't run any constructors).
*/
- nameObj = Tcl_NewStringObj(oPtr->namespacePtr->fullName, -1);
- Tcl_AppendToObj(nameObj, ":: oo ::delegate", -1);
+ nameObj = Tcl_ObjPrintf("%s:: oo ::delegate",
+ oPtr->namespacePtr->fullName);
Tcl_NewObjectInstance(interp, (Tcl_Class) oPtr->fPtr->classCls,
TclGetString(nameObj), NULL, -1, NULL, -1);
- Tcl_DecrRefCount(nameObj);
+ Tcl_BounceRefCount(nameObj);
/*
* Delegate to [oo::define] to do the work.
*/
- invoke = (Tcl_Obj **)Tcl_Alloc(3 * sizeof(Tcl_Obj *));
+ invoke = (Tcl_Obj **) TclStackAlloc(interp, 3 * sizeof(Tcl_Obj *));
invoke[0] = oPtr->fPtr->defineName;
invoke[1] = TclOOObjectName(interp, oPtr);
invoke[2] = objv[objc-1];
@@ -152,8 +152,8 @@ DecrRefsPostClassConstructor(
Tcl_Interp *interp,
int result)
{
- Tcl_Obj **invoke = (Tcl_Obj **)data[0];
- Object *oPtr = (Object *)data[1];
+ Tcl_Obj **invoke = (Tcl_Obj **) data[0];
+ Object *oPtr = (Object *) data[1];
Tcl_InterpState saved;
int code;
@@ -168,7 +168,7 @@ DecrRefsPostClassConstructor(
code = Tcl_EvalObjv(interp, 2, invoke, 0);
TclDecrRefCount(invoke[0]);
TclDecrRefCount(invoke[1]);
- Tcl_Free(invoke);
+ TclStackFree(interp, invoke);
if (code != TCL_OK) {
Tcl_DiscardInterpState(saved);
return code;
@@ -380,7 +380,7 @@ TclOO_Object_Destroy(
Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
CallContext *contextPtr;
- if (objc != (int)Tcl_ObjectContextSkippedArgs(context)) {
+ if (objc != (int) Tcl_ObjectContextSkippedArgs(context)) {
Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
NULL);
return TCL_ERROR;
@@ -410,7 +410,7 @@ AfterNRDestructor(
Tcl_Interp *interp,
int result)
{
- CallContext *contextPtr = (CallContext *)data[0];
+ CallContext *contextPtr = (CallContext *) data[0];
if (contextPtr->oPtr->command) {
Tcl_DeleteCommandFromToken(interp, contextPtr->oPtr->command);
@@ -445,7 +445,7 @@ TclOO_Object_Eval(
Tcl_Obj *scriptPtr;
CmdFrame *invoker;
- if ((size_t)objc < skip + 1) {
+ if ((size_t) objc < skip + 1) {
Tcl_WrongNumArgs(interp, skip, objv, "arg ?arg ...?");
return TCL_ERROR;
}
@@ -474,7 +474,7 @@ TclOO_Object_Eval(
* object when it decrements its refcount after eval'ing it.
*/
- if ((size_t)objc != skip+1) {
+ if ((size_t) objc != skip+1) {
scriptPtr = Tcl_ConcatObj(objc-skip, objv+skip);
invoker = NULL;
} else {
@@ -498,7 +498,7 @@ FinalizeEval(
int result)
{
if (result == TCL_ERROR) {
- Object *oPtr = (Object *)data[0];
+ Object *oPtr = (Object *) data[0];
const char *namePtr;
if (oPtr) {
@@ -556,7 +556,7 @@ TclOO_Object_Unknown(
* name without an error).
*/
- if ((size_t)objc < skip+1) {
+ if ((size_t) objc < skip + 1) {
Tcl_WrongNumArgs(interp, skip, objv, "method ?arg ...?");
return TCL_ERROR;
}
@@ -567,7 +567,7 @@ TclOO_Object_Unknown(
*/
if (framePtr->isProcCallFrame & FRAME_IS_METHOD) {
- CallContext *callerContext = (CallContext *)framePtr->clientData;
+ CallContext *callerContext = (CallContext *) framePtr->clientData;
Method *mPtr = callerContext->callPtr->chain[
callerContext->index].mPtr;
@@ -621,7 +621,7 @@ TclOO_Object_Unknown(
Tcl_AppendToObj(errorMsg, " or ", -1);
}
Tcl_AppendToObj(errorMsg, methodNames[i], -1);
- Tcl_Free((void *)methodNames);
+ Tcl_Free((void *) methodNames);
Tcl_SetObjResult(interp, errorMsg);
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
TclGetString(objv[skip]), (char *)NULL);
@@ -777,7 +777,7 @@ LookupObjectVar(
if (framePtr->isProcCallFrame & FRAME_IS_METHOD) {
Object *oPtr = (Object *) object;
- CallContext *callerContext = (CallContext *)framePtr->clientData;
+ CallContext *callerContext = (CallContext *) framePtr->clientData;
Method *mPtr = callerContext->callPtr->chain[
callerContext->index].mPtr;
PrivateVariableMapping *pvPtr;
@@ -818,9 +818,8 @@ LookupObjectVar(
}
// The namespace isn't the global one; necessarily true for any object!
- varNamePtr = Tcl_NewStringObj(namespacePtr->fullName, -1);
- Tcl_AppendToObj(varNamePtr, "::", 2);
- Tcl_AppendObjToObj(varNamePtr, varName);
+ varNamePtr = Tcl_ObjPrintf("%s::%s",
+ namespacePtr->fullName, TclGetString(varName));
}
Tcl_IncrRefCount(varNamePtr);
Tcl_Var var = (Tcl_Var) TclObjLookupVar(interp, varNamePtr, NULL,
@@ -930,7 +929,7 @@ TclOONextObjCmd(
Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", (char *)NULL);
return TCL_ERROR;
}
- context = (Tcl_ObjectContext)framePtr->clientData;
+ context = (Tcl_ObjectContext) framePtr->clientData;
/*
* Invoke the (advanced) method call context in the caller context. Note
@@ -970,7 +969,7 @@ TclOONextToObjCmd(
Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", (char *)NULL);
return TCL_ERROR;
}
- contextPtr = (CallContext *)framePtr->clientData;
+ contextPtr = (CallContext *) framePtr->clientData;
/*
* Sanity check the arguments; we need the first one to refer to a class.
@@ -984,7 +983,7 @@ TclOONextToObjCmd(
if (object == NULL) {
return TCL_ERROR;
}
- classPtr = ((Object *)object)->classPtr;
+ classPtr = ((Object *) object)->classPtr;
if (classPtr == NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"\"%s\" is not a class", TclGetString(objv[1])));
@@ -999,7 +998,7 @@ TclOONextToObjCmd(
*/
for (i=contextPtr->index+1 ; i<contextPtr->callPtr->numChain ; i++) {
- struct MInvoke *miPtr = contextPtr->callPtr->chain + i;
+ MInvoke *miPtr = &contextPtr->callPtr->chain[i];
if (!miPtr->isFilter && miPtr->mPtr->declaringClassPtr == classPtr) {
/*
@@ -1030,7 +1029,7 @@ TclOONextToObjCmd(
}
for (i=contextPtr->index ; i != TCL_INDEX_NONE ; i--) {
- struct MInvoke *miPtr = contextPtr->callPtr->chain + i;
+ MInvoke *miPtr = &contextPtr->callPtr->chain[i];
if (!miPtr->isFilter && miPtr->mPtr->declaringClassPtr == classPtr) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
@@ -1055,9 +1054,9 @@ NextRestoreFrame(
int result)
{
Interp *iPtr = (Interp *) interp;
- CallContext *contextPtr = (CallContext *)data[1];
+ CallContext *contextPtr = (CallContext *) data[1];
- iPtr->varFramePtr = (CallFrame *)data[0];
+ iPtr->varFramePtr = (CallFrame *) data[0];
if (contextPtr != NULL) {
contextPtr->index = PTR2UINT(data[2]);
}
@@ -1110,7 +1109,7 @@ TclOOSelfObjCmd(
return TCL_ERROR;
}
- contextPtr = (CallContext*)framePtr->clientData;
+ contextPtr = (CallContext *) framePtr->clientData;
/*
* Now we do "conventional" argument parsing for a while. Note that no
@@ -1165,7 +1164,7 @@ TclOOSelfObjCmd(
Tcl_SetErrorCode(interp, "TCL", "OO", "UNMATCHED_CONTEXT", (char *)NULL);
return TCL_ERROR;
} else {
- struct MInvoke *miPtr = &CurrentlyInvoked(contextPtr);
+ MInvoke *miPtr = &CurrentlyInvoked(contextPtr);
Object *oPtr;
const char *type;
@@ -1191,7 +1190,8 @@ TclOOSelfObjCmd(
Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", (char *)NULL);
return TCL_ERROR;
} else {
- CallContext *callerPtr = (CallContext *)framePtr->callerVarPtr->clientData;
+ CallContext *callerPtr = (CallContext *)
+ framePtr->callerVarPtr->clientData;
Method *mPtr = callerPtr->callPtr->chain[callerPtr->index].mPtr;
Object *declarerPtr;
@@ -1820,16 +1820,14 @@ TclOOImplementClassProperty(
Tcl_Obj *methodName = Tcl_ObjPrintf(
"<ReadProp-%s>", TclGetString(propNamePtr));
Tcl_IncrRefCount(propNamePtr); // Paired with DetailsDeleter
- TclNewMethod(
- NULL, targetClass, methodName, 0, &GetterType, propNamePtr);
+ TclNewMethod(targetClass, methodName, 0, &GetterType, propNamePtr);
Tcl_BounceRefCount(methodName);
}
if (installSetter) {
Tcl_Obj *methodName = Tcl_ObjPrintf(
"<WriteProp-%s>", TclGetString(propNamePtr));
Tcl_IncrRefCount(propNamePtr); // Paired with DetailsDeleter
- TclNewMethod(
- NULL, targetClass, methodName, 0, &SetterType, propNamePtr);
+ TclNewMethod(targetClass, methodName, 0, &SetterType, propNamePtr);
Tcl_BounceRefCount(methodName);
}
}
diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c
index e1cf778..27d8233 100644
--- a/generic/tclOOCall.c
+++ b/generic/tclOOCall.c
@@ -19,30 +19,29 @@
#include <assert.h>
/*
- * Structure containing a CallContext and any other values needed only during
- * the construction of the CallContext.
+ * Structure containing a CallChain and any other values needed only during
+ * the construction of the CallChain.
*/
-
-struct ChainBuilder {
+typedef struct ChainBuilder {
CallChain *callChainPtr; /* The call chain being built. */
size_t filterLength; /* Number of entries in the call chain that
* are due to processing filters and not the
* main call chain. */
Object *oPtr; /* The object that we are building the chain
* for. */
-};
+} ChainBuilder;
/*
* Structures used for traversing the class hierarchy to find out where
* definitions are supposed to be done.
*/
-typedef struct {
+typedef struct DefineEntry {
Class *definerCls;
Tcl_Obj *namespaceName;
} DefineEntry;
-typedef struct {
+typedef struct DefineChain {
DefineEntry *list;
int num;
int size;
@@ -51,15 +50,17 @@ typedef struct {
/*
* Extra flags used for call chain management.
*/
+enum CallChainFlags {
+ DEFINITE_PROTECTED = 0x100000,
+ DEFINITE_PUBLIC = 0x200000,
+ KNOWN_STATE = (DEFINITE_PROTECTED | DEFINITE_PUBLIC),
+ SPECIAL = (CONSTRUCTOR | DESTRUCTOR | FORCE_UNKNOWN),
+ BUILDING_MIXINS = 0x400000,
+ TRAVERSED_MIXIN = 0x800000,
+ OBJECT_MIXIN = 0x1000000,
+ DEFINE_FOR_CLASS = 0x2000000
+};
-#define DEFINITE_PROTECTED 0x100000
-#define DEFINITE_PUBLIC 0x200000
-#define KNOWN_STATE (DEFINITE_PROTECTED | DEFINITE_PUBLIC)
-#define SPECIAL (CONSTRUCTOR | DESTRUCTOR | FORCE_UNKNOWN)
-#define BUILDING_MIXINS 0x400000
-#define TRAVERSED_MIXIN 0x800000
-#define OBJECT_MIXIN 0x1000000
-#define DEFINE_FOR_CLASS 0x2000000
#define MIXIN_CONSISTENT(flags) \
(((flags) & OBJECT_MIXIN) || \
!((flags) & BUILDING_MIXINS) == !((flags) & TRAVERSED_MIXIN))
@@ -87,11 +88,19 @@ typedef struct {
(((flags) & TRUE_PRIVATE_METHOD) != 0)
/*
+ * Name the bits used in the names table values.
+ */
+enum NameTableValues {
+ IN_LIST = 1, /* Seen an implementation. */
+ NO_IMPLEMENTATION = 2 /* Seen, but not implemented yet. */
+};
+
+/*
* Function declarations for things defined in this file.
*/
static void AddClassFiltersToCallContext(Object *const oPtr,
- Class *clsPtr, struct ChainBuilder *const cbPtr,
+ Class *clsPtr, ChainBuilder *const cbPtr,
Tcl_HashTable *const doneFilters, int flags);
static void AddClassMethodNames(Class *clsPtr, int flags,
Tcl_HashTable *const namesPtr,
@@ -100,12 +109,12 @@ static inline void AddDefinitionNamespaceToChain(Class *const definerCls,
Tcl_Obj *const namespaceName,
DefineChain *const definePtr, int flags);
static inline void AddMethodToCallChain(Method *const mPtr,
- struct ChainBuilder *const cbPtr,
+ ChainBuilder *const cbPtr,
Tcl_HashTable *const doneFilters,
Class *const filterDecl, int flags);
static inline int AddInstancePrivateToCallContext(Object *const oPtr,
Tcl_Obj *const methodNameObj,
- struct ChainBuilder *const cbPtr, int flags);
+ ChainBuilder *const cbPtr, int flags);
static inline void AddStandardMethodName(int flags, Tcl_Obj *namePtr,
Method *mPtr, Tcl_HashTable *namesPtr);
static inline void AddPrivateMethodNames(Tcl_HashTable *methodsTablePtr,
@@ -113,18 +122,18 @@ static inline void AddPrivateMethodNames(Tcl_HashTable *methodsTablePtr,
static inline int AddSimpleChainToCallContext(Object *const oPtr,
Class *const contextCls,
Tcl_Obj *const methodNameObj,
- struct ChainBuilder *const cbPtr,
+ ChainBuilder *const cbPtr,
Tcl_HashTable *const doneFilters, int flags,
Class *const filterDecl);
static int AddPrivatesFromClassChainToCallContext(Class *classPtr,
Class *const contextCls,
Tcl_Obj *const methodNameObj,
- struct ChainBuilder *const cbPtr,
+ ChainBuilder *const cbPtr,
Tcl_HashTable *const doneFilters, int flags,
Class *const filterDecl);
static int AddSimpleClassChainToCallContext(Class *classPtr,
Tcl_Obj *const methodNameObj,
- struct ChainBuilder *const cbPtr,
+ ChainBuilder *const cbPtr,
Tcl_HashTable *const doneFilters, int flags,
Class *const filterDecl);
static void AddSimpleClassDefineNamespaces(Class *classPtr,
@@ -281,16 +290,16 @@ DupMethodNameRep(
Tcl_Obj *srcPtr,
Tcl_Obj *dstPtr)
{
- StashCallChain(dstPtr,
- (CallChain *)TclFetchInternalRep(srcPtr, &methodNameType)->twoPtrValue.ptr1);
+ StashCallChain(dstPtr, (CallChain *)
+ TclFetchInternalRep(srcPtr, &methodNameType)->twoPtrValue.ptr1);
}
static void
FreeMethodNameRep(
Tcl_Obj *objPtr)
{
- TclOODeleteChain(
- (CallChain *)TclFetchInternalRep(objPtr, &methodNameType)->twoPtrValue.ptr1);
+ TclOODeleteChain((CallChain *)
+ TclFetchInternalRep(objPtr, &methodNameType)->twoPtrValue.ptr1);
}
/*
@@ -316,7 +325,7 @@ TclOOInvokeContext(
int objc, /* The number of arguments. */
Tcl_Obj *const objv[]) /* The arguments as actually seen. */
{
- CallContext *const contextPtr = (CallContext *)clientData;
+ CallContext *const contextPtr = (CallContext *) clientData;
Method *const mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr;
const int isFilter =
contextPtr->callPtr->chain[contextPtr->index].isFilter;
@@ -375,7 +384,7 @@ TclOOInvokeContext(
return (mPtr->typePtr->callProc)(mPtr->clientData, interp,
(Tcl_ObjectContext) contextPtr, objc, objv);
}
- return ((Tcl_MethodCallProc2 *)(void *)(mPtr->typePtr->callProc))(mPtr->clientData, interp,
+ return (mPtr->type2Ptr->callProc)(mPtr->clientData, interp,
(Tcl_ObjectContext) contextPtr, objc, objv);
}
@@ -385,7 +394,7 @@ SetFilterFlags(
TCL_UNUSED(Tcl_Interp *),
int result)
{
- CallContext *contextPtr = (CallContext *)data[0];
+ CallContext *contextPtr = (CallContext *) data[0];
contextPtr->oPtr->flags |= FILTER_HANDLING;
return result;
@@ -397,7 +406,7 @@ ResetFilterFlags(
TCL_UNUSED(Tcl_Interp *),
int result)
{
- CallContext *contextPtr = (CallContext *)data[0];
+ CallContext *contextPtr = (CallContext *) data[0];
contextPtr->oPtr->flags &= ~FILTER_HANDLING;
return result;
@@ -409,7 +418,7 @@ FinalizeMethodRefs(
TCL_UNUSED(Tcl_Interp *),
int result)
{
- CallContext *contextPtr = (CallContext *)data[0];
+ CallContext *contextPtr = (CallContext *) data[0];
Tcl_Size i;
for (i = 0 ; i < contextPtr->callPtr->numChain ; i++) {
@@ -460,12 +469,6 @@ TclOOGetSortedMethodList(
Tcl_InitHashTable(&examinedClasses, TCL_ONE_WORD_KEYS);
/*
- * Name the bits used in the names table values.
- */
-#define IN_LIST 1
-#define NO_IMPLEMENTATION 2
-
- /*
* Process method names due to the object.
*/
@@ -619,7 +622,7 @@ SortMethodNames(
* sorted when it is long enough to matter.
*/
- strings = (const char **)Tcl_Alloc(sizeof(char *) * namesPtr->numEntries);
+ strings = (const char **) Tcl_Alloc(sizeof(char *) * namesPtr->numEntries);
FOREACH_HASH(namePtr, isWanted, namesPtr) {
if (!WANT_PUBLIC(flags) || (PTR2INT(isWanted) & IN_LIST)) {
if (PTR2INT(isWanted) & NO_IMPLEMENTATION) {
@@ -641,7 +644,7 @@ SortMethodNames(
}
*stringsPtr = strings;
} else {
- Tcl_Free((void *)strings);
+ Tcl_Free((void *) strings);
*stringsPtr = NULL;
}
return i;
@@ -808,9 +811,6 @@ AddStandardMethodName(
}
}
}
-
-#undef IN_LIST
-#undef NO_IMPLEMENTATION
/*
* ----------------------------------------------------------------------
@@ -830,8 +830,7 @@ AddInstancePrivateToCallContext(
Object *const oPtr, /* Object to add call chain entries for. */
Tcl_Obj *const methodName, /* Name of method to add the call chain
* entries for. */
- struct ChainBuilder *const cbPtr,
- /* Where to add the call chain entries. */
+ ChainBuilder *const cbPtr, /* Where to add the call chain entries. */
int flags) /* What sort of call chain are we building. */
{
Tcl_HashEntry *hPtr;
@@ -841,7 +840,7 @@ AddInstancePrivateToCallContext(
if (oPtr->methodsPtr) {
hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, methodName);
if (hPtr != NULL) {
- mPtr = (Method *)Tcl_GetHashValue(hPtr);
+ mPtr = (Method *) Tcl_GetHashValue(hPtr);
if (IS_PRIVATE(mPtr)) {
AddMethodToCallChain(mPtr, cbPtr, NULL, NULL, flags);
donePrivate = 1;
@@ -873,8 +872,7 @@ AddSimpleChainToCallContext(
Tcl_Obj *const methodNameObj,
/* Name of method to add the call chain
* entries for. */
- struct ChainBuilder *const cbPtr,
- /* Where to add the call chain entries. */
+ ChainBuilder *const cbPtr, /* Where to add the call chain entries. */
Tcl_HashTable *const doneFilters,
/* Where to record what call chain entries
* have been processed. */
@@ -892,7 +890,7 @@ AddSimpleChainToCallContext(
hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, methodNameObj);
if (hPtr != NULL) {
- mPtr = (Method *)Tcl_GetHashValue(hPtr);
+ mPtr = (Method *) Tcl_GetHashValue(hPtr);
if (!IS_PRIVATE(mPtr)) {
if (WANT_PUBLIC(flags)) {
if (!IS_PUBLIC(mPtr)) {
@@ -922,7 +920,7 @@ AddSimpleChainToCallContext(
if (oPtr->methodsPtr && !blockedUnexported) {
hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, methodNameObj);
if (hPtr != NULL) {
- mPtr = (Method *)Tcl_GetHashValue(hPtr);
+ mPtr = (Method *) Tcl_GetHashValue(hPtr);
if (!IS_PRIVATE(mPtr)) {
AddMethodToCallChain(mPtr, cbPtr, doneFilters, filterDecl,
flags);
@@ -960,8 +958,7 @@ static inline void
AddMethodToCallChain(
Method *const mPtr, /* Actual method implementation to add to call
* chain (or NULL, a no-op). */
- struct ChainBuilder *const cbPtr,
- /* The call chain to add the method
+ ChainBuilder *const cbPtr, /* The call chain to add the method
* implementation to. */
Tcl_HashTable *const doneFilters,
/* Where to record what filters have been
@@ -1046,13 +1043,13 @@ AddMethodToCallChain(
*/
if (callPtr->numChain == CALL_CHAIN_STATIC_SIZE) {
- callPtr->chain =
- (struct MInvoke *)Tcl_Alloc(sizeof(struct MInvoke) * (callPtr->numChain + 1));
+ callPtr->chain = (MInvoke *)
+ Tcl_Alloc(sizeof(MInvoke) * (callPtr->numChain + 1));
memcpy(callPtr->chain, callPtr->staticChain,
- sizeof(struct MInvoke) * callPtr->numChain);
+ sizeof(MInvoke) * callPtr->numChain);
} else if (callPtr->numChain > CALL_CHAIN_STATIC_SIZE) {
- callPtr->chain = (struct MInvoke *)Tcl_Realloc(callPtr->chain,
- sizeof(struct MInvoke) * (callPtr->numChain + 1));
+ callPtr->chain = (MInvoke *) Tcl_Realloc(callPtr->chain,
+ sizeof(MInvoke) * (callPtr->numChain + 1));
}
callPtr->chain[i].mPtr = mPtr;
callPtr->chain[i].isFilter = (doneFilters != NULL);
@@ -1178,7 +1175,7 @@ TclOOGetCallContext(
{
CallContext *contextPtr;
CallChain *callPtr;
- struct ChainBuilder cb;
+ ChainBuilder cb;
Tcl_Size i, count;
int doFilters, donePrivate = 0;
Tcl_HashEntry *hPtr;
@@ -1224,7 +1221,7 @@ TclOOGetCallContext(
const int reuseMask = (WANT_PUBLIC(flags) ? ~0 : ~PUBLIC_METHOD);
if ((irPtr = TclFetchInternalRep(cacheInThisObj, &methodNameType))) {
- callPtr = (CallChain *)irPtr->twoPtrValue.ptr1;
+ callPtr = (CallChain *) irPtr->twoPtrValue.ptr1;
if (IsStillValid(callPtr, oPtr, flags, reuseMask)) {
callPtr->refCount++;
goto returnContext;
@@ -1257,7 +1254,7 @@ TclOOGetCallContext(
}
if (hPtr != NULL && Tcl_GetHashValue(hPtr) != NULL) {
- callPtr = (CallChain *)Tcl_GetHashValue(hPtr);
+ callPtr = (CallChain *) Tcl_GetHashValue(hPtr);
if (IsStillValid(callPtr, oPtr, flags, reuseMask)) {
callPtr->refCount++;
goto returnContext;
@@ -1269,7 +1266,7 @@ TclOOGetCallContext(
doFilters = 1;
}
- callPtr = (CallChain *)Tcl_Alloc(sizeof(CallChain));
+ callPtr = (CallChain *) Tcl_Alloc(sizeof(CallChain));
InitCallChain(callPtr, oPtr, flags);
cb.callChainPtr = callPtr;
@@ -1374,8 +1371,8 @@ TclOOGetCallContext(
int isNew;
if (oPtr->flags & USE_CLASS_CACHE) {
if (oPtr->selfCls->classChainCache == NULL) {
- oPtr->selfCls->classChainCache =
- (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable));
+ oPtr->selfCls->classChainCache = (Tcl_HashTable *)
+ Tcl_Alloc(sizeof(Tcl_HashTable));
Tcl_InitObjHashTable(oPtr->selfCls->classChainCache);
}
@@ -1383,7 +1380,8 @@ TclOOGetCallContext(
methodNameObj, &isNew);
} else {
if (oPtr->chainCache == NULL) {
- oPtr->chainCache = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable));
+ oPtr->chainCache = (Tcl_HashTable *)
+ Tcl_Alloc(sizeof(Tcl_HashTable));
Tcl_InitObjHashTable(oPtr->chainCache);
}
@@ -1409,7 +1407,8 @@ TclOOGetCallContext(
}
returnContext:
- contextPtr = (CallContext *)TclStackAlloc(oPtr->fPtr->interp, sizeof(CallContext));
+ contextPtr = (CallContext *)
+ TclStackAlloc(oPtr->fPtr->interp, sizeof(CallContext));
contextPtr->oPtr = oPtr;
/*
@@ -1447,7 +1446,7 @@ TclOOGetStereotypeCallChain(
* FILTER_HANDLING are useful. */
{
CallChain *callPtr;
- struct ChainBuilder cb;
+ ChainBuilder cb;
Tcl_Size count;
Foundation *fPtr = clsPtr->thisPtr->fPtr;
Tcl_HashEntry *hPtr;
@@ -1489,7 +1488,7 @@ TclOOGetStereotypeCallChain(
if (hPtr != NULL && Tcl_GetHashValue(hPtr) != NULL) {
const int reuseMask = (WANT_PUBLIC(flags) ? ~0 : ~PUBLIC_METHOD);
- callPtr = (CallChain *)Tcl_GetHashValue(hPtr);
+ callPtr = (CallChain *) Tcl_GetHashValue(hPtr);
if (IsStillValid(callPtr, &obj, flags, reuseMask)) {
callPtr->refCount++;
return callPtr;
@@ -1501,7 +1500,7 @@ TclOOGetStereotypeCallChain(
hPtr = NULL;
}
- callPtr = (CallChain *)Tcl_Alloc(sizeof(CallChain));
+ callPtr = (CallChain *) Tcl_Alloc(sizeof(CallChain));
memset(callPtr, 0, sizeof(CallChain));
callPtr->flags = flags & (PUBLIC_METHOD|PRIVATE_METHOD|FILTER_HANDLING);
callPtr->epoch = fPtr->epoch;
@@ -1557,7 +1556,8 @@ TclOOGetStereotypeCallChain(
if (hPtr == NULL) {
int isNew;
if (clsPtr->classChainCache == NULL) {
- clsPtr->classChainCache = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable));
+ clsPtr->classChainCache = (Tcl_HashTable *)
+ Tcl_Alloc(sizeof(Tcl_HashTable));
Tcl_InitObjHashTable(clsPtr->classChainCache);
}
hPtr = Tcl_CreateHashEntry(clsPtr->classChainCache,
@@ -1585,8 +1585,7 @@ static void
AddClassFiltersToCallContext(
Object *const oPtr, /* Object that the filters operate on. */
Class *clsPtr, /* Class to get the filters from. */
- struct ChainBuilder *const cbPtr,
- /* Context to fill with call chain entries. */
+ ChainBuilder *const cbPtr, /* Context to fill with call chain entries. */
Tcl_HashTable *const doneFilters,
/* Where to record what filters have been
* processed. Keys are objects, values are
@@ -1673,8 +1672,7 @@ AddPrivatesFromClassChainToCallContext(
* also be added. */
Tcl_Obj *const methodName, /* Name of method to add the call chain
* entries for. */
- struct ChainBuilder *const cbPtr,
- /* Where to add the call chain entries. */
+ ChainBuilder *const cbPtr, /* Where to add the call chain entries. */
Tcl_HashTable *const doneFilters,
/* Where to record what call chain entries
* have been processed. */
@@ -1715,7 +1713,7 @@ AddPrivatesFromClassChainToCallContext(
methodName);
if (hPtr != NULL) {
- Method *mPtr = (Method *)Tcl_GetHashValue(hPtr);
+ Method *mPtr = (Method *) Tcl_GetHashValue(hPtr);
if (IS_PRIVATE(mPtr)) {
AddMethodToCallChain(mPtr, cbPtr, doneFilters, filterDecl,
@@ -1758,8 +1756,7 @@ AddSimpleClassChainToCallContext(
Tcl_Obj *const methodNameObj,
/* Name of method to add the call chain
* entries for. */
- struct ChainBuilder *const cbPtr,
- /* Where to add the call chain entries. */
+ ChainBuilder *const cbPtr, /* Where to add the call chain entries. */
Tcl_HashTable *const doneFilters,
/* Where to record what call chain entries
* have been processed. */
@@ -1804,7 +1801,7 @@ AddSimpleClassChainToCallContext(
privateDanger |= 1;
}
if (hPtr != NULL) {
- Method *mPtr = (Method *)Tcl_GetHashValue(hPtr);
+ Method *mPtr = (Method *) Tcl_GetHashValue(hPtr);
if (!IS_PRIVATE(mPtr)) {
if (!(flags & KNOWN_STATE)) {
@@ -1864,13 +1861,9 @@ TclOORenderCallChain(
*/
TclNewLiteralStringObj(filterLiteral, "filter");
- Tcl_IncrRefCount(filterLiteral);
TclNewLiteralStringObj(methodLiteral, "method");
- Tcl_IncrRefCount(methodLiteral);
TclNewLiteralStringObj(objectLiteral, "object");
- Tcl_IncrRefCount(objectLiteral);
TclNewLiteralStringObj(privateLiteral, "private");
- Tcl_IncrRefCount(privateLiteral);
/*
* Do the actual construction of the descriptions. They consist of a list
@@ -1884,9 +1877,10 @@ TclOORenderCallChain(
* method (or "object" if it is declared on the instance).
*/
- objv = (Tcl_Obj **)TclStackAlloc(interp, callPtr->numChain * sizeof(Tcl_Obj *));
+ objv = (Tcl_Obj **)
+ TclStackAlloc(interp, callPtr->numChain * sizeof(Tcl_Obj *));
for (i = 0 ; i < callPtr->numChain ; i++) {
- struct MInvoke *miPtr = &callPtr->chain[i];
+ MInvoke *miPtr = &callPtr->chain[i];
descObjs[0] =
miPtr->isFilter ? filterLiteral :
@@ -1911,10 +1905,10 @@ TclOORenderCallChain(
* they'll live on the description itself.
*/
- Tcl_DecrRefCount(filterLiteral);
- Tcl_DecrRefCount(methodLiteral);
- Tcl_DecrRefCount(objectLiteral);
- Tcl_DecrRefCount(privateLiteral);
+ Tcl_BounceRefCount(filterLiteral);
+ Tcl_BounceRefCount(methodLiteral);
+ Tcl_BounceRefCount(objectLiteral);
+ Tcl_BounceRefCount(privateLiteral);
/*
* Finish building the description and return it.
@@ -2152,12 +2146,12 @@ AddDefinitionNamespaceToChain(
if (definePtr->num == DEFINE_CHAIN_STATIC_SIZE) {
DefineEntry *staticList = definePtr->list;
- definePtr->list =
- (DefineEntry *)Tcl_Alloc(sizeof(DefineEntry) * definePtr->size);
+ definePtr->list = (DefineEntry *)
+ Tcl_Alloc(sizeof(DefineEntry) * definePtr->size);
memcpy(definePtr->list, staticList,
sizeof(DefineEntry) * definePtr->num);
} else {
- definePtr->list = (DefineEntry *)Tcl_Realloc(definePtr->list,
+ definePtr->list = (DefineEntry *) Tcl_Realloc(definePtr->list,
sizeof(DefineEntry) * definePtr->size);
}
}
diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c
index d3ec410..882ca52 100644
--- a/generic/tclOODefineCmds.c
+++ b/generic/tclOODefineCmds.c
@@ -32,13 +32,12 @@
/*
* Some things that make it easier to declare a slot.
*/
-
-struct DeclaredSlot {
+typedef struct DeclaredSlot {
const char *name;
const Tcl_MethodType getterType;
const Tcl_MethodType setterType;
const Tcl_MethodType resolverType;
-};
+} DeclaredSlot;
#define SLOT(name,getter,setter,resolver) \
{"::oo::" name, \
@@ -156,7 +155,7 @@ static int ResolveClass(void *clientData,
* Now define the slots used in declarations.
*/
-static const struct DeclaredSlot slots[] = {
+static const DeclaredSlot slots[] = {
SLOT("define::filter", ClassFilter_Get, ClassFilter_Set, NULL),
SLOT("define::mixin", ClassMixin_Get, ClassMixin_Set, ResolveClass),
SLOT("define::superclass", ClassSuper_Get, ClassSuper_Set, ResolveClass),
@@ -360,9 +359,9 @@ TclOOObjectSetFilters(
size_t size = sizeof(Tcl_Obj *) * numFilters;
if (oPtr->filters.num == 0) {
- filtersList = (Tcl_Obj **)Tcl_Alloc(size);
+ filtersList = (Tcl_Obj **) Tcl_Alloc(size);
} else {
- filtersList = (Tcl_Obj **)Tcl_Realloc(oPtr->filters.list, size);
+ filtersList = (Tcl_Obj **) Tcl_Realloc(oPtr->filters.list, size);
}
for (i = 0 ; i < numFilters ; i++) {
filtersList[i] = filters[i];
@@ -419,9 +418,10 @@ TclOOClassSetFilters(
size_t size = sizeof(Tcl_Obj *) * numFilters;
if (classPtr->filters.num == 0) {
- filtersList = (Tcl_Obj **)Tcl_Alloc(size);
+ filtersList = (Tcl_Obj **) Tcl_Alloc(size);
} else {
- filtersList = (Tcl_Obj **)Tcl_Realloc(classPtr->filters.list, size);
+ filtersList = (Tcl_Obj **)
+ Tcl_Realloc(classPtr->filters.list, size);
}
for (i = 0 ; i < numFilters ; i++) {
filtersList[i] = filters[i];
@@ -475,10 +475,11 @@ TclOOObjectSetMixins(
}
TclOODecrRefCount(mixinPtr->thisPtr);
}
- oPtr->mixins.list = (Class **)Tcl_Realloc(oPtr->mixins.list,
+ oPtr->mixins.list = (Class **) Tcl_Realloc(oPtr->mixins.list,
sizeof(Class *) * numMixins);
} else {
- oPtr->mixins.list = (Class **)Tcl_Alloc(sizeof(Class *) * numMixins);
+ oPtr->mixins.list = (Class **)
+ Tcl_Alloc(sizeof(Class *) * numMixins);
oPtr->flags &= ~USE_CLASS_CACHE;
}
oPtr->mixins.num = numMixins;
@@ -533,10 +534,12 @@ TclOOClassSetMixins(
TclOORemoveFromMixinSubs(classPtr, mixinPtr);
TclOODecrRefCount(mixinPtr->thisPtr);
}
- classPtr->mixins.list = (Class **)Tcl_Realloc(classPtr->mixins.list,
- sizeof(Class *) * numMixins);
+ classPtr->mixins.list = (Class **)
+ Tcl_Realloc(classPtr->mixins.list,
+ sizeof(Class *) * numMixins);
} else {
- classPtr->mixins.list = (Class **)Tcl_Alloc(sizeof(Class *) * numMixins);
+ classPtr->mixins.list = (Class **)
+ Tcl_Alloc(sizeof(Class *) * numMixins);
}
classPtr->mixins.num = numMixins;
memcpy(classPtr->mixins.list, mixins, sizeof(Class *) * numMixins);
@@ -584,9 +587,10 @@ InstallStandardVariableMapping(
if (varc == 0) {
Tcl_Free(vnlPtr->list);
} else if (i) {
- vnlPtr->list = (Tcl_Obj **)Tcl_Realloc(vnlPtr->list, sizeof(Tcl_Obj *) * varc);
+ vnlPtr->list = (Tcl_Obj **)
+ Tcl_Realloc(vnlPtr->list, sizeof(Tcl_Obj *) * varc);
} else {
- vnlPtr->list = (Tcl_Obj **)Tcl_Alloc(sizeof(Tcl_Obj *) * varc);
+ vnlPtr->list = (Tcl_Obj **) Tcl_Alloc(sizeof(Tcl_Obj *) * varc);
}
}
vnlPtr->num = 0;
@@ -607,7 +611,8 @@ InstallStandardVariableMapping(
*/
if (n != varc) {
- vnlPtr->list = (Tcl_Obj **)Tcl_Realloc(vnlPtr->list, sizeof(Tcl_Obj *) * n);
+ vnlPtr->list = (Tcl_Obj **)
+ Tcl_Realloc(vnlPtr->list, sizeof(Tcl_Obj *) * n);
}
Tcl_DeleteHashTable(&uniqueTable);
}
@@ -668,7 +673,7 @@ InstallPrivateVariableMapping(
*/
if (n != varc) {
- pvlPtr->list = (PrivateVariableMapping *)Tcl_Realloc(pvlPtr->list,
+ pvlPtr->list = (PrivateVariableMapping *) Tcl_Realloc(pvlPtr->list,
sizeof(PrivateVariableMapping) * n);
}
Tcl_DeleteHashTable(&uniqueTable);
@@ -748,7 +753,7 @@ RenameDeleteMethod(
* Complete the splicing by changing the method's name.
*/
- mPtr = (Method *)Tcl_GetHashValue(hPtr);
+ mPtr = (Method *) Tcl_GetHashValue(hPtr);
if (toPtr) {
Tcl_IncrRefCount(toPtr);
Tcl_DecrRefCount(mPtr->namePtr);
@@ -975,7 +980,7 @@ TclOOGetDefineCmdContext(
Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL);
return NULL;
}
- object = (Tcl_Object)iPtr->varFramePtr->clientData;
+ object = (Tcl_Object) iPtr->varFramePtr->clientData;
if (Tcl_ObjectDeleted(object)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"this command cannot be called when the object has been"
@@ -1107,7 +1112,7 @@ GenerateErrorInfo(
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
"\n (in definition script for %s \"%.*s%s\" line %d)",
- typeOfSubject, (overflow ? limit : (int)length), objName,
+ typeOfSubject, (overflow ? limit : (int) length), objName,
(overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
}
@@ -1237,7 +1242,7 @@ TclOODefineObjCmd(
Tcl_IncrRefCount(objNameObj);
result = TclEvalObjEx(interp, objv[2], 0,
- ((Interp *)interp)->cmdFramePtr, 2);
+ ((Interp *) interp)->cmdFramePtr, 2);
if (result == TCL_ERROR) {
GenerateErrorInfo(interp, oPtr, objNameObj, "class");
}
@@ -1306,7 +1311,7 @@ TclOOObjDefObjCmd(
Tcl_IncrRefCount(objNameObj);
result = TclEvalObjEx(interp, objv[2], 0,
- ((Interp *)interp)->cmdFramePtr, 2);
+ ((Interp *) interp)->cmdFramePtr, 2);
if (result == TCL_ERROR) {
GenerateErrorInfo(interp, oPtr, objNameObj, "object");
}
@@ -1380,7 +1385,7 @@ TclOODefineSelfObjCmd(
Tcl_IncrRefCount(objNameObj);
result = TclEvalObjEx(interp, objv[1], 0,
- ((Interp *)interp)->cmdFramePtr, 1);
+ ((Interp *) interp)->cmdFramePtr, 1);
if (result == TCL_ERROR) {
GenerateErrorInfo(interp, oPtr, objNameObj, "class object");
}
@@ -1643,7 +1648,7 @@ TclOODefineConstructorObjCmd(
return TCL_ERROR;
}
- (void)TclGetStringFromObj(objv[2], &bodyLength);
+ (void) TclGetStringFromObj(objv[2], &bodyLength);
if (bodyLength > 0) {
/*
* Create the method structure.
@@ -1837,7 +1842,7 @@ TclOODefineDestructorObjCmd(
}
- (void)TclGetStringFromObj(objv[1], &bodyLength);
+ (void) TclGetStringFromObj(objv[1], &bodyLength);
if (bodyLength > 0) {
/*
* Create the method structure.
@@ -1922,7 +1927,8 @@ TclOODefineExportObjCmd(
if (isInstanceExport) {
if (!oPtr->methodsPtr) {
- oPtr->methodsPtr = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable));
+ oPtr->methodsPtr = (Tcl_HashTable *)
+ Tcl_Alloc(sizeof(Tcl_HashTable));
Tcl_InitObjHashTable(oPtr->methodsPtr);
oPtr->flags &= ~USE_CLASS_CACHE;
}
@@ -1934,14 +1940,14 @@ TclOODefineExportObjCmd(
}
if (isNew) {
- mPtr = (Method *)Tcl_Alloc(sizeof(Method));
+ mPtr = (Method *) Tcl_Alloc(sizeof(Method));
memset(mPtr, 0, sizeof(Method));
mPtr->refCount = 1;
mPtr->namePtr = objv[i];
Tcl_IncrRefCount(objv[i]);
Tcl_SetHashValue(hPtr, mPtr);
} else {
- mPtr = (Method *)Tcl_GetHashValue(hPtr);
+ mPtr = (Method *) Tcl_GetHashValue(hPtr);
}
if (isNew || !(mPtr->flags & (PUBLIC_METHOD | PRIVATE_METHOD))) {
mPtr->flags |= PUBLIC_METHOD;
@@ -2248,14 +2254,14 @@ TclOODefineUnexportObjCmd(
}
if (isNew) {
- mPtr = (Method *)Tcl_Alloc(sizeof(Method));
+ mPtr = (Method *) Tcl_Alloc(sizeof(Method));
memset(mPtr, 0, sizeof(Method));
mPtr->refCount = 1;
mPtr->namePtr = objv[i];
Tcl_IncrRefCount(objv[i]);
Tcl_SetHashValue(hPtr, mPtr);
} else {
- mPtr = (Method *)Tcl_GetHashValue(hPtr);
+ mPtr = (Method *) Tcl_GetHashValue(hPtr);
}
if (isNew || mPtr->flags & (PUBLIC_METHOD | TRUE_PRIVATE_METHOD)) {
mPtr->flags &= ~(PUBLIC_METHOD | TRUE_PRIVATE_METHOD);
@@ -2347,30 +2353,38 @@ int
TclOODefineSlots(
Foundation *fPtr)
{
- const struct DeclaredSlot *slotInfoPtr;
- Tcl_Obj *getName = Tcl_NewStringObj("Get", -1);
- Tcl_Obj *setName = Tcl_NewStringObj("Set", -1);
- Tcl_Obj *resolveName = Tcl_NewStringObj("Resolve", -1);
+ const DeclaredSlot *slotInfoPtr;
+ Tcl_Interp *interp = fPtr->interp;
+ Tcl_Obj *getName, *setName, *resolveName;
+ Tcl_Object object = Tcl_NewObjectInstance(interp, (Tcl_Class)
+ fPtr->classCls, "::oo::Slot", NULL, TCL_INDEX_NONE, NULL, 0);
Class *slotCls;
- slotCls = ((Object *) Tcl_NewObjectInstance(fPtr->interp, (Tcl_Class)
- fPtr->classCls, "::oo::Slot", NULL, TCL_INDEX_NONE, NULL, 0))->classPtr;
+ if (object == NULL) {
+ return TCL_ERROR;
+ }
+ slotCls = ((Object *) object)->classPtr;
if (slotCls == NULL) {
return TCL_ERROR;
}
+
+ TclNewLiteralStringObj(getName, "Get");
+ TclNewLiteralStringObj(setName, "Set");
+ TclNewLiteralStringObj(resolveName, "Resolve");
for (slotInfoPtr = slots ; slotInfoPtr->name ; slotInfoPtr++) {
- Tcl_Object slotObject = Tcl_NewObjectInstance(fPtr->interp,
- (Tcl_Class) slotCls, slotInfoPtr->name, NULL, TCL_INDEX_NONE, NULL, 0);
+ Tcl_Object slotObject = Tcl_NewObjectInstance(interp,
+ (Tcl_Class) slotCls, slotInfoPtr->name, NULL, TCL_INDEX_NONE,
+ NULL, 0);
if (slotObject == NULL) {
continue;
}
- TclNewInstanceMethod(fPtr->interp, slotObject, getName, 0,
+ TclNewInstanceMethod(interp, slotObject, getName, 0,
&slotInfoPtr->getterType, NULL);
- TclNewInstanceMethod(fPtr->interp, slotObject, setName, 0,
+ TclNewInstanceMethod(interp, slotObject, setName, 0,
&slotInfoPtr->setterType, NULL);
if (slotInfoPtr->resolverType.callProc) {
- TclNewInstanceMethod(fPtr->interp, slotObject, resolveName, 0,
+ TclNewInstanceMethod(interp, slotObject, resolveName, 0,
&slotInfoPtr->resolverType, NULL);
}
}
@@ -2522,7 +2536,7 @@ ClassMixin_Set(
return TCL_ERROR;
}
- mixins = (Class **)TclStackAlloc(interp, sizeof(Class *) * mixinc);
+ mixins = (Class **) TclStackAlloc(interp, sizeof(Class *) * mixinc);
Tcl_InitHashTable(&uniqueCheck, TCL_ONE_WORD_KEYS);
for (i = 0; i < mixinc; i++) {
@@ -2647,7 +2661,7 @@ ClassSuper_Set(
*/
if (superc == 0) {
- superclasses = (Class **)Tcl_Realloc(superclasses, sizeof(Class *));
+ superclasses = (Class **) Tcl_Realloc(superclasses, sizeof(Class *));
if (TclOOIsReachable(fPtr->classCls, clsPtr)) {
superclasses[0] = fPtr->classCls;
} else {
@@ -2959,7 +2973,7 @@ ObjMixin_Set(
return TCL_ERROR;
}
- mixins = (Class **)TclStackAlloc(interp, sizeof(Class *) * mixinc);
+ mixins = (Class **) TclStackAlloc(interp, sizeof(Class *) * mixinc);
Tcl_InitHashTable(&uniqueCheck, TCL_ONE_WORD_KEYS);
for (i = 0; i < mixinc; i++) {
@@ -3760,9 +3774,10 @@ TclOOPropertyDefinitionCmd(
if (setterScript != NULL) {
Tcl_Obj *setterName = Tcl_ObjPrintf("<WriteProp-%s>",
TclGetString(propObj));
- Tcl_Obj *argsPtr = Tcl_NewStringObj("value", -1);
+ Tcl_Obj *argsPtr;
Method *mPtr;
+ TclNewLiteralStringObj(argsPtr, "value");
Tcl_IncrRefCount(setterScript);
if (useInstance) {
mPtr = TclOONewProcInstanceMethod(interp, oPtr, 0,
diff --git a/generic/tclOOInfo.c b/generic/tclOOInfo.c
index 4555c39..feac2c0 100644
--- a/generic/tclOOInfo.c
+++ b/generic/tclOOInfo.c
@@ -95,6 +95,23 @@ static const EnsembleImplMap infoClassCmds[] = {
/*
* ----------------------------------------------------------------------
*
+ * LocalVarName --
+ *
+ * Get the name of a local variable (especially a method argument) as a
+ * Tcl value.
+ *
+ * ----------------------------------------------------------------------
+ */
+static inline Tcl_Obj *
+LocalVarName(
+ CompiledLocal *localPtr)
+{
+ return Tcl_NewStringObj(localPtr->name, TCL_AUTO_LENGTH);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
* TclOOInitInfo --
*
* Adjusts the Tcl core [info] command to contain subcommands ("object"
@@ -256,22 +273,17 @@ InfoObjectDefnCmd(
}
hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, objv[2]);
if (hPtr == NULL) {
- unknownMethod:
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "unknown method \"%s\"", TclGetString(objv[2])));
- Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
- TclGetString(objv[2]), (char *)NULL);
- return TCL_ERROR;
+ goto unknownMethod;
}
- procPtr = TclOOGetProcFromMethod((Method *)Tcl_GetHashValue(hPtr));
+ procPtr = TclOOGetProcFromMethod((Method *) Tcl_GetHashValue(hPtr));
if (procPtr == NULL) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "definition not available for this kind of method", -1));
- Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
- TclGetString(objv[2]), (char *)NULL);
- return TCL_ERROR;
+ goto wrongType;
}
+ /*
+ * We now have the method to describe the definition of.
+ */
+
TclNewObj(resultObjs[0]);
for (localPtr=procPtr->firstLocalPtr; localPtr!=NULL;
localPtr=localPtr->nextPtr) {
@@ -279,17 +291,34 @@ InfoObjectDefnCmd(
Tcl_Obj *argObj;
TclNewObj(argObj);
- Tcl_ListObjAppendElement(NULL, argObj,
- Tcl_NewStringObj(localPtr->name, -1));
+ Tcl_ListObjAppendElement(NULL, argObj, LocalVarName(localPtr));
if (localPtr->defValuePtr != NULL) {
Tcl_ListObjAppendElement(NULL, argObj, localPtr->defValuePtr);
}
Tcl_ListObjAppendElement(NULL, resultObjs[0], argObj);
}
}
- resultObjs[1] = TclOOGetMethodBody((Method *)Tcl_GetHashValue(hPtr));
+ resultObjs[1] = TclOOGetMethodBody((Method *) Tcl_GetHashValue(hPtr));
Tcl_SetObjResult(interp, Tcl_NewListObj(2, resultObjs));
return TCL_OK;
+
+ /*
+ * Errors...
+ */
+
+ unknownMethod:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown method \"%s\"", TclGetString(objv[2])));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
+ TclGetString(objv[2]), (char *)NULL);
+ return TCL_ERROR;
+
+ wrongType:
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "definition not available for this kind of method", -1));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
+ TclGetString(objv[2]), (char *)NULL);
+ return TCL_ERROR;
}
/*
@@ -367,25 +396,38 @@ InfoObjectForwardCmd(
}
hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, objv[2]);
if (hPtr == NULL) {
- unknownMethod:
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "unknown method \"%s\"", TclGetString(objv[2])));
- Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
- TclGetString(objv[2]), (char *)NULL);
- return TCL_ERROR;
+ goto unknownMethod;
}
- prefixObj = TclOOGetFwdFromMethod((Method *)Tcl_GetHashValue(hPtr));
+ prefixObj = TclOOGetFwdFromMethod((Method *) Tcl_GetHashValue(hPtr));
if (prefixObj == NULL) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "prefix argument list not available for this kind of method",
- -1));
- Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
- TclGetString(objv[2]), (char *)NULL);
- return TCL_ERROR;
+ goto wrongType;
}
+ /*
+ * Describe the valid forward method.
+ */
+
Tcl_SetObjResult(interp, prefixObj);
return TCL_OK;
+
+ /*
+ * Errors...
+ */
+
+ unknownMethod:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown method \"%s\"", TclGetString(objv[2])));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
+ TclGetString(objv[2]), (char *)NULL);
+ return TCL_ERROR;
+
+ wrongType:
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "prefix argument list not available for this kind of method",
+ -1));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
+ TclGetString(objv[2]), (char *)NULL);
+ return TCL_ERROR;
}
/*
@@ -544,6 +586,10 @@ InfoObjectMethodsCmd(
SCOPE_LOCALPRIVATE
};
+ /*
+ * Parse arguments.
+ */
+
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "objName ?-option value ...?");
return TCL_ERROR;
@@ -604,6 +650,10 @@ InfoObjectMethodsCmd(
}
}
+ /*
+ * List matching methods.
+ */
+
TclNewObj(resultObj);
if (recurse) {
const char **names;
@@ -615,7 +665,7 @@ InfoObjectMethodsCmd(
Tcl_NewStringObj(names[i], -1));
}
if (numNames > 0) {
- Tcl_Free((void *)names);
+ Tcl_Free((void *) names);
}
} else if (oPtr->methodsPtr) {
if (scope == -1) {
@@ -684,7 +734,7 @@ InfoObjectMethodTypeCmd(
TclGetString(objv[2]), (char *)NULL);
return TCL_ERROR;
}
- mPtr = (Method *)Tcl_GetHashValue(hPtr);
+ mPtr = (Method *) Tcl_GetHashValue(hPtr);
if (mPtr->typePtr == NULL) {
/*
* Special entry for visibility control: pretend the method doesnt
@@ -970,8 +1020,7 @@ InfoClassConstrCmd(
Tcl_Obj *argObj;
TclNewObj(argObj);
- Tcl_ListObjAppendElement(NULL, argObj,
- Tcl_NewStringObj(localPtr->name, -1));
+ Tcl_ListObjAppendElement(NULL, argObj, LocalVarName(localPtr));
if (localPtr->defValuePtr != NULL) {
Tcl_ListObjAppendElement(NULL, argObj, localPtr->defValuePtr);
}
@@ -1022,7 +1071,7 @@ InfoClassDefnCmd(
TclGetString(objv[2]), (char *)NULL);
return TCL_ERROR;
}
- procPtr = TclOOGetProcFromMethod((Method *)Tcl_GetHashValue(hPtr));
+ procPtr = TclOOGetProcFromMethod((Method *) Tcl_GetHashValue(hPtr));
if (procPtr == NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"definition not available for this kind of method", -1));
@@ -1038,15 +1087,14 @@ InfoClassDefnCmd(
Tcl_Obj *argObj;
TclNewObj(argObj);
- Tcl_ListObjAppendElement(NULL, argObj,
- Tcl_NewStringObj(localPtr->name, -1));
+ Tcl_ListObjAppendElement(NULL, argObj, LocalVarName(localPtr));
if (localPtr->defValuePtr != NULL) {
Tcl_ListObjAppendElement(NULL, argObj, localPtr->defValuePtr);
}
Tcl_ListObjAppendElement(NULL, resultObjs[0], argObj);
}
}
- resultObjs[1] = TclOOGetMethodBody((Method *)Tcl_GetHashValue(hPtr));
+ resultObjs[1] = TclOOGetMethodBody((Method *) Tcl_GetHashValue(hPtr));
Tcl_SetObjResult(interp, Tcl_NewListObj(2, resultObjs));
return TCL_OK;
}
@@ -1220,7 +1268,7 @@ InfoClassForwardCmd(
TclGetString(objv[2]), (char *)NULL);
return TCL_ERROR;
}
- prefixObj = TclOOGetFwdFromMethod((Method *)Tcl_GetHashValue(hPtr));
+ prefixObj = TclOOGetFwdFromMethod((Method *) Tcl_GetHashValue(hPtr));
if (prefixObj == NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"prefix argument list not available for this kind of method",
@@ -1383,7 +1431,7 @@ InfoClassMethodsCmd(
Tcl_NewStringObj(names[i], -1));
}
if (numNames > 0) {
- Tcl_Free((void *)names);
+ Tcl_Free((void *) names);
}
} else {
FOREACH_HASH_DECLS;
@@ -1450,7 +1498,7 @@ InfoClassMethodTypeCmd(
TclGetString(objv[2]), (char *)NULL);
return TCL_ERROR;
}
- mPtr = (Method *)Tcl_GetHashValue(hPtr);
+ mPtr = (Method *) Tcl_GetHashValue(hPtr);
if (mPtr->typePtr == NULL) {
/*
* Special entry for visibility control: pretend the method doesnt
diff --git a/generic/tclOOInt.h b/generic/tclOOInt.h
index 124953d..182d982 100644
--- a/generic/tclOOInt.h
+++ b/generic/tclOOInt.h
@@ -30,35 +30,45 @@
* Forward declarations.
*/
-struct CallChain;
-struct Class;
-struct Foundation;
-struct Object;
+typedef struct CallChain CallChain;
+typedef struct CallContext CallContext;
+typedef struct Class Class;
+typedef struct DeclaredClassMethod DeclaredClassMethod;
+typedef struct ForwardMethod ForwardMethod;
+typedef struct Foundation Foundation;
+typedef struct Method Method;
+typedef struct MInvoke MInvoke;
+typedef struct Object Object;
+typedef struct PrivateVariableMapping PrivateVariableMapping;
+typedef struct ProcedureMethod ProcedureMethod;
+typedef struct PropertyStorage PropertyStorage;
/*
* The data that needs to be stored per method. This record is used to collect
* information about all sorts of methods, including forwards, constructors
* and destructors.
*/
-
-typedef struct Method {
- const Tcl_MethodType *typePtr;
- /* The type of method. If NULL, this is a
+struct Method {
+ union {
+ const Tcl_MethodType *typePtr;
+ const Tcl_MethodType2 *type2Ptr;
+ }; /* The type of method. If NULL, this is a
* special flag record which is just used for
- * the setting of the flags field. */
+ * the setting of the flags field. Note that
+ * this is a union of two pointer types that
+ * have the same layout at least as far as the
+ * internal version field. */
Tcl_Size refCount;
void *clientData; /* Type-specific data. */
Tcl_Obj *namePtr; /* Name of the method. */
- struct Object *declaringObjectPtr;
- /* The object that declares this method, or
+ Object *declaringObjectPtr; /* The object that declares this method, or
* NULL if it was declared by a class. */
- struct Class *declaringClassPtr;
- /* The class that declares this method, or
+ Class *declaringClassPtr; /* The class that declares this method, or
* NULL if it was declared directly on an
* object. */
int flags; /* Assorted flags. Includes whether this
* method is public/exported or not. */
-} Method;
+};
/*
* Pre- and post-call callbacks, to allow procedure-like methods to be fine
@@ -75,10 +85,9 @@ typedef void *(TclOO_PmCDCloneProc)(void *clientData);
/*
* Procedure-like methods have the following extra information.
*/
-
-typedef struct ProcedureMethod {
+struct ProcedureMethod {
int version; /* Version of this structure. Currently must
- * be 0. */
+ * be TCLOO_PROCEDURE_METHOD_VERSION_1. */
Proc *procPtr; /* Core of the implementation of the method;
* includes the argument definition and the
* body bytecodes. */
@@ -107,44 +116,47 @@ typedef struct ProcedureMethod {
* destructor, which we can't know until then
* for messy reasons. Other flags are variable
* but not used. */
-} ProcedureMethod;
+};
-#define TCLOO_PROCEDURE_METHOD_VERSION 0
+enum ProcedureMethodVersion {
+ TCLOO_PROCEDURE_METHOD_VERSION_1 = 0
+};
+#define TCLOO_PROCEDURE_METHOD_VERSION TCLOO_PROCEDURE_METHOD_VERSION_1
/*
* Flags for use in a ProcedureMethod.
*
- * When the USE_DECLARER_NS flag is set, the method will use the namespace of
- * the object or class that declared it (or the clone of it, if it was from
- * such that the implementation of the method came to the particular use)
- * instead of the namespace of the object on which the method was invoked.
- * This flag must be distinct from all others that are associated with
- * methods.
*/
-
-#define USE_DECLARER_NS 0x80
+enum ProceudreMethodFlags {
+ USE_DECLARER_NS = 0x80 /* When set, the method will use the namespace
+ * of the object or class that declared it (or
+ * the clone of it, if it was from such that
+ * the implementation of the method came to the
+ * particular use) instead of the namespace of
+ * the object on which the method was invoked.
+ * This flag must be distinct from all others
+ * that are associated with methods. */
+};
/*
* Forwarded methods have the following extra information.
*/
-
-typedef struct ForwardMethod {
+struct ForwardMethod {
Tcl_Obj *prefixObj; /* The list of values to use to replace the
* object and method name with. Will be a
* non-empty list. */
-} ForwardMethod;
+};
/*
* Structure used in private variable mappings. Describes the mapping of a
* single variable from the user's local name to the system's storage name.
* [TIP #500]
*/
-
-typedef struct {
+struct PrivateVariableMapping {
Tcl_Obj *variableObj; /* Name used within methods. This is the part
* that is properly under user control. */
Tcl_Obj *fullNameObj; /* Name used at the instance namespace level. */
-} PrivateVariableMapping;
+};
/*
* Helper definitions that declare a "list" array. The two varieties are
@@ -167,15 +179,19 @@ typedef struct {
* These types are needed in function arguments.
*/
+typedef LIST_STATIC(Class *) ClassList;
+typedef LIST_DYNAMIC(Class *) VarClassList;
+typedef LIST_STATIC(Tcl_Obj *) FilterList;
+typedef LIST_DYNAMIC(Object *) ObjectList;
typedef LIST_STATIC(Tcl_Obj *) VariableNameList;
typedef LIST_STATIC(PrivateVariableMapping) PrivateVariableList;
typedef LIST_STATIC(Tcl_Obj *) PropertyList;
/*
- * This type is used in various places.
+ * This type is used in various places. It holds the parts of an object or
+ * class relating to property information.
*/
-
-typedef struct {
+struct PropertyStorage {
PropertyList readable; /* The readable properties slot. */
PropertyList writable; /* The writable properties slot. */
Tcl_Obj *allReadableCache; /* The cache of all readable properties
@@ -187,37 +203,33 @@ typedef struct {
* stereotypical instances). Contains a sorted
* unique list if not NULL. */
int epoch; /* The epoch that the caches are valid for. */
-} PropertyStorage;
+};
/*
* Now, the definition of what an object actually is.
*/
-typedef struct Object {
- struct Foundation *fPtr; /* The basis for the object system. Putting
- * this here allows the avoidance of quite a
- * lot of hash lookups on the critical path
- * for object invocation and creation. */
+struct Object {
+ Foundation *fPtr; /* The basis for the object system, which is
+ * conceptually part of the interpreter. */
Tcl_Namespace *namespacePtr;/* This object's namespace. */
Tcl_Command command; /* Reference to this object's public
* command. */
Tcl_Command myCommand; /* Reference to this object's internal
* command. */
- struct Class *selfCls; /* This object's class. */
+ Class *selfCls; /* This object's class. */
Tcl_HashTable *methodsPtr; /* Object-local Tcl_Obj (method name) to
* Method* mapping. */
- LIST_STATIC(struct Class *) mixins;
- /* Classes mixed into this object. */
- LIST_STATIC(Tcl_Obj *) filters;
- /* List of filter names. */
- struct Class *classPtr; /* This is non-NULL for all classes, and NULL
+ ClassList mixins; /* Classes mixed into this object. */
+ FilterList filters; /* List of filter names. */
+ Class *classPtr; /* This is non-NULL for all classes, and NULL
* for everything else. It points to the class
* structure. */
Tcl_Size refCount; /* Number of strong references to this object.
* Note that there may be many more weak
* references; this mechanism exists to
* avoid Tcl_Preserve. */
- int flags;
+ int flags; /* See ObjectFlags. */
Tcl_Size creationEpoch; /* Unique value to make comparisons of objects
* easier. */
Tcl_Size epoch; /* Per-object epoch, incremented when the way
@@ -243,67 +255,62 @@ typedef struct Object {
PropertyStorage properties; /* Information relating to the lists of
* properties that this object *claims* to
* support. */
-} Object;
+};
-#define OBJECT_DESTRUCTING 1 /* Indicates that an object is being or has
+enum ObjectFlags {
+ OBJECT_DESTRUCTING = 1, /* Indicates that an object is being or has
* been destroyed */
-#define DESTRUCTOR_CALLED 2 /* Indicates that evaluation of destructor
+ DESTRUCTOR_CALLED = 2, /* Indicates that evaluation of destructor
* script for the object has began */
-#define OO_UNUSED_4 4 /* No longer used. */
-#define ROOT_OBJECT 0x1000 /* Flag to say that this object is the root of
+ ROOT_OBJECT = 0x1000, /* Flag to say that this object is the root of
* the class hierarchy and should be treated
* specially during teardown. */
-#define FILTER_HANDLING 0x2000 /* Flag set when the object is processing a
+ FILTER_HANDLING = 0x2000, /* Flag set when the object is processing a
* filter; when set, filters are *not*
* processed on the object, preventing nasty
* recursive filtering problems. */
-#define USE_CLASS_CACHE 0x4000 /* Flag set to say that the object is a pure
+ USE_CLASS_CACHE = 0x4000, /* Flag set to say that the object is a pure
* instance of the class, and has had nothing
* added that changes the dispatch chain (i.e.
* no methods, mixins, or filters. */
-#define ROOT_CLASS 0x8000 /* Flag to say that this object is the root
+ ROOT_CLASS = 0x8000, /* Flag to say that this object is the root
* class of classes, and should be treated
* specially during teardown (and in a few
* other spots). */
-#define FORCE_UNKNOWN 0x10000 /* States that we are *really* looking up the
+ FORCE_UNKNOWN = 0x10000, /* States that we are *really* looking up the
* unknown method handler at that point. */
-#define DONT_DELETE 0x20000 /* Inhibit deletion of this object. Used
+ DONT_DELETE = 0x20000, /* Inhibit deletion of this object. Used
* during fundamental object type mutation to
* make sure that the object actually survives
* to the end of the operation. */
-#define HAS_PRIVATE_METHODS 0x40000
+ HAS_PRIVATE_METHODS = 0x40000
/* Object/class has (or had) private methods,
* and so shouldn't be cached so
* aggressively. */
+};
/*
* And the definition of a class. Note that every class also has an associated
* object, through which it is manipulated.
*/
-typedef struct Class {
+struct Class {
Object *thisPtr; /* Reference to the object associated with
* this class. */
int flags; /* Assorted flags. */
- LIST_STATIC(struct Class *) superclasses;
- /* List of superclasses, used for generation
+ ClassList superclasses; /* List of superclasses, used for generation
* of method call chains. */
- LIST_DYNAMIC(struct Class *) subclasses;
- /* List of subclasses, used to ensure deletion
+ VarClassList subclasses; /* List of subclasses, used to ensure deletion
* of dependent entities happens properly when
* the class itself is deleted. */
- LIST_DYNAMIC(Object *) instances;
- /* List of instances, used to ensure deletion
+ ObjectList instances; /* List of instances, used to ensure deletion
* of dependent entities happens properly when
* the class itself is deleted. */
- LIST_STATIC(Tcl_Obj *) filters;
- /* List of filter names, used for generation
+ FilterList filters; /* List of filter names, used for generation
* of method call chains. */
- LIST_STATIC(struct Class *) mixins;
- /* List of mixin classes, used for generation
+ ClassList mixins; /* List of mixin classes, used for generation
* of method call chains. */
- LIST_DYNAMIC(struct Class *) mixinSubs;
- /* List of classes that this class is mixed
+ VarClassList mixinSubs; /* List of classes that this class is mixed
* into, used to ensure deletion of dependent
* entities happens properly when the class
* itself is deleted. */
@@ -319,8 +326,8 @@ typedef struct Class {
* of each piece of attached metadata. This
* field starts out as NULL and is only
* allocated if metadata is attached. */
- struct CallChain *constructorChainPtr;
- struct CallChain *destructorChainPtr;
+ CallChain *constructorChainPtr;
+ CallChain *destructorChainPtr;
Tcl_HashTable *classChainCache;
/* Places where call chains are stored. For
* constructors, the class chain is always
@@ -354,15 +361,12 @@ typedef struct Class {
PropertyStorage properties; /* Information relating to the lists of
* properties that this class *claims* to
* support. */
-} Class;
+};
/*
- * The foundation of the object system within an interpreter contains
- * references to the key classes and namespaces, together with a few other
- * useful bits and pieces. Probably ought to eventually go in the Interp
- * structure itself.
+ * Master epoch counter for making unique IDs for objects that can be compared
+ * cheaply.
*/
-
typedef struct ThreadLocalData {
Tcl_Size nsCount; /* Epoch counter is used for keeping
* the values used in Tcl_Obj internal
@@ -372,19 +376,17 @@ typedef struct ThreadLocalData {
* generally cross threads). */
} ThreadLocalData;
-typedef struct Foundation {
- Tcl_Interp *interp;
+/*
+ * The foundation of the object system within an interpreter contains
+ * references to the key classes and namespaces, together with a few other
+ * useful bits and pieces. Probably ought to eventually go in the Interp
+ * structure itself.
+ */
+struct Foundation {
+ Tcl_Interp *interp; /* The interpreter this is attached to. */
Class *objectCls; /* The root of the object system. */
Class *classCls; /* The class of all classes. */
Tcl_Namespace *ooNs; /* ::oo namespace. */
- Tcl_Namespace *defineNs; /* Namespace containing special commands for
- * manipulating objects and classes. The
- * "oo::define" command acts as a special kind
- * of ensemble for this namespace. */
- Tcl_Namespace *objdefNs; /* Namespace containing special commands for
- * manipulating objects and classes. The
- * "oo::objdefine" command acts as a special
- * kind of ensemble for this namespace. */
Tcl_Namespace *helpersNs; /* Namespace containing the commands that are
* only valid when executing inside a
* procedural method. */
@@ -403,17 +405,18 @@ typedef struct Foundation {
* "<cloned>" pseudo-constructor. */
Tcl_Obj *defineName; /* Fully qualified name of oo::define. */
Tcl_Obj *myName; /* The "my" shared object. */
-} Foundation;
+};
/*
- * A call context structure is built when a method is called. It contains the
- * chain of method implementations that are to be invoked by a particular
- * call, and the process of calling walks the chain, with the [next] command
- * proceeding to the next entry in the chain.
+ * The number of MInvoke records in the CallChain before we allocate
+ * separately.
*/
-
#define CALL_CHAIN_STATIC_SIZE 4
+/*
+ * Information relating to the invocation of a particular method implementation
+ * in a call chain.
+ */
struct MInvoke {
Method *mPtr; /* Reference to the method implementation
* record. */
@@ -422,7 +425,10 @@ struct MInvoke {
* NULL, it was added by the object. */
};
-typedef struct CallChain {
+/*
+ * The cacheable part of a call context.
+ */
+struct CallChain {
Tcl_Size objectCreationEpoch;/* The object's creation epoch. Note that the
* object reference is not stored in the call
* chain; it is in the call context. */
@@ -433,13 +439,19 @@ typedef struct CallChain {
int flags; /* Assorted flags, see below. */
Tcl_Size refCount; /* Reference count. */
Tcl_Size numChain; /* Size of the call chain. */
- struct MInvoke *chain; /* Array of call chain entries. May point to
+ MInvoke *chain; /* Array of call chain entries. May point to
* staticChain if the number of entries is
* small. */
- struct MInvoke staticChain[CALL_CHAIN_STATIC_SIZE];
-} CallChain;
+ MInvoke staticChain[CALL_CHAIN_STATIC_SIZE];
+};
-typedef struct CallContext {
+/*
+ * A call context structure is built when a method is called. It contains the
+ * chain of method implementations that are to be invoked by a particular
+ * call, and the process of calling walks the chain, with the [next] command
+ * proceeding to the next entry in the chain.
+ */
+struct CallContext {
Object *oPtr; /* The object associated with this call. */
Tcl_Size index; /* Index into the call chain of the currently
* executing method implementation. */
@@ -448,33 +460,32 @@ typedef struct CallContext {
* method call or a continuation via the
* [next] command. */
CallChain *callPtr; /* The actual call chain. */
-} CallContext;
+};
/*
* Bits for the 'flags' field of the call chain.
*/
-
-#define PUBLIC_METHOD 0x01 /* This is a public (exported) method. */
-#define PRIVATE_METHOD 0x02 /* This is a private (class's direct instances
+enum TclOOCallChainFlags {
+ PUBLIC_METHOD = 0x01, /* This is a public (exported) method. */
+ PRIVATE_METHOD = 0x02, /* This is a private (class's direct instances
* only) method. Supports itcl. */
-#define OO_UNKNOWN_METHOD 0x04 /* This is an unknown method. */
-#define CONSTRUCTOR 0x08 /* This is a constructor. */
-#define DESTRUCTOR 0x10 /* This is a destructor. */
-#define TRUE_PRIVATE_METHOD 0x20
- /* This is a private method only accessible
+ OO_UNKNOWN_METHOD = 0x04, /* This is an unknown method. */
+ CONSTRUCTOR = 0x08, /* This is a constructor. */
+ DESTRUCTOR = 0x10, /* This is a destructor. */
+ TRUE_PRIVATE_METHOD = 0x20 /* This is a private method only accessible
* from other methods defined on this class
* or instance. [TIP #500] */
+};
#define SCOPE_FLAGS (PUBLIC_METHOD | PRIVATE_METHOD | TRUE_PRIVATE_METHOD)
/*
* Structure containing definition information about basic class methods.
*/
-
-typedef struct {
+struct DeclaredClassMethod {
const char *name; /* Name of the method in question. */
int isPublic; /* Whether the method is public by default. */
Tcl_MethodType definition; /* How to call the method. */
-} DeclaredClassMethod;
+};
/*
*----------------------------------------------------------------
@@ -538,7 +549,7 @@ MODULE_SCOPE Tcl_Method TclNewInstanceMethod(Tcl_Interp *interp,
Tcl_Object object, Tcl_Obj *nameObj,
int flags, const Tcl_MethodType *typePtr,
void *clientData);
-MODULE_SCOPE Tcl_Method TclNewMethod(Tcl_Interp *interp, Tcl_Class cls,
+MODULE_SCOPE Tcl_Method TclNewMethod(Tcl_Class cls,
Tcl_Obj *nameObj, int flags,
const Tcl_MethodType *typePtr,
void *clientData);
@@ -595,7 +606,7 @@ MODULE_SCOPE int TclOOInvokeContext(void *clientData,
MODULE_SCOPE int TclNRObjectContextInvokeNext(Tcl_Interp *interp,
Tcl_ObjectContext context, Tcl_Size objc,
Tcl_Obj *const *objv, Tcl_Size skip);
-MODULE_SCOPE void TclOONewBasicMethod(Tcl_Interp *interp, Class *clsPtr,
+MODULE_SCOPE void TclOONewBasicMethod(Class *clsPtr,
const DeclaredClassMethod *dcm);
MODULE_SCOPE Tcl_Obj * TclOOObjectName(Tcl_Interp *interp, Object *oPtr);
MODULE_SCOPE void TclOOReleaseClassContents(Tcl_Interp *interp,
diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c
index f60b1c2..89e4d4e 100644
--- a/generic/tclOOMethod.c
+++ b/generic/tclOOMethod.c
@@ -21,7 +21,7 @@
* used in a procedure-like method.
*/
-typedef struct {
+typedef struct PMFrameData {
CallFrame *framePtr; /* Reference to the call frame itself (it's
* actually allocated on the Tcl stack). */
ProcErrorProc *errProc; /* The error handler for the body. */
@@ -34,7 +34,7 @@ typedef struct {
* on-the-ground resolvers used when working with resolved compiled variables.
*/
-typedef struct {
+typedef struct OOResVarInfo {
Tcl_ResolvedVarInfo info; /* "Type" information so that the compiled
* variable can be linked to the namespace
* variable at the right time. */
@@ -146,25 +146,25 @@ TclNewInstanceMethod(
int isNew;
if (nameObj == NULL) {
- mPtr = (Method *)Tcl_Alloc(sizeof(Method));
+ mPtr = (Method *) Tcl_Alloc(sizeof(Method));
mPtr->namePtr = NULL;
mPtr->refCount = 1;
goto populate;
}
if (!oPtr->methodsPtr) {
- oPtr->methodsPtr = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable));
+ oPtr->methodsPtr = (Tcl_HashTable *) Tcl_Alloc(sizeof(Tcl_HashTable));
Tcl_InitObjHashTable(oPtr->methodsPtr);
oPtr->flags &= ~USE_CLASS_CACHE;
}
hPtr = Tcl_CreateHashEntry(oPtr->methodsPtr, nameObj, &isNew);
if (isNew) {
- mPtr = (Method *)Tcl_Alloc(sizeof(Method));
+ mPtr = (Method *) Tcl_Alloc(sizeof(Method));
mPtr->namePtr = nameObj;
mPtr->refCount = 1;
Tcl_IncrRefCount(nameObj);
Tcl_SetHashValue(hPtr, mPtr);
} else {
- mPtr = (Method *)Tcl_GetHashValue(hPtr);
+ mPtr = (Method *) Tcl_GetHashValue(hPtr);
if (mPtr->typePtr != NULL && mPtr->typePtr->deleteProc != NULL) {
mPtr->typePtr->deleteProc(mPtr->clientData);
}
@@ -203,10 +203,11 @@ Tcl_NewInstanceMethod(
* method to be created. */
{
if (typePtr->version > TCL_OO_METHOD_VERSION_1) {
- Tcl_Panic("%s: Wrong version in typePtr->version, should be TCL_OO_METHOD_VERSION_1", "Tcl_NewInstanceMethod");
+ Tcl_Panic("%s: Wrong version in typePtr->version, should be %s",
+ "Tcl_NewInstanceMethod", "TCL_OO_METHOD_VERSION_1");
}
- return TclNewInstanceMethod(NULL, object, nameObj, flags,
- (const Tcl_MethodType *)typePtr, clientData);
+ return TclNewInstanceMethod(NULL, object, nameObj, flags, typePtr,
+ clientData);
}
Tcl_Method
Tcl_NewInstanceMethod2(
@@ -225,10 +226,11 @@ Tcl_NewInstanceMethod2(
* method to be created. */
{
if (typePtr->version < TCL_OO_METHOD_VERSION_2) {
- Tcl_Panic("%s: Wrong version in typePtr->version, should be TCL_OO_METHOD_VERSION_2", "Tcl_NewInstanceMethod2");
+ Tcl_Panic("%s: Wrong version in typePtr->version, should be %s",
+ "Tcl_NewInstanceMethod2", "TCL_OO_METHOD_VERSION_2");
}
return TclNewInstanceMethod(NULL, object, nameObj, flags,
- (const Tcl_MethodType *)typePtr, clientData);
+ (const Tcl_MethodType *) typePtr, clientData);
}
/*
@@ -243,7 +245,6 @@ Tcl_NewInstanceMethod2(
Tcl_Method
TclNewMethod(
- TCL_UNUSED(Tcl_Interp *),
Tcl_Class cls, /* The class to attach the method to. */
Tcl_Obj *nameObj, /* The name of the object. May be NULL (e.g.,
* for constructors or destructors); if so, up
@@ -262,20 +263,20 @@ TclNewMethod(
int isNew;
if (nameObj == NULL) {
- mPtr = (Method *)Tcl_Alloc(sizeof(Method));
+ mPtr = (Method *) Tcl_Alloc(sizeof(Method));
mPtr->namePtr = NULL;
mPtr->refCount = 1;
goto populate;
}
- hPtr = Tcl_CreateHashEntry(&clsPtr->classMethods, nameObj,&isNew);
+ hPtr = Tcl_CreateHashEntry(&clsPtr->classMethods, nameObj, &isNew);
if (isNew) {
- mPtr = (Method *)Tcl_Alloc(sizeof(Method));
+ mPtr = (Method *) Tcl_Alloc(sizeof(Method));
mPtr->refCount = 1;
mPtr->namePtr = nameObj;
Tcl_IncrRefCount(nameObj);
Tcl_SetHashValue(hPtr, mPtr);
} else {
- mPtr = (Method *)Tcl_GetHashValue(hPtr);
+ mPtr = (Method *) Tcl_GetHashValue(hPtr);
if (mPtr->typePtr != NULL && mPtr->typePtr->deleteProc != NULL) {
mPtr->typePtr->deleteProc(mPtr->clientData);
}
@@ -315,9 +316,10 @@ Tcl_NewMethod(
* method to be created. */
{
if (typePtr->version > TCL_OO_METHOD_VERSION_1) {
- Tcl_Panic("%s: Wrong version in typePtr->version, should be TCL_OO_METHOD_VERSION_1", "Tcl_NewMethod");
+ Tcl_Panic("%s: Wrong version in typePtr->version, should be %s",
+ "Tcl_NewMethod", "TCL_OO_METHOD_VERSION_1");
}
- return TclNewMethod(NULL, cls, nameObj, flags, typePtr, clientData);
+ return TclNewMethod(cls, nameObj, flags, typePtr, clientData);
}
Tcl_Method
@@ -336,9 +338,11 @@ Tcl_NewMethod2(
* method to be created. */
{
if (typePtr->version < TCL_OO_METHOD_VERSION_2) {
- Tcl_Panic("%s: Wrong version in typePtr->version, should be TCL_OO_METHOD_VERSION_2", "Tcl_NewMethod2");
+ Tcl_Panic("%s: Wrong version in typePtr->version, should be %s",
+ "Tcl_NewMethod2", "TCL_OO_METHOD_VERSION_2");
}
- return TclNewMethod(NULL, cls, nameObj, flags, (const Tcl_MethodType *)typePtr, clientData);
+ return TclNewMethod(cls, nameObj, flags,
+ (const Tcl_MethodType *) typePtr, clientData);
}
/*
@@ -380,7 +384,6 @@ TclOODelMethodRef(
void
TclOONewBasicMethod(
- Tcl_Interp *interp,
Class *clsPtr, /* Class to attach the method to. */
const DeclaredClassMethod *dcm)
/* Name of the method, whether it is public,
@@ -388,10 +391,9 @@ TclOONewBasicMethod(
{
Tcl_Obj *namePtr = Tcl_NewStringObj(dcm->name, -1);
- Tcl_IncrRefCount(namePtr);
- TclNewMethod(interp, (Tcl_Class) clsPtr, namePtr,
+ TclNewMethod((Tcl_Class) clsPtr, namePtr,
(dcm->isPublic ? PUBLIC_METHOD : 0), &dcm->definition, NULL);
- Tcl_DecrRefCount(namePtr);
+ Tcl_BounceRefCount(namePtr);
}
/*
@@ -550,7 +552,7 @@ InitCmdFrame(
if (context.line && context.nline > 1
&& (context.line[context.nline - 1] >= 0)) {
int isNew;
- CmdFrame *cfPtr = (CmdFrame *)Tcl_Alloc(sizeof(CmdFrame));
+ CmdFrame *cfPtr = (CmdFrame *) Tcl_Alloc(sizeof(CmdFrame));
Tcl_HashEntry *hPtr;
cfPtr->level = -1;
@@ -678,8 +680,8 @@ TclOOMakeProcMethod(
InitCmdFrame(iPtr, procPtr);
- return TclNewMethod(interp, (Tcl_Class) clsPtr, nameObj, flags, typePtr,
- clientData);
+ return TclNewMethod(
+ (Tcl_Class) clsPtr, nameObj, flags, typePtr, clientData);
}
/*
@@ -700,7 +702,7 @@ InvokeProcedureMethod(
int objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* Arguments as actually seen. */
{
- ProcedureMethod *pmPtr = (ProcedureMethod *)clientData;
+ ProcedureMethod *pmPtr = (ProcedureMethod *) clientData;
int result;
PMFrameData *fdPtr; /* Important data that has to have a lifetime
* matched by this function (or rather, by the
@@ -711,7 +713,7 @@ InvokeProcedureMethod(
* the next thing in the chain.
*/
- if (TclOOObjectDestroyed(((CallContext *)context)->oPtr)
+ if (TclOOObjectDestroyed(((CallContext *) context)->oPtr)
|| Tcl_InterpDeleted(interp)) {
return TclNRObjectContextInvokeNext(interp, context, objc, objv,
Tcl_ObjectContextSkippedArgs(context));
@@ -752,7 +754,7 @@ InvokeProcedureMethod(
* Allocate the special frame data.
*/
- fdPtr = (PMFrameData *)TclStackAlloc(interp, sizeof(PMFrameData));
+ fdPtr = (PMFrameData *) TclStackAlloc(interp, sizeof(PMFrameData));
/*
* Create a call frame for this method.
@@ -802,9 +804,9 @@ FinalizePMCall(
Tcl_Interp *interp,
int result)
{
- ProcedureMethod *pmPtr = (ProcedureMethod *)data[0];
- Tcl_ObjectContext context = (Tcl_ObjectContext)data[1];
- PMFrameData *fdPtr = (PMFrameData *)data[2];
+ ProcedureMethod *pmPtr = (ProcedureMethod *) data[0];
+ Tcl_ObjectContext context = (Tcl_ObjectContext) data[1];
+ PMFrameData *fdPtr = (PMFrameData *) data[2];
/*
* Give the post-call callback a chance to do some cleanup. Note that at
@@ -998,7 +1000,7 @@ ProcedureMethodCompiledVarConnect(
if (framePtr == NULL || !(framePtr->isProcCallFrame & FRAME_IS_METHOD)) {
return NULL;
}
- contextPtr = (CallContext *)framePtr->clientData;
+ contextPtr = (CallContext *) framePtr->clientData;
/*
* If we've done the work before (in a comparable context) then reuse that
@@ -1118,7 +1120,7 @@ ProcedureMethodCompiledVarResolver(
return TCL_CONTINUE;
}
- infoPtr = (OOResVarInfo *)Tcl_Alloc(sizeof(OOResVarInfo));
+ infoPtr = (OOResVarInfo *) Tcl_Alloc(sizeof(OOResVarInfo));
infoPtr->info.fetchProc = ProcedureMethodCompiledVarConnect;
infoPtr->info.deleteProc = ProcedureMethodCompiledVarDelete;
infoPtr->cachedObjectVar = NULL;
@@ -1208,7 +1210,8 @@ MethodErrorHandler(
// We pull the method name out of context instead of from argument
{
Tcl_Size nameLen, objectNameLen;
- CallContext *contextPtr = (CallContext *)((Interp *) interp)->varFramePtr->clientData;
+ CallContext *contextPtr = (CallContext *)
+ ((Interp *) interp)->varFramePtr->clientData;
Method *mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr;
const char *objectName, *kindName, *methodName =
Tcl_GetStringFromObj(mPtr->namePtr, &nameLen);
@@ -1239,7 +1242,8 @@ ConstructorErrorHandler(
TCL_UNUSED(Tcl_Obj *) /*methodNameObj*/)
// Ignore. We know it is the constructor.
{
- CallContext *contextPtr = (CallContext *)((Interp *) interp)->varFramePtr->clientData;
+ CallContext *contextPtr = (CallContext *)
+ ((Interp *) interp)->varFramePtr->clientData;
Method *mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr;
Object *declarerPtr;
const char *objectName, *kindName;
@@ -1269,7 +1273,8 @@ DestructorErrorHandler(
TCL_UNUSED(Tcl_Obj *) /*methodNameObj*/)
// Ignore. We know it is the destructor.
{
- CallContext *contextPtr = (CallContext *)((Interp *) interp)->varFramePtr->clientData;
+ CallContext *contextPtr = (CallContext *)
+ ((Interp *) interp)->varFramePtr->clientData;
Method *mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr;
Object *declarerPtr;
const char *objectName, *kindName;
@@ -1318,7 +1323,7 @@ static void
DeleteProcedureMethod(
void *clientData)
{
- ProcedureMethod *pmPtr = (ProcedureMethod *)clientData;
+ ProcedureMethod *pmPtr = (ProcedureMethod *) clientData;
if (pmPtr->refCount-- <= 1) {
DeleteProcedureMethodRecord(pmPtr);
@@ -1331,7 +1336,7 @@ CloneProcedureMethod(
void *clientData,
void **newClientData)
{
- ProcedureMethod *pmPtr = (ProcedureMethod *)clientData;
+ ProcedureMethod *pmPtr = (ProcedureMethod *) clientData;
ProcedureMethod *pm2Ptr;
Tcl_Obj *bodyObj, *argsObj;
CompiledLocal *localPtr;
@@ -1370,7 +1375,7 @@ CloneProcedureMethod(
* record.
*/
- pm2Ptr = (ProcedureMethod *)Tcl_Alloc(sizeof(ProcedureMethod));
+ pm2Ptr = (ProcedureMethod *) Tcl_Alloc(sizeof(ProcedureMethod));
memcpy(pm2Ptr, pmPtr, sizeof(ProcedureMethod));
pm2Ptr->refCount = 1;
pm2Ptr->cmd.clientData = &pm2Ptr->efi;
@@ -1426,7 +1431,7 @@ TclOONewForwardInstanceMethod(
return NULL;
}
- fmPtr = (ForwardMethod *)Tcl_Alloc(sizeof(ForwardMethod));
+ fmPtr = (ForwardMethod *) Tcl_Alloc(sizeof(ForwardMethod));
fmPtr->prefixObj = prefixObj;
Tcl_IncrRefCount(prefixObj);
return (Method *) TclNewInstanceMethod(interp, (Tcl_Object) oPtr,
@@ -1465,10 +1470,10 @@ TclOONewForwardMethod(
return NULL;
}
- fmPtr = (ForwardMethod *)Tcl_Alloc(sizeof(ForwardMethod));
+ fmPtr = (ForwardMethod *) Tcl_Alloc(sizeof(ForwardMethod));
fmPtr->prefixObj = prefixObj;
Tcl_IncrRefCount(prefixObj);
- return (Method *) TclNewMethod(interp, (Tcl_Class) clsPtr, nameObj,
+ return (Method *) TclNewMethod((Tcl_Class) clsPtr, nameObj,
flags, &fwdMethodType, fmPtr);
}
@@ -1492,7 +1497,7 @@ InvokeForwardMethod(
Tcl_Obj *const *objv) /* Arguments as actually seen. */
{
CallContext *contextPtr = (CallContext *) context;
- ForwardMethod *fmPtr = (ForwardMethod *)clientData;
+ ForwardMethod *fmPtr = (ForwardMethod *) clientData;
Tcl_Obj **argObjs, **prefixObjs;
Tcl_Size numPrefixes, skip = contextPtr->skip;
int len;
@@ -1513,8 +1518,8 @@ InvokeForwardMethod(
* of the TCL_EVAL_NOERR flag results in an evaluation configuration
* very much like TCL_EVAL_INVOKE.
*/
- ((Interp *)interp)->lookupNsPtr
- = (Namespace *) contextPtr->oPtr->namespacePtr;
+ ((Interp *) interp)->lookupNsPtr = (Namespace *)
+ contextPtr->oPtr->namespacePtr;
return TclNREvalObjv(interp, len, argObjs, TCL_EVAL_NOERR, NULL);
}
@@ -1524,7 +1529,7 @@ FinalizeForwardCall(
Tcl_Interp *interp,
int result)
{
- Tcl_Obj **argObjs = (Tcl_Obj **)data[0];
+ Tcl_Obj **argObjs = (Tcl_Obj **) data[0];
TclStackFree(interp, argObjs);
return result;
@@ -1544,7 +1549,7 @@ static void
DeleteForwardMethod(
void *clientData)
{
- ForwardMethod *fmPtr = (ForwardMethod *)clientData;
+ ForwardMethod *fmPtr = (ForwardMethod *) clientData;
Tcl_DecrRefCount(fmPtr->prefixObj);
Tcl_Free(fmPtr);
@@ -1556,8 +1561,8 @@ CloneForwardMethod(
void *clientData,
void **newClientData)
{
- ForwardMethod *fmPtr = (ForwardMethod *)clientData;
- ForwardMethod *fm2Ptr = (ForwardMethod *)Tcl_Alloc(sizeof(ForwardMethod));
+ ForwardMethod *fmPtr = (ForwardMethod *) clientData;
+ ForwardMethod *fm2Ptr = (ForwardMethod *) Tcl_Alloc(sizeof(ForwardMethod));
fm2Ptr->prefixObj = fmPtr->prefixObj;
Tcl_IncrRefCount(fm2Ptr->prefixObj);
@@ -1581,7 +1586,7 @@ TclOOGetProcFromMethod(
Method *mPtr)
{
if (mPtr->typePtr == &procMethodType) {
- ProcedureMethod *pmPtr = (ProcedureMethod *)mPtr->clientData;
+ ProcedureMethod *pmPtr = (ProcedureMethod *) mPtr->clientData;
return pmPtr->procPtr;
}
@@ -1593,7 +1598,7 @@ TclOOGetMethodBody(
Method *mPtr)
{
if (mPtr->typePtr == &procMethodType) {
- ProcedureMethod *pmPtr = (ProcedureMethod *)mPtr->clientData;
+ ProcedureMethod *pmPtr = (ProcedureMethod *) mPtr->clientData;
(void) TclGetString(pmPtr->procPtr->bodyPtr);
return pmPtr->procPtr->bodyPtr;
@@ -1606,7 +1611,7 @@ TclOOGetFwdFromMethod(
Method *mPtr)
{
if (mPtr->typePtr == &fwdMethodType) {
- ForwardMethod *fwPtr = (ForwardMethod *)mPtr->clientData;
+ ForwardMethod *fwPtr = (ForwardMethod *) mPtr->clientData;
return fwPtr->prefixObj;
}
@@ -1648,7 +1653,8 @@ InitEnsembleRewrite(
* array of rewritten arguments. */
{
size_t len = rewriteLength + objc - toRewrite;
- Tcl_Obj **argObjs = (Tcl_Obj **)TclStackAlloc(interp, sizeof(Tcl_Obj *) * len);
+ Tcl_Obj **argObjs = (Tcl_Obj **)
+ TclStackAlloc(interp, sizeof(Tcl_Obj *) * len);
memcpy(argObjs, rewriteObjs, rewriteLength * sizeof(Tcl_Obj *));
memcpy(argObjs + rewriteLength, objv + toRewrite,
@@ -1725,7 +1731,8 @@ Tcl_MethodIsType(
Method *mPtr = (Method *) method;
if (typePtr->version > TCL_OO_METHOD_VERSION_1) {
- Tcl_Panic("%s: Wrong version in typePtr->version, should be TCL_OO_METHOD_VERSION_1", "Tcl_MethodIsType");
+ Tcl_Panic("%s: Wrong version in typePtr->version, should be %s",
+ "Tcl_MethodIsType", "TCL_OO_METHOD_VERSION_1");
}
if (mPtr->typePtr == typePtr) {
if (clientDataPtr != NULL) {
@@ -1745,9 +1752,10 @@ Tcl_MethodIsType2(
Method *mPtr = (Method *) method;
if (typePtr->version < TCL_OO_METHOD_VERSION_2) {
- Tcl_Panic("%s: Wrong version in typePtr->version, should be TCL_OO_METHOD_VERSION_2", "Tcl_MethodIsType2");
+ Tcl_Panic("%s: Wrong version in typePtr->version, should be %s",
+ "Tcl_MethodIsType2", "TCL_OO_METHOD_VERSION_2");
}
- if (mPtr->typePtr == (const Tcl_MethodType *)typePtr) {
+ if (mPtr->typePtr == (const Tcl_MethodType *) typePtr) {
if (clientDataPtr != NULL) {
*clientDataPtr = mPtr->clientData;
}
@@ -1760,14 +1768,14 @@ int
Tcl_MethodIsPublic(
Tcl_Method method)
{
- return (((Method *)method)->flags & PUBLIC_METHOD) ? 1 : 0;
+ return (((Method *) method)->flags & PUBLIC_METHOD) ? 1 : 0;
}
int
Tcl_MethodIsPrivate(
Tcl_Method method)
{
- return (((Method *)method)->flags & TRUE_PRIVATE_METHOD) ? 1 : 0;
+ return (((Method *) method)->flags & TRUE_PRIVATE_METHOD) ? 1 : 0;
}
/*
generated by cgit v0.12 at 2024-11-16 10:09:19 (GMT)