Posted to tcl by apw at Tue Jul 31 20:26:09 GMT 2007view raw

  1. typedef int (Tcl_PreCallProc)(Tcl_Interp *interp, ClientData clientData, int *isFinished);
  2. typedef int (Tcl_PostCallProc)(Tcl_Interp *interp, ClientData clientData, int result);
  3. typedef void (Tcl_ErrProc)(Tcl_Interp *,Tcl_Obj *);
  4. typedef void (Tcl_RenderDeclarerProc)(ClientData clientData);
  5.  
  6. typedef struct Tcl_ProcedureMethod {
  7. int version;
  8. Proc *procPtr;
  9. int flags;
  10. Tcl_PreCallProc *preCallPtr;
  11. Tcl_PostCallProc *postCallPtr;
  12. Tcl_ErrProc *errProc;
  13. Tcl_RenderDeclarerProc *renderDelcarerProc;
  14. ClientData clientData;
  15. } Tcl_ProcedureMethod;
  16.  
  17.  
  18. /*
  19. * ----------------------------------------------------------------------
  20. *
  21. * InvokeProcedureMethod --
  22. *
  23. * How to invoke a procedure-like method.
  24. *
  25. * ----------------------------------------------------------------------
  26. */
  27.  
  28. static int
  29. InvokeProcedureMethod(
  30. ClientData clientData, /* Pointer to some per-method context. */
  31. Tcl_Interp *interp,
  32. Tcl_ObjectContext context, /* The method calling context. */
  33. int objc, /* Number of arguments. */
  34. Tcl_Obj *const *objv) /* Arguments as actually seen. */
  35. {
  36. CallContext *contextPtr = (CallContext *) context;
  37. ItclProcedureMethod *pmPtr = clientData;
  38. int result, flags = FRAME_IS_METHOD, skip = contextPtr->skip;
  39. CallFrame *framePtr, **framePtrPtr;
  40. Object *oPtr = contextPtr->oPtr;
  41. Command cmd;
  42. const char *namePtr;
  43. Tcl_Obj *nameObj;
  44. void (*errProc)(Tcl_Interp *,Tcl_Obj *);
  45. ExtraFrameInfo efi;
  46. struct PNI pni;
  47. Tcl_Namespace *nsPtr = oPtr->namespacePtr;
  48.  
  49. nameObj = Tcl_MethodName(Tcl_ObjectContextMethod(context));
  50. namePtr = TclGetString(nameObj);
  51. errProc = pmPtr->errProc;
  52.  
  53. /*
  54. * Magic to enable things like [incr Tcl], which wants methods to run in
  55. * their class's namespace.
  56. */
  57.  
  58. if (pmPtr->flags & USE_DECLARER_NS) {
  59. register Method *mPtr = contextPtr->callChain[contextPtr->index].mPtr;
  60.  
  61. if (mPtr->declaringClassPtr != NULL) {
  62. nsPtr = mPtr->declaringClassPtr->thisPtr->namespacePtr;
  63. } else {
  64. nsPtr = mPtr->declaringObjectPtr->namespacePtr;
  65. }
  66. }
  67. if (pmPtr->preCallPtr != NULL) {
  68. int isFinished;
  69. result = (* pmPtr->preCallPtr)(interp, oPtr, nsPtr, pmPtr, &isFinished);
  70. if (isFinished) {
  71. return result;
  72. }
  73. if (result != TCL_OK) {
  74. return result;
  75. }
  76. }
  77.  
  78. efi.length = 2;
  79. memset(&cmd, 0, sizeof(Command));
  80. cmd.nsPtr = (Namespace *) nsPtr;
  81. cmd.clientData = &efi;
  82. pmPtr->procPtr->cmdPtr = &cmd;
  83. result = TclProcCompileProc(interp, pmPtr->procPtr,
  84. pmPtr->procPtr->bodyPtr, (Namespace *) nsPtr, "body of method",
  85. namePtr);
  86. if (result != TCL_OK) {
  87. return result;
  88. }
  89.  
  90. flags |= FRAME_IS_PROC;
  91. framePtrPtr = &framePtr;
  92. result = TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr, nsPtr,
  93. flags);
  94. if (result != TCL_OK) {
  95. return result;
  96. }
  97.  
  98. framePtr->clientData = contextPtr;
  99. framePtr->objc = objc;
  100. framePtr->objv = objv; /* ref counts for args are incremented below */
  101. framePtr->procPtr = pmPtr->procPtr;
  102.  
  103. framePtr->resolvePtr = oPtr->resolvePtr;
  104. /*
  105. * Finish filling out the extra frame info.
  106. */
  107.  
  108. efi.fields[0].name = "method";
  109. efi.fields[0].proc = NULL;
  110. efi.fields[0].clientData = nameObj;
  111. pni.interp = interp;
  112. pni.method = Tcl_ObjectContextMethod(context);
  113. efi.fields[1].proc = *pmPtr->renderDeclarerProc;
  114. efi.fields[1].clientData = &pni;
  115. if (Tcl_MethodDeclarerObject(pni.method) != NULL) {
  116. efi.fields[1].name = "object";
  117. } else {
  118. efi.fields[1].name = "class";
  119. }
  120.  
  121. /*
  122. * Ensure that the method name itself is part of the arguments when we're
  123. * doing unknown processing.
  124. */
  125.  
  126. if (contextPtr->flags & OO_UNKNOWN_METHOD) {
  127. skip--;
  128. }
  129.  
  130. /*
  131. * Now invoke the body of the method.
  132. */
  133.  
  134. result = TclObjInterpProcCore(interp, nameObj, skip, errProc);
  135. if (pmPtr->postCallPtr != NULL) {
  136. result = (* pmPtr->postCallPtr)(interp, oPtr, nsPtr, pmPtr, result);
  137. }
  138.  
  139. return result;
  140. }