Posted to tcl by mjanssen at Mon Oct 16 14:04:51 GMT 2006view raw

  1. // objc and objv are coming straight from a Command created with Tcl_CreateObjCommand
  2.  
  3. static int ObjectInvokeSlot(Tcl_Interp * interp, ObjectInfo * self, char * slotName, ObjectSlot * slot, int objc, Tcl_Obj * const objv[]) {
  4. Tcl_Obj * argList, * lambdaExpr;
  5. int nobjc,res,i;
  6. Tcl_Obj ** nobjv;
  7. static Tcl_Obj * applyCmd = NULL;
  8. if (applyCmd==NULL) {
  9. applyCmd=Tcl_NewStringObj("apply",-1);
  10. Tcl_IncrRefCount(applyCmd);
  11. }
  12. switch (slot->type) {
  13. case SELF_METHOD_INTERNAL:
  14. return (slot->function)(self,interp,Tcl_GetString(self->name),objc,objv);
  15. case SELF_DATA_SLOT:
  16. if(objc<2 || objc >3) {
  17. Tcl_WrongNumArgs(interp,1,objv,"slot_name ?value?");
  18. return TCL_ERROR;
  19. }
  20. if (objc==3) {
  21. // Set new value for the slot (slot always exist, because it was called through the slot command)
  22. // Discard the old Tcl_Obj;
  23. ObjectAddSlot(self,slotName,SELF_DATA_SLOT,Tcl_DuplicateObj(objv[2]));
  24. ObjectGetSlot(self,slotName,&slot);
  25. }
  26. Tcl_SetObjResult(interp, Tcl_DuplicateObj(slot->value));
  27. return TCL_OK;
  28. case SELF_METHOD_SLOT:
  29. argList = Tcl_NewListObj(objc,objv);
  30. Tcl_ListObjReplace(interp,argList,0,1,1,&applyCmd);
  31. Tcl_ListObjReplace(interp,argList,1,1,1,&(slot->value));
  32. Tcl_ListObjGetElements(interp,argList,&nobjc,&nobjv);
  33.  
  34. res = Tcl_EvalObjv(interp,nobjc,nobjv,0);
  35.  
  36. Tcl_DecrRefCount(argList);
  37. // something is leaking here.
  38. return res;
  39. default:
  40. Tcl_Panic("unknow slot type %d\n",slot->type,(void *)NULL);
  41. }
  42. return TCL_OK;
  43. }

Comments

Posted by at Mon Oct 16 18:21:15 GMT 2006 [text] [code]

nobjv = (Tcl_Obj **)ckalloc(objc*sizeof(Tcl_Obj *)); nobjv[0] = applyCmd; nobjv[1] = slot->value; for(i=0;i<objc;i++){ if(i>1) { nobjv[i]=Tcl_DuplicateObj(objv[i]); } Tcl_IncrRefCount(nobjv[i]); } res = Tcl_EvalObjv(interp,objc,nobjv,0); for(i=0;i<objc;i++){ fprintf(stderr, "%d ref %d\n",i,nobjv[i]->refCount); Tcl_DecrRefCount(nobjv[i]); } ckfree((char *)nobjv); return res;