Posted to tcl by hypnotoad at Fri Dec 05 19:28:48 GMT 2014view raw

  1.  
  2. cstruct::function ${EnsembleName}_nodeeval {
  3. returns int
  4. arglist {Tcl_Interp *interp,%StructName% *p,Tcl_Obj *body,int writeback}
  5. } {
  6. Tcl_Obj *id;
  7. Tcl_Obj *pValueDict;
  8. int i;
  9. Tcl_Obj **varv;
  10. int varc,result;
  11. if(!p) {
  12. return TCL_CONTINUE;
  13. }
  14. pValueDict=%StructName%_StructToDict(interp,p,1);
  15. if(!pValueDict) {
  16. return TCL_CONTINUE;
  17. }
  18. if (Tcl_ListObjGetElements(interp, pValueDict, &varc, &varv) != TCL_OK) {
  19. return TCL_ERROR;
  20. }
  21. for(i=0;i<varc;i+=2) {
  22. //Tcl_IncrRefCount(varv[i+1]);
  23. Tcl_ObjSetVar2(interp, varv[i], (Tcl_Obj *)NULL, varv[i+1], 0);
  24. }
  25. id=%EnsembleName%_Identify(p);
  26. Tcl_ObjSetVar2(interp,Irm_NewStringObj("id"),NULL,id,0);
  27. Tcl_ObjSetVar2(interp,Irm_NewStringObj("typeid"),NULL,%EnsembleName%_TypeToTclObj(p),0);
  28. Tcl_ObjSetVar2(interp,Irm_NewStringObj("groupid"),NULL,%EnsembleName%_GroupToTclObj(p),0);
  29. Tcl_ObjSetVar2(interp,Irm_NewStringObj("config_dict"),NULL,Tcl_DuplicateObj(pValueDict),0);
  30.  
  31. result=Tcl_EvalObjEx(interp, body, 0);
  32.  
  33. if(result!=TCL_OK) {
  34. if(pValueDict) {
  35. Tcl_DecrRefCount(pValueDict);
  36. }
  37. return result;
  38. }
  39. if(writeback){
  40. /*
  41. ** Read values back into the dict
  42. ** For now, we limit writeback to state variables
  43. ** And we don't care about garbage values
  44. */
  45. for(i=0;i<varc;i+=2) {
  46. Tcl_Obj *newValue;
  47. int offset;
  48. int type;
  49. newValue=Tcl_ObjGetVar2(interp,varv[i],(Tcl_Obj*)NULL,0);
  50. if(newValue==varv[i+1]) {
  51. /* Undocumented, unsanctioned, but it works in practice
  52. ** If the pointer hasn't changed, neither has the value
  53. */
  54. continue;
  55. }
  56. if(!newValue) {
  57. /* Variable must have been unset... move along */
  58. continue;
  59. }
  60. if( %StructName%_StructValueOffset(0, varv[i], &offset, &type) == TCL_OK ) {
  61. %StructName%_StructSet(interp,p,offset,newValue);
  62. } else {
  63. %StructName%_SpecDictPut(p,varv[i],newValue);
  64. }
  65. }
  66. %StructName%_ApplySettings(p);
  67. }
  68. if(pValueDict) {
  69. Tcl_DecrRefCount(pValueDict);
  70. }
  71. return TCL_OK;
  72. }