Posted to tcl by apw at Tue Jul 31 20:26:09 GMT 2007view pretty
typedef int (Tcl_PreCallProc)(Tcl_Interp *interp, ClientData clientData, int *isFinished); typedef int (Tcl_PostCallProc)(Tcl_Interp *interp, ClientData clientData, int result); typedef void (Tcl_ErrProc)(Tcl_Interp *,Tcl_Obj *); typedef void (Tcl_RenderDeclarerProc)(ClientData clientData); typedef struct Tcl_ProcedureMethod { int version; Proc *procPtr; int flags; Tcl_PreCallProc *preCallPtr; Tcl_PostCallProc *postCallPtr; Tcl_ErrProc *errProc; Tcl_RenderDeclarerProc *renderDelcarerProc; ClientData clientData; } Tcl_ProcedureMethod; /* * ---------------------------------------------------------------------- * * InvokeProcedureMethod -- * * How to invoke a procedure-like method. * * ---------------------------------------------------------------------- */ static int InvokeProcedureMethod( ClientData clientData, /* Pointer to some per-method context. */ Tcl_Interp *interp, Tcl_ObjectContext context, /* The method calling context. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Arguments as actually seen. */ { CallContext *contextPtr = (CallContext *) context; ItclProcedureMethod *pmPtr = clientData; int result, flags = FRAME_IS_METHOD, skip = contextPtr->skip; CallFrame *framePtr, **framePtrPtr; Object *oPtr = contextPtr->oPtr; Command cmd; const char *namePtr; Tcl_Obj *nameObj; void (*errProc)(Tcl_Interp *,Tcl_Obj *); ExtraFrameInfo efi; struct PNI pni; Tcl_Namespace *nsPtr = oPtr->namespacePtr; nameObj = Tcl_MethodName(Tcl_ObjectContextMethod(context)); namePtr = TclGetString(nameObj); errProc = pmPtr->errProc; /* * Magic to enable things like [incr Tcl], which wants methods to run in * their class's namespace. */ if (pmPtr->flags & USE_DECLARER_NS) { register Method *mPtr = contextPtr->callChain[contextPtr->index].mPtr; if (mPtr->declaringClassPtr != NULL) { nsPtr = mPtr->declaringClassPtr->thisPtr->namespacePtr; } else { nsPtr = mPtr->declaringObjectPtr->namespacePtr; } } if (pmPtr->preCallPtr != NULL) { int isFinished; result = (* pmPtr->preCallPtr)(interp, oPtr, nsPtr, pmPtr, &isFinished); if (isFinished) { return result; } if (result != TCL_OK) { return result; } } efi.length = 2; memset(&cmd, 0, sizeof(Command)); cmd.nsPtr = (Namespace *) nsPtr; cmd.clientData = &efi; pmPtr->procPtr->cmdPtr = &cmd; result = TclProcCompileProc(interp, pmPtr->procPtr, pmPtr->procPtr->bodyPtr, (Namespace *) nsPtr, "body of method", namePtr); if (result != TCL_OK) { return result; } flags |= FRAME_IS_PROC; framePtrPtr = &framePtr; result = TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr, nsPtr, flags); if (result != TCL_OK) { return result; } framePtr->clientData = contextPtr; framePtr->objc = objc; framePtr->objv = objv; /* ref counts for args are incremented below */ framePtr->procPtr = pmPtr->procPtr; framePtr->resolvePtr = oPtr->resolvePtr; /* * Finish filling out the extra frame info. */ efi.fields[0].name = "method"; efi.fields[0].proc = NULL; efi.fields[0].clientData = nameObj; pni.interp = interp; pni.method = Tcl_ObjectContextMethod(context); efi.fields[1].proc = *pmPtr->renderDeclarerProc; efi.fields[1].clientData = &pni; if (Tcl_MethodDeclarerObject(pni.method) != NULL) { efi.fields[1].name = "object"; } else { efi.fields[1].name = "class"; } /* * Ensure that the method name itself is part of the arguments when we're * doing unknown processing. */ if (contextPtr->flags & OO_UNKNOWN_METHOD) { skip--; } /* * Now invoke the body of the method. */ result = TclObjInterpProcCore(interp, nameObj, skip, errProc); if (pmPtr->postCallPtr != NULL) { result = (* pmPtr->postCallPtr)(interp, oPtr, nsPtr, pmPtr, result); } return result; }