diff options
Diffstat (limited to 'generic/tclOOMethod.c')
| -rw-r--r-- | generic/tclOOMethod.c | 130 |
1 files changed, 80 insertions, 50 deletions
diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c index 3e64ba2..78421e1 100644 --- a/generic/tclOOMethod.c +++ b/generic/tclOOMethod.c @@ -67,7 +67,7 @@ static Tcl_Obj ** InitEnsembleRewrite(Tcl_Interp *interp, int objc, Tcl_Obj *const *objv, int toRewrite, int rewriteLength, Tcl_Obj *const *rewriteObjs, int *lengthPtr); -static int InvokeProcedureMethod(ClientData clientData, +static int InvokeProcedureMethod(void *clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv); static Tcl_NRPostProc FinalizeForwardCall; @@ -77,22 +77,22 @@ static int PushMethodCallFrame(Tcl_Interp *interp, int objc, Tcl_Obj *const *objv, PMFrameData *fdPtr); static void DeleteProcedureMethodRecord(ProcedureMethod *pmPtr); -static void DeleteProcedureMethod(ClientData clientData); +static void DeleteProcedureMethod(void *clientData); static int CloneProcedureMethod(Tcl_Interp *interp, - ClientData clientData, ClientData *newClientData); + void *clientData, void **newClientData); static void MethodErrorHandler(Tcl_Interp *interp, Tcl_Obj *procNameObj); static void ConstructorErrorHandler(Tcl_Interp *interp, Tcl_Obj *procNameObj); static void DestructorErrorHandler(Tcl_Interp *interp, Tcl_Obj *procNameObj); -static Tcl_Obj * RenderDeclarerName(ClientData clientData); -static int InvokeForwardMethod(ClientData clientData, +static Tcl_Obj * RenderDeclarerName(void *clientData); +static int InvokeForwardMethod(void *clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv); -static void DeleteForwardMethod(ClientData clientData); +static void DeleteForwardMethod(void *clientData); static int CloneForwardMethod(Tcl_Interp *interp, - ClientData clientData, ClientData *newClientData); + void *clientData, void **newClientData); static int ProcedureMethodVarResolver(Tcl_Interp *interp, const char *varName, Tcl_Namespace *contextNs, int flags, Tcl_Var *varPtr); @@ -121,7 +121,7 @@ static const Tcl_MethodType fwdMethodType = { #define TclVarTable(contextNs) \ ((Tcl_HashTable *) (&((Namespace *) (contextNs))->varTable)) #define TclVarHashGetValue(hPtr) \ - ((Tcl_Var) ((char *)hPtr - TclOffset(VarInHash, entry))) + ((Tcl_Var) ((char *)hPtr - offsetof(VarInHash, entry))) /* * ---------------------------------------------------------------------- @@ -146,11 +146,11 @@ Tcl_NewInstanceMethod( /* The type of method this is, which defines * how to invoke, delete and clone the * method. */ - ClientData clientData) /* Some data associated with the particular + void *clientData) /* Some data associated with the particular * method to be created. */ { - register Object *oPtr = (Object *) object; - register Method *mPtr; + Object *oPtr = (Object *) object; + Method *mPtr; Tcl_HashEntry *hPtr; int isNew; @@ -186,7 +186,11 @@ Tcl_NewInstanceMethod( mPtr->declaringObjectPtr = oPtr; mPtr->declaringClassPtr = NULL; if (flags) { - mPtr->flags |= flags & (PUBLIC_METHOD | PRIVATE_METHOD); + mPtr->flags |= flags & + (PUBLIC_METHOD | PRIVATE_METHOD | TRUE_PRIVATE_METHOD); + if (flags & TRUE_PRIVATE_METHOD) { + oPtr->flags |= HAS_PRIVATE_METHODS; + } } oPtr->epoch++; return (Tcl_Method) mPtr; @@ -214,11 +218,11 @@ Tcl_NewMethod( /* The type of method this is, which defines * how to invoke, delete and clone the * method. */ - ClientData clientData) /* Some data associated with the particular + void *clientData) /* Some data associated with the particular * method to be created. */ { - register Class *clsPtr = (Class *) cls; - register Method *mPtr; + Class *clsPtr = (Class *) cls; + Method *mPtr; Tcl_HashEntry *hPtr; int isNew; @@ -250,7 +254,11 @@ Tcl_NewMethod( mPtr->declaringObjectPtr = NULL; mPtr->declaringClassPtr = clsPtr; if (flags) { - mPtr->flags |= flags & (PUBLIC_METHOD | PRIVATE_METHOD); + mPtr->flags |= flags & + (PUBLIC_METHOD | PRIVATE_METHOD | TRUE_PRIVATE_METHOD); + if (flags & TRUE_PRIVATE_METHOD) { + clsPtr->flags |= HAS_PRIVATE_METHODS; + } } return (Tcl_Method) mPtr; @@ -336,7 +344,7 @@ TclOONewProcInstanceMethod( * interested. */ { int argsLen; - register ProcedureMethod *pmPtr; + ProcedureMethod *pmPtr; Tcl_Method method; if (Tcl_ListObjLength(interp, argsObj, &argsLen) != TCL_OK) { @@ -388,7 +396,7 @@ TclOONewProcMethod( * interested. */ { int argsLen; /* -1 => delete argsObj before exit */ - register ProcedureMethod *pmPtr; + ProcedureMethod *pmPtr; const char *procName; Tcl_Method method; @@ -450,7 +458,7 @@ TclOOMakeProcInstanceMethod( * NULL. */ const Tcl_MethodType *typePtr, /* The type of the method to create. */ - ClientData clientData, /* The per-method type-specific data. */ + void *clientData, /* The per-method type-specific data. */ Proc **procPtrPtr) /* A pointer to the variable in which to write * the procedure record reference. Presumably * inside the structure indicated by the @@ -563,7 +571,7 @@ TclOOMakeProcMethod( * NULL. */ const Tcl_MethodType *typePtr, /* The type of the method to create. */ - ClientData clientData, /* The per-method type-specific data. */ + void *clientData, /* The per-method type-specific data. */ Proc **procPtrPtr) /* A pointer to the variable in which to write * the procedure record reference. Presumably * inside the structure indicated by the @@ -658,7 +666,7 @@ TclOOMakeProcMethod( static int InvokeProcedureMethod( - ClientData clientData, /* Pointer to some per-method context. */ + void *clientData, /* Pointer to some per-method context. */ Tcl_Interp *interp, Tcl_ObjectContext context, /* The method calling context. */ int objc, /* Number of arguments. */ @@ -737,7 +745,7 @@ InvokeProcedureMethod( static int FinalizePMCall( - ClientData data[], + void *data[], Tcl_Interp *interp, int result) { @@ -788,9 +796,10 @@ PushMethodCallFrame( * frame. */ { Namespace *nsPtr = (Namespace *) contextPtr->oPtr->namespacePtr; - register int result; + int result; const char *namePtr; CallFrame **framePtrPtr = &fdPtr->framePtr; + ByteCode *codePtr; /* * Compute basic information on the basis of the type of method it is. @@ -820,7 +829,7 @@ PushMethodCallFrame( */ if (pmPtr->flags & USE_DECLARER_NS) { - register Method *mPtr = + Method *mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr; if (mPtr->declaringClassPtr != NULL) { @@ -856,10 +865,8 @@ PushMethodCallFrame( * alternative is *so* slow... */ - if (pmPtr->procPtr->bodyPtr->typePtr == &tclByteCodeType) { - ByteCode *codePtr = - pmPtr->procPtr->bodyPtr->internalRep.twoPtrValue.ptr1; - + ByteCodeGetIntRep(pmPtr->procPtr->bodyPtr, &tclByteCodeType, codePtr); + if (codePtr) { codePtr->nsPtr = nsPtr; } result = TclProcCompileProc(interp, pmPtr->procPtr, @@ -893,7 +900,7 @@ PushMethodCallFrame( fdPtr->efi.fields[1].proc = pmPtr->gfivProc; fdPtr->efi.fields[1].clientData = pmPtr; } else { - register Tcl_Method method = + Tcl_Method method = Tcl_ObjectContextMethod((Tcl_ObjectContext) contextPtr); if (Tcl_MethodDeclarerObject(method) != NULL) { @@ -928,7 +935,7 @@ PushMethodCallFrame( * variables used in methods. The compiled variable resolver is more * important, but both are needed as it is possible to have a variable * that is only referred to in ways that aren't compilable and we can't - * force LVT presence. [TIP #320] + * force LVT presence. [TIP #320, #500] * * ---------------------------------------------------------------------- */ @@ -984,6 +991,7 @@ ProcedureMethodCompiledVarConnect( CallFrame *framePtr = iPtr->varFramePtr; CallContext *contextPtr; Tcl_Obj *variableObj; + PrivateVariableMapping *privateVar; Tcl_HashEntry *hPtr; int i, isNew, cacheIt, varLen, len; const char *match, *varName; @@ -1017,6 +1025,15 @@ ProcedureMethodCompiledVarConnect( varName = TclGetStringFromObj(infoPtr->variableObj, &varLen); if (contextPtr->callPtr->chain[contextPtr->index] .mPtr->declaringClassPtr != NULL) { + FOREACH_STRUCT(privateVar, contextPtr->callPtr->chain[contextPtr->index] + .mPtr->declaringClassPtr->privateVariables) { + match = TclGetStringFromObj(privateVar->variableObj, &len); + if ((len == varLen) && !memcmp(match, varName, len)) { + variableObj = privateVar->fullNameObj; + cacheIt = 0; + goto gotMatch; + } + } FOREACH(variableObj, contextPtr->callPtr->chain[contextPtr->index] .mPtr->declaringClassPtr->variables) { match = TclGetStringFromObj(variableObj, &len); @@ -1026,6 +1043,14 @@ ProcedureMethodCompiledVarConnect( } } } else { + FOREACH_STRUCT(privateVar, contextPtr->oPtr->privateVariables) { + match = TclGetStringFromObj(privateVar->variableObj, &len); + if ((len == varLen) && !memcmp(match, varName, len)) { + variableObj = privateVar->fullNameObj; + cacheIt = 1; + goto gotMatch; + } + } FOREACH(variableObj, contextPtr->oPtr->variables) { match = TclGetStringFromObj(variableObj, &len); if ((len == varLen) && !memcmp(match, varName, len)) { @@ -1125,7 +1150,7 @@ ProcedureMethodCompiledVarResolver( static Tcl_Obj * RenderDeclarerName( - ClientData clientData) + void *clientData) { struct PNI *pni = clientData; Tcl_Object object = Tcl_MethodDeclarerObject(pni->method); @@ -1164,7 +1189,7 @@ MethodErrorHandler( CallContext *contextPtr = ((Interp *) interp)->varFramePtr->clientData; Method *mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr; const char *objectName, *kindName, *methodName = - Tcl_GetStringFromObj(mPtr->namePtr, &nameLen); + TclGetStringFromObj(mPtr->namePtr, &nameLen); Object *declarerPtr; if (mPtr->declaringObjectPtr != NULL) { @@ -1267,9 +1292,9 @@ DeleteProcedureMethodRecord( static void DeleteProcedureMethod( - ClientData clientData) + void *clientData) { - register ProcedureMethod *pmPtr = clientData; + ProcedureMethod *pmPtr = clientData; if (pmPtr->refCount-- <= 1) { DeleteProcedureMethodRecord(pmPtr); @@ -1279,8 +1304,8 @@ DeleteProcedureMethod( static int CloneProcedureMethod( Tcl_Interp *interp, - ClientData clientData, - ClientData *newClientData) + void *clientData, + void **newClientData) { ProcedureMethod *pmPtr = clientData; ProcedureMethod *pm2Ptr; @@ -1313,7 +1338,7 @@ CloneProcedureMethod( bodyObj = Tcl_DuplicateObj(pmPtr->procPtr->bodyPtr); Tcl_GetString(bodyObj); - TclFreeIntRep(bodyObj); + Tcl_StoreIntRep(pmPtr->procPtr->bodyPtr, &tclByteCodeType, NULL); /* * Create the actual copy of the method record, manufacturing a new proc @@ -1362,7 +1387,7 @@ TclOONewForwardInstanceMethod( * prefix to forward to. */ { int prefixLen; - register ForwardMethod *fmPtr; + ForwardMethod *fmPtr; if (Tcl_ListObjLength(interp, prefixObj, &prefixLen) != TCL_OK) { return NULL; @@ -1401,7 +1426,7 @@ TclOONewForwardMethod( * prefix to forward to. */ { int prefixLen; - register ForwardMethod *fmPtr; + ForwardMethod *fmPtr; if (Tcl_ListObjLength(interp, prefixObj, &prefixLen) != TCL_OK) { return NULL; @@ -1433,7 +1458,7 @@ TclOONewForwardMethod( static int InvokeForwardMethod( - ClientData clientData, /* Pointer to some per-method context. */ + void *clientData, /* Pointer to some per-method context. */ Tcl_Interp *interp, Tcl_ObjectContext context, /* The method calling context. */ int objc, /* Number of arguments. */ @@ -1467,7 +1492,7 @@ InvokeForwardMethod( static int FinalizeForwardCall( - ClientData data[], + void *data[], Tcl_Interp *interp, int result) { @@ -1489,7 +1514,7 @@ FinalizeForwardCall( static void DeleteForwardMethod( - ClientData clientData) + void *clientData) { ForwardMethod *fmPtr = clientData; @@ -1500,8 +1525,8 @@ DeleteForwardMethod( static int CloneForwardMethod( Tcl_Interp *interp, - ClientData clientData, - ClientData *newClientData) + void *clientData, + void **newClientData) { ForwardMethod *fmPtr = clientData; ForwardMethod *fm2Ptr = ckalloc(sizeof(ForwardMethod)); @@ -1542,9 +1567,7 @@ TclOOGetMethodBody( if (mPtr->typePtr == &procMethodType) { ProcedureMethod *pmPtr = mPtr->clientData; - if (pmPtr->procPtr->bodyPtr->bytes == NULL) { - (void) Tcl_GetString(pmPtr->procPtr->bodyPtr); - } + (void) TclGetString(pmPtr->procPtr->bodyPtr); return pmPtr->procPtr->bodyPtr; } return NULL; @@ -1652,7 +1675,7 @@ int Tcl_MethodIsType( Tcl_Method method, const Tcl_MethodType *typePtr, - ClientData *clientDataPtr) + void **clientDataPtr) { Method *mPtr = (Method *) method; @@ -1671,6 +1694,13 @@ Tcl_MethodIsPublic( { return (((Method *)method)->flags & PUBLIC_METHOD) ? 1 : 0; } + +int +Tcl_MethodIsPrivate( + Tcl_Method method) +{ + return (((Method *)method)->flags & TRUE_PRIVATE_METHOD) ? 1 : 0; +} /* * Extended method construction for itcl-ng. @@ -1683,7 +1713,7 @@ TclOONewProcInstanceMethodEx( TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, ProcErrorProc *errProc, - ClientData clientData, + void *clientData, Tcl_Obj *nameObj, /* The name of the method, which must not be * NULL. */ Tcl_Obj *argsObj, /* The formal argument list for the method, @@ -1720,7 +1750,7 @@ TclOONewProcMethodEx( TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, ProcErrorProc *errProc, - ClientData clientData, + void *clientData, Tcl_Obj *nameObj, /* The name of the method, which may be NULL; * if so, up to caller to manage storage * (e.g., because it is a constructor or |