Skip to content

Commit 0fb0b2b

Browse files
dkfellowsdkfellows
committed
Some factoring out of more internal bits of TclOO; no API change at all
1 parent bfe1df3 commit 0fb0b2b

File tree

5 files changed

+125
-106
lines changed

5 files changed

+125
-106
lines changed

‎generic/tclOOBasic.c‎

Lines changed: 62 additions & 60 deletions
Original file line numberDiff line numberDiff line change
@@ -25,6 +25,9 @@ static Tcl_NRPostProc FinalizeEval;
2525
static Tcl_NRPostProc NextRestoreFrame;
2626
static Tcl_NRPostProc MarkAsSingleton;
2727
static Tcl_NRPostProc UpdateClassDelegatesAfterClone;
28+
29+
#define CurrentlyInvoked(contextPtr) \
30+
((contextPtr)->callPtr->chain[(contextPtr)->index])
2831

2932
/*
3033
* ----------------------------------------------------------------------
@@ -857,8 +860,7 @@ TclOO_Object_Unknown(
857860

858861
if (framePtr->isProcCallFrame & FRAME_IS_METHOD) {
859862
CallContext *callerContext = (CallContext *) framePtr->clientData;
860-
Method *mPtr = callerContext->callPtr->chain[
861-
callerContext->index].mPtr;
863+
Method *mPtr = CurrentlyInvoked(callerContext).mPtr;
862864

863865
if (mPtr->declaringObjectPtr) {
864866
if (oPtr == mPtr->declaringObjectPtr) {
@@ -1072,8 +1074,7 @@ TclOOLookupObjectVar(
10721074
if (framePtr->isProcCallFrame & FRAME_IS_METHOD) {
10731075
Object *oPtr = (Object *) object;
10741076
CallContext *callerContext = (CallContext *) framePtr->clientData;
1075-
Method *mPtr = callerContext->callPtr->chain[
1076-
callerContext->index].mPtr;
1077+
Method *mPtr = CurrentlyInvoked(callerContext).mPtr;
10771078
PrivateVariableMapping *pvPtr;
10781079
Tcl_Size i;
10791080

@@ -1426,6 +1427,53 @@ NextRestoreFrame(
14261427
return result;
14271428
}
14281429

1430+
/*
1431+
* ----------------------------------------------------------------------
1432+
*
1433+
* MethodName --
1434+
*
1435+
* Helper for TclOOSelfObjCmd to generate the correct name for a method.
1436+
*
1437+
* ----------------------------------------------------------------------
1438+
*/
1439+
static inline Tcl_Obj *
1440+
MethodName(
1441+
Foundation *fPtr,
1442+
CallContext *contextPtr,
1443+
Method *mPtr)
1444+
{
1445+
switch (contextPtr->callPtr->flags & (CONSTRUCTOR | DESTRUCTOR)) {
1446+
case CONSTRUCTOR:
1447+
return fPtr->constructorName;
1448+
case DESTRUCTOR:
1449+
return fPtr->destructorName;
1450+
default:
1451+
return mPtr->namePtr;
1452+
}
1453+
}
1454+
1455+
/*
1456+
* ----------------------------------------------------------------------
1457+
*
1458+
* Declarer --
1459+
*
1460+
* Helper for TclOOSelfObjCmd to get the (named) entity declaring a method.
1461+
*
1462+
* ----------------------------------------------------------------------
1463+
*/
1464+
static inline Object *
1465+
Declarer(
1466+
Method *mPtr)
1467+
{
1468+
if (mPtr->declaringClassPtr != NULL) {
1469+
return mPtr->declaringClassPtr->thisPtr;
1470+
} else if (mPtr->declaringObjectPtr != NULL) {
1471+
return mPtr->declaringObjectPtr;
1472+
} else {
1473+
TCL_UNREACHABLE();
1474+
}
1475+
}
1476+
14291477
/*
14301478
* ----------------------------------------------------------------------
14311479
*
@@ -1453,13 +1501,11 @@ TclOOSelfObjCmd(
14531501
SELF_NEXT, SELF_OBJECT, SELF_TARGET
14541502
} index;
14551503
Interp *iPtr = (Interp *) interp;
1504+
Foundation *fPtr = (Foundation *) iPtr->objectFoundation;
14561505
CallFrame *framePtr = iPtr->varFramePtr;
14571506
CallContext *contextPtr;
14581507
Tcl_Obj *result[3];
14591508

1460-
#define CurrentlyInvoked(contextPtr) \
1461-
((contextPtr)->callPtr->chain[(contextPtr)->index])
1462-
14631509
/*
14641510
* Start with sanity checks on the calling context and the method context.
14651511
*/
@@ -1507,14 +1553,8 @@ TclOOSelfObjCmd(
15071553
return TCL_OK;
15081554
}
15091555
case SELF_METHOD:
1510-
if (contextPtr->callPtr->flags & CONSTRUCTOR) {
1511-
Tcl_SetObjResult(interp, contextPtr->oPtr->fPtr->constructorName);
1512-
} else if (contextPtr->callPtr->flags & DESTRUCTOR) {
1513-
Tcl_SetObjResult(interp, contextPtr->oPtr->fPtr->destructorName);
1514-
} else {
1515-
Tcl_SetObjResult(interp,
1516-
CurrentlyInvoked(contextPtr).mPtr->namePtr);
1517-
}
1556+
Tcl_SetObjResult(interp, MethodName(fPtr, contextPtr,
1557+
CurrentlyInvoked(contextPtr).mPtr));
15181558
return TCL_OK;
15191559
case SELF_FILTER:
15201560
if (!CurrentlyInvoked(contextPtr).isFilter) {
@@ -1551,51 +1591,21 @@ TclOOSelfObjCmd(
15511591
} else {
15521592
CallContext *callerPtr = (CallContext *)
15531593
framePtr->callerVarPtr->clientData;
1554-
Method *mPtr = callerPtr->callPtr->chain[callerPtr->index].mPtr;
1555-
Object *declarerPtr;
1556-
1557-
if (mPtr->declaringClassPtr != NULL) {
1558-
declarerPtr = mPtr->declaringClassPtr->thisPtr;
1559-
} else if (mPtr->declaringObjectPtr != NULL) {
1560-
declarerPtr = mPtr->declaringObjectPtr;
1561-
} else {
1562-
TCL_UNREACHABLE();
1563-
}
1594+
Method *mPtr = CurrentlyInvoked(callerPtr).mPtr;
15641595

1565-
result[0] = TclOOObjectName(interp, declarerPtr);
1596+
result[0] = TclOOObjectName(interp, Declarer(mPtr));
15661597
result[1] = TclOOObjectName(interp, callerPtr->oPtr);
1567-
if (callerPtr->callPtr->flags & CONSTRUCTOR) {
1568-
result[2] = declarerPtr->fPtr->constructorName;
1569-
} else if (callerPtr->callPtr->flags & DESTRUCTOR) {
1570-
result[2] = declarerPtr->fPtr->destructorName;
1571-
} else {
1572-
result[2] = mPtr->namePtr;
1573-
}
1598+
result[2] = MethodName(fPtr, callerPtr, mPtr);
15741599
Tcl_SetObjResult(interp, Tcl_NewListObj(3, result));
15751600
return TCL_OK;
15761601
}
15771602
case SELF_NEXT:
15781603
if (contextPtr->index < contextPtr->callPtr->numChain - 1) {
15791604
Method *mPtr =
15801605
contextPtr->callPtr->chain[contextPtr->index + 1].mPtr;
1581-
Object *declarerPtr;
15821606

1583-
if (mPtr->declaringClassPtr != NULL) {
1584-
declarerPtr = mPtr->declaringClassPtr->thisPtr;
1585-
} else if (mPtr->declaringObjectPtr != NULL) {
1586-
declarerPtr = mPtr->declaringObjectPtr;
1587-
} else {
1588-
TCL_UNREACHABLE();
1589-
}
1590-
1591-
result[0] = TclOOObjectName(interp, declarerPtr);
1592-
if (contextPtr->callPtr->flags & CONSTRUCTOR) {
1593-
result[1] = declarerPtr->fPtr->constructorName;
1594-
} else if (contextPtr->callPtr->flags & DESTRUCTOR) {
1595-
result[1] = declarerPtr->fPtr->destructorName;
1596-
} else {
1597-
result[1] = mPtr->namePtr;
1598-
}
1607+
result[0] = TclOOObjectName(interp, Declarer(mPtr));
1608+
result[1] = MethodName(fPtr, contextPtr, mPtr);
15991609
Tcl_SetObjResult(interp, Tcl_NewListObj(2, result));
16001610
}
16011611
return TCL_OK;
@@ -1607,7 +1617,6 @@ TclOOSelfObjCmd(
16071617
return TCL_ERROR;
16081618
} else {
16091619
Method *mPtr;
1610-
Object *declarerPtr;
16111620
Tcl_Size i;
16121621

16131622
for (i=contextPtr->index ; i<contextPtr->callPtr->numChain ; i++) {
@@ -1619,15 +1628,8 @@ TclOOSelfObjCmd(
16191628
Tcl_Panic("filtering call chain without terminal non-filter");
16201629
}
16211630
mPtr = contextPtr->callPtr->chain[i].mPtr;
1622-
if (mPtr->declaringClassPtr != NULL) {
1623-
declarerPtr = mPtr->declaringClassPtr->thisPtr;
1624-
} else if (mPtr->declaringObjectPtr != NULL) {
1625-
declarerPtr = mPtr->declaringObjectPtr;
1626-
} else {
1627-
TCL_UNREACHABLE();
1628-
}
1629-
result[0] = TclOOObjectName(interp, declarerPtr);
1630-
result[1] = mPtr->namePtr;
1631+
result[0] = TclOOObjectName(interp, Declarer(mPtr));
1632+
result[1] = MethodName(fPtr, contextPtr, mPtr);
16311633
Tcl_SetObjResult(interp, Tcl_NewListObj(2, result));
16321634
return TCL_OK;
16331635
}

‎generic/tclOOCall.c‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1966,7 +1966,7 @@ TclOOGetDefineContextNamespace(
19661966
Tcl_Interp *interp, /* In what interpreter should namespace names
19671967
* actually be resolved. */
19681968
Object *oPtr, /* The object to get the context for. */
1969-
int forClass) /* What sort of context are we looking for.
1969+
bool forClass) /* What sort of context are we looking for.
19701970
* If true, we are going to use this for
19711971
* [oo::define], otherwise, we are going to
19721972
* use this for [oo::objdefine]. */

‎generic/tclOODefineCmds.c‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1410,7 +1410,7 @@ TclOODefineObjCmd(
14101410
* command(s).
14111411
*/
14121412

1413-
nsPtr = TclOOGetDefineContextNamespace(interp, oPtr, 1);
1413+
nsPtr = TclOOGetDefineContextNamespace(interp, oPtr, true);
14141414
if (InitDefineContext(interp, nsPtr, oPtr, objc, objv) != TCL_OK) {
14151415
return TCL_ERROR;
14161416
}
@@ -1479,7 +1479,7 @@ TclOOObjDefObjCmd(
14791479
* command(s).
14801480
*/
14811481

1482-
nsPtr = TclOOGetDefineContextNamespace(interp, oPtr, 0);
1482+
nsPtr = TclOOGetDefineContextNamespace(interp, oPtr, false);
14831483
if (InitDefineContext(interp, nsPtr, oPtr, objc, objv) != TCL_OK) {
14841484
return TCL_ERROR;
14851485
}
@@ -1550,7 +1550,7 @@ TclOODefineSelfObjCmd(
15501550
* command(s).
15511551
*/
15521552

1553-
nsPtr = TclOOGetDefineContextNamespace(interp, oPtr, 0);
1553+
nsPtr = TclOOGetDefineContextNamespace(interp, oPtr, false);
15541554
if (InitDefineContext(interp, nsPtr, oPtr, objc, objv) != TCL_OK) {
15551555
return TCL_ERROR;
15561556
}

‎generic/tclOOInt.h‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -601,7 +601,7 @@ MODULE_SCOPE Class * TclOOGetClassDefineCmdContext(Tcl_Interp *interp);
601601
MODULE_SCOPE Class * TclOOGetClassFromObj(Tcl_Interp *interp,
602602
Tcl_Obj *objPtr);
603603
MODULE_SCOPE Tcl_Namespace *TclOOGetDefineContextNamespace(
604-
Tcl_Interp *interp, Object *oPtr, int forClass);
604+
Tcl_Interp *interp, Object *oPtr, bool forClass);
605605
MODULE_SCOPE CallChain *TclOOGetStereotypeCallChain(Class *clsPtr,
606606
Tcl_Obj *methodNameObj, int flags);
607607
MODULE_SCOPE Foundation *TclOOGetFoundation(Tcl_Interp *interp);

‎generic/tclOOMethod.c‎

Lines changed: 58 additions & 41 deletions
Original file line numberDiff line numberDiff line change
@@ -1089,6 +1089,61 @@ ProcedureMethodVarResolver(
10891089
return (*varPtr ? TCL_OK : TCL_CONTINUE);
10901090
}
10911091

1092+
// Helper for ProcedureMethodCompiledVarConnect() that looks up if a variable
1093+
// is in the list of variables we want to resolve (and maps it to the
1094+
// implementation name, for private variables).
1095+
static inline Tcl_Obj *
1096+
GetRealVarName(
1097+
CallContext *contextPtr,
1098+
OOResVarInfo *infoPtr,
1099+
bool *cacheIt)
1100+
{
1101+
PrivateVariableMapping *privateVar;
1102+
Tcl_Size i, varLen, len;
1103+
const char *varName = Tcl_GetStringFromObj(infoPtr->variableObj, &varLen);
1104+
const char *match;
1105+
Tcl_Obj *variableObj;
1106+
1107+
if (contextPtr->callPtr->chain[contextPtr->index]
1108+
.mPtr->declaringClassPtr != NULL) {
1109+
FOREACH_STRUCT(privateVar, contextPtr->callPtr->chain[contextPtr->index]
1110+
.mPtr->declaringClassPtr->privateVariables) {
1111+
match = Tcl_GetStringFromObj(privateVar->variableObj, &len);
1112+
if ((len == varLen) && !memcmp(match, varName, len)) {
1113+
*cacheIt = false;
1114+
return privateVar->fullNameObj;
1115+
}
1116+
}
1117+
FOREACH(variableObj, contextPtr->callPtr->chain[contextPtr->index]
1118+
.mPtr->declaringClassPtr->variables) {
1119+
match = Tcl_GetStringFromObj(variableObj, &len);
1120+
if ((len == varLen) && !memcmp(match, varName, len)) {
1121+
*cacheIt = false;
1122+
return variableObj;
1123+
}
1124+
}
1125+
} else {
1126+
FOREACH_STRUCT(privateVar, contextPtr->oPtr->privateVariables) {
1127+
match = Tcl_GetStringFromObj(privateVar->variableObj, &len);
1128+
if ((len == varLen) && !memcmp(match, varName, len)) {
1129+
*cacheIt = true;
1130+
return privateVar->fullNameObj;
1131+
}
1132+
}
1133+
FOREACH(variableObj, contextPtr->oPtr->variables) {
1134+
match = Tcl_GetStringFromObj(variableObj, &len);
1135+
if ((len == varLen) && !memcmp(match, varName, len)) {
1136+
*cacheIt = true;
1137+
return variableObj;
1138+
}
1139+
}
1140+
}
1141+
return NULL;
1142+
}
1143+
1144+
// Called on entry to a compiled context to connect the local variables to
1145+
// be resolved to the actual variables in the object instance. If we want to
1146+
// connect it, we return the variable; otherwise NULL.
10921147
static Tcl_Var
10931148
ProcedureMethodCompiledVarConnect(
10941149
Tcl_Interp *interp,
@@ -1099,12 +1154,9 @@ ProcedureMethodCompiledVarConnect(
10991154
CallFrame *framePtr = iPtr->varFramePtr;
11001155
CallContext *contextPtr;
11011156
Tcl_Obj *variableObj;
1102-
PrivateVariableMapping *privateVar;
11031157
Tcl_HashEntry *hPtr;
11041158
int isNew;
11051159
bool cacheIt;
1106-
Tcl_Size i, varLen, len;
1107-
const char *match, *varName;
11081160

11091161
/*
11101162
* Check that the variable is being requested in a context that is also a
@@ -1132,50 +1184,15 @@ ProcedureMethodCompiledVarConnect(
11321184
* either.
11331185
*/
11341186

1135-
varName = Tcl_GetStringFromObj(infoPtr->variableObj, &varLen);
1136-
if (contextPtr->callPtr->chain[contextPtr->index]
1137-
.mPtr->declaringClassPtr != NULL) {
1138-
FOREACH_STRUCT(privateVar, contextPtr->callPtr->chain[contextPtr->index]
1139-
.mPtr->declaringClassPtr->privateVariables) {
1140-
match = Tcl_GetStringFromObj(privateVar->variableObj, &len);
1141-
if ((len == varLen) && !memcmp(match, varName, len)) {
1142-
variableObj = privateVar->fullNameObj;
1143-
cacheIt = false;
1144-
goto gotMatch;
1145-
}
1146-
}
1147-
FOREACH(variableObj, contextPtr->callPtr->chain[contextPtr->index]
1148-
.mPtr->declaringClassPtr->variables) {
1149-
match = Tcl_GetStringFromObj(variableObj, &len);
1150-
if ((len == varLen) && !memcmp(match, varName, len)) {
1151-
cacheIt = false;
1152-
goto gotMatch;
1153-
}
1154-
}
1155-
} else {
1156-
FOREACH_STRUCT(privateVar, contextPtr->oPtr->privateVariables) {
1157-
match = Tcl_GetStringFromObj(privateVar->variableObj, &len);
1158-
if ((len == varLen) && !memcmp(match, varName, len)) {
1159-
variableObj = privateVar->fullNameObj;
1160-
cacheIt = true;
1161-
goto gotMatch;
1162-
}
1163-
}
1164-
FOREACH(variableObj, contextPtr->oPtr->variables) {
1165-
match = Tcl_GetStringFromObj(variableObj, &len);
1166-
if ((len == varLen) && !memcmp(match, varName, len)) {
1167-
cacheIt = true;
1168-
goto gotMatch;
1169-
}
1170-
}
1187+
variableObj = GetRealVarName(contextPtr, infoPtr, &cacheIt);
1188+
if (!variableObj) {
1189+
return NULL;
11711190
}
1172-
return NULL;
11731191

11741192
/*
11751193
* It is a variable we want to resolve, so resolve it.
11761194
*/
11771195

1178-
gotMatch:
11791196
hPtr = Tcl_CreateHashEntry(TclVarTable(contextPtr->oPtr->namespacePtr),
11801197
variableObj, &isNew);
11811198
if (isNew) {

0 commit comments

Comments
 (0)