Posted to tcl by hypnotoad at Fri Dec 05 19:28:48 GMT 2014view raw
- cstruct::function ${EnsembleName}_nodeeval {
- returns int
- arglist {Tcl_Interp *interp,%StructName% *p,Tcl_Obj *body,int writeback}
- } {
- Tcl_Obj *id;
- Tcl_Obj *pValueDict;
- int i;
- Tcl_Obj **varv;
- int varc,result;
- if(!p) {
- return TCL_CONTINUE;
- }
- pValueDict=%StructName%_StructToDict(interp,p,1);
- if(!pValueDict) {
- return TCL_CONTINUE;
- }
- if (Tcl_ListObjGetElements(interp, pValueDict, &varc, &varv) != TCL_OK) {
- return TCL_ERROR;
- }
- for(i=0;i<varc;i+=2) {
- //Tcl_IncrRefCount(varv[i+1]);
- Tcl_ObjSetVar2(interp, varv[i], (Tcl_Obj *)NULL, varv[i+1], 0);
- }
- id=%EnsembleName%_Identify(p);
- Tcl_ObjSetVar2(interp,Irm_NewStringObj("id"),NULL,id,0);
- Tcl_ObjSetVar2(interp,Irm_NewStringObj("typeid"),NULL,%EnsembleName%_TypeToTclObj(p),0);
- Tcl_ObjSetVar2(interp,Irm_NewStringObj("groupid"),NULL,%EnsembleName%_GroupToTclObj(p),0);
- Tcl_ObjSetVar2(interp,Irm_NewStringObj("config_dict"),NULL,Tcl_DuplicateObj(pValueDict),0);
- result=Tcl_EvalObjEx(interp, body, 0);
- if(result!=TCL_OK) {
- if(pValueDict) {
- Tcl_DecrRefCount(pValueDict);
- }
- return result;
- }
- if(writeback){
- /*
- ** Read values back into the dict
- ** For now, we limit writeback to state variables
- ** And we don't care about garbage values
- */
- for(i=0;i<varc;i+=2) {
- Tcl_Obj *newValue;
- int offset;
- int type;
- newValue=Tcl_ObjGetVar2(interp,varv[i],(Tcl_Obj*)NULL,0);
- if(newValue==varv[i+1]) {
- /* Undocumented, unsanctioned, but it works in practice
- ** If the pointer hasn't changed, neither has the value
- */
- continue;
- }
- if(!newValue) {
- /* Variable must have been unset... move along */
- continue;
- }
- if( %StructName%_StructValueOffset(0, varv[i], &offset, &type) == TCL_OK ) {
- %StructName%_StructSet(interp,p,offset,newValue);
- } else {
- %StructName%_SpecDictPut(p,varv[i],newValue);
- }
- }
- %StructName%_ApplySettings(p);
- }
- if(pValueDict) {
- Tcl_DecrRefCount(pValueDict);
- }
- return TCL_OK;
- }