9 static void setobjdataid(Tcl_Obj *o, int ix, IdDataTable *tab) {
12 ulp= TALLOC(sizeof(unsigned long));
14 o->internalRep.twoPtrValue.ptr1= tab;
15 o->internalRep.twoPtrValue.ptr2= ulp;
16 o->typePtr= &tabledataid_nearlytype;
19 int tabledataid_parse(Tcl_Interp *ip, Tcl_Obj *o, IdDataTable *tab) {
24 if (o->typePtr == &tabledataid_nearlytype &&
25 o->internalRep.twoPtrValue.ptr1 == tab) return TCL_OK;
27 l= strlen(tab->prefix);
28 str= Tcl_GetStringFromObj(o,0);
29 if (memcmp(str,tab->prefix,l))
30 return staticerr(ip,"bad id (wrong prefix)",0);
31 errno=0; ul=strtoul(str+l,&ep,10);
32 if (errno || *ep) return staticerr(ip,"bad id number",0);
33 if (ul > INT_MAX) return staticerr(ip,"out of range id number",0);
36 setobjdataid(o,ul,tab);
40 void tabledataid_disposing(void *val, IdDataTable *tab) {
45 assert(tab->a[ix] == val);
50 int pat_iddata(Tcl_Interp *ip, Tcl_Obj *o, void **rv, IdDataTable *tab) {
54 rc= tabledataid_parse(ip,o,tab);
57 ix= *(unsigned long*)o->internalRep.twoPtrValue.ptr2;
58 if (ix >= tab->n || !(r= tab->a[ix]))
59 return staticerr(ip,"id not in use",0);
61 assert(*(int*)r == ix);
67 Tcl_Obj *ret_iddata(Tcl_Interp *ip, void *val, IdDataTable *tab) {
68 /* Command procedure implementation may set val->ix,
69 * ie *(int*)val, to -1, to mean it's a new struct. Otherwise
70 * it had better be an old one !
77 for (ix=0; ix<tab->n && tab->a[ix]; ix++);
81 tab->a= (void*)Tcl_Realloc((void*)tab->a, tab->n*sizeof(*tab->a));
82 while (ix<tab->n) tab->a[ix++]=0;
88 assert(val == tab->a[ix]);
92 setobjdataid(o,ix,tab);
93 Tcl_InvalidateStringRep(o);
97 static int tabledataid_nt_sfa(Tcl_Interp *ip, Tcl_Obj *o) {
101 static void tabledataid_nt_free(Tcl_Obj *o) {
102 TFREE(o->internalRep.twoPtrValue.ptr2);
103 o->internalRep.twoPtrValue.ptr2= 0;
106 static void tabledataid_nt_dup(Tcl_Obj *src, Tcl_Obj *dup) {
107 setobjdataid(dup,*(unsigned long*)src->internalRep.twoPtrValue.ptr2,
108 src->internalRep.twoPtrValue.ptr1);
111 static void tabledataid_nt_ustr(Tcl_Obj *o) {
115 prefix= ((IdDataTable*)o->internalRep.twoPtrValue.ptr1)->prefix;
116 snprintf(buf,sizeof(buf), "%lu",
117 *(unsigned long*)o->internalRep.twoPtrValue.ptr2);
118 obj_updatestr_vstringls(o,
119 prefix, strlen(prefix),
124 Tcl_ObjType tabledataid_nearlytype = {
126 tabledataid_nt_free, tabledataid_nt_dup,
127 tabledataid_nt_ustr, tabledataid_nt_sfa