base/idtable.c

   1 /*
   2  */
   3
   4 #include "tables.h"
   5 #include "hbytes.h"
   6
   7 /* Arg parsing */
   8
   9 typedef struct {
  10   const IdDataSpec *idds;
  11   int n;
  12   void **a;
  13 } IdDataAssocData;
  14
  15 typedef struct {
  16   Tcl_Interp *interp;
  17   IdDataAssocData *assoc;
  18   int ix;
  19 } IdDataValue;
  20
  21 static void assoc_del(ClientData assoc_cd, Tcl_Interp *ip) {
  22   IdDataAssocData *assoc;
  23   int ix;
  24   void **p, *v;
  25
  26   assoc= assoc_cd;
  27   for (ix=0, p=assoc->a; ix<assoc->n; ix++, p++) {
  28     v= *p;
  29     if (!v) continue;
  30     assert(*(int*)v == ix);
  31     *(int*)v= -1;
  32     assoc->idds->destroyitem(ip,v);
  33     *p= 0;
  34   }
  35   TFREE(assoc->a);
  36   TFREE(assoc);
  37 }
  38
  39 static void setobjdataid(Tcl_Interp *interp, Tcl_Obj *o,
  40                          int ix, const IdDataSpec *idds) {
  41   IdDataValue *dv;
  42   IdDataAssocData *assoc;
  43
  44   assoc= Tcl_GetAssocData(interp, (char*)idds->assockey, 0);
  45   if (!assoc) {
  46     assoc= TALLOC(sizeof(*assoc));
  47     assoc->idds= idds;
  48     assoc->n= 0;
  49     assoc->a= 0;
  50     Tcl_SetAssocData(interp, (char*)idds->assockey, assoc_del, assoc);
  51   }
  52
  53   dv= TALLOC(sizeof(*dv));
  54   dv->interp= interp;
  55   dv->assoc= assoc;
  56   dv->ix= ix;
  57
  58   o->typePtr= &tabledataid_nearlytype;
  59   o->internalRep.otherValuePtr= dv;
  60 }
  61
  62 int tabledataid_parse(Tcl_Interp *ip, Tcl_Obj *o, const IdDataSpec *idds) {
  63   int l;
  64   unsigned long ul;
  65   IdDataValue *dv;
  66   IdDataAssocData *assoc;
  67   char *ep, *str;
  68
  69   if (o->typePtr != &tabledataid_nearlytype) goto convert;
  70
  71   dv= o->internalRep.otherValuePtr;
  72   if (dv->interp != ip) goto convert;
  73   assoc= dv->assoc;
  74   if (dv->assoc->idds != idds) goto convert;
  75
  76   return TCL_OK;
  77
  78 convert:
  79   l= strlen(idds->valprefix);
  80   str= Tcl_GetStringFromObj(o,0);
  81   if (memcmp(str,idds->valprefix,l))
  82     return staticerr(ip,"bad id (wrong prefix)",0);
  83
  84   errno=0; ul=strtoul(str+l,&ep,10);
  85   if (errno || *ep) return staticerr(ip,"bad id number",0);
  86   if (ul > INT_MAX) return staticerr(ip,"out of range id number",0);
  87
  88   objfreeir(o);
  89   setobjdataid(ip,o,ul,idds);
  90   return TCL_OK;
  91 }
  92
  93 int pat_iddata(Tcl_Interp *ip, Tcl_Obj *o, void **rv, const IdDataSpec *idds) {
  94   int rc, ix;
  95   IdDataValue *dv;
  96   IdDataAssocData *assoc;
  97   void *r;
  98
  99   rc= tabledataid_parse(ip,o,idds);
 100   if (rc) return rc;
 101
 102   dv= o->internalRep.otherValuePtr;
 103   ix= dv->ix;
 104   assoc= dv->assoc;
 105
 106   if (ix >= assoc->n || !(r= assoc->a[ix]))
 107     return staticerr(ip,"id not in use",0);
 108
 109   assert(*(int*)r == ix);
 110
 111   *rv= r;
 112   return TCL_OK;
 113 }
 114
 115 Tcl_Obj *ret_iddata(Tcl_Interp *ip, void *val, const IdDataSpec *idds) {
 116   /* Command procedure implementation may set val->ix,
 117    * ie *(int*)val, to -1, to mean it's a new struct.  Otherwise
 118    * it had better be an old one !
 119    */
 120   Tcl_Obj *o;
 121   IdDataValue *dv;
 122   IdDataAssocData *assoc;
 123   int ix;
 124
 125   o= Tcl_NewObj();
 126   setobjdataid(ip,o,0,idds);
 127   dv= o->internalRep.otherValuePtr;
 128   assoc= dv->assoc;
 129
 130   ix= *(int*)val;
 131   if (ix==-1) {
 132     for (ix=0; ix<assoc->n && assoc->a[ix]; ix++);
 133     if (ix>=assoc->n) {
 134       assoc->n += 2;
 135       assoc->n *= 2;
 136       assoc->a= TREALLOC(assoc->a, assoc->n*sizeof(*assoc->a));
 137       while (ix<assoc->n) assoc->a[ix++]=0;
 138       ix--;
 139     }
 140     assoc->a[ix]= val;
 141     *(int*)val= ix;
 142   } else {
 143     assert(val == assoc->a[ix]);
 144   }
 145   dv->ix= ix;
 146   Tcl_InvalidateStringRep(o);
 147   return o;
 148 }
 149
 150 void tabledataid_disposing(Tcl_Interp *ip, void *val, const IdDataSpec *idds) {
 151   IdDataAssocData *assoc;
 152   int ix;
 153
 154   ix= *(int*)val;
 155   if (ix==-1) return;
 156
 157   assoc= Tcl_GetAssocData(ip, (char*)idds->assockey, 0);
 158   assert(assoc->a[ix] == val);
 159   assoc->a[ix]= 0;
 160   *(int*)val= -1;
 161 }
 162
 163 static int tabledataid_nt_sfa(Tcl_Interp *ip, Tcl_Obj *o) {
 164   abort();
 165 }
 166
 167 static void tabledataid_nt_free(Tcl_Obj *o) {
 168   TFREE(o->internalRep.otherValuePtr);
 169   o->internalRep.otherValuePtr= 0;
 170 }
 171
 172 static void tabledataid_nt_dup(Tcl_Obj *src, Tcl_Obj *dup) {
 173   IdDataValue *sv, *dv;
 174
 175   sv= src->internalRep.otherValuePtr;
 176   dv= TALLOC(sizeof(*dv));
 177   *dv= *sv;
 178   dup->typePtr= &tabledataid_nearlytype;
 179   dup->internalRep.otherValuePtr= dv;
 180 }
 181
 182 static void tabledataid_nt_ustr(Tcl_Obj *o) {
 183   const IdDataValue *dv;
 184   const IdDataAssocData *assoc;
 185   const IdDataSpec *idds;
 186   char buf[75];
 187
 188   dv= o->internalRep.otherValuePtr;
 189   assoc= dv->assoc;
 190   idds= assoc->idds;
 191
 192   snprintf(buf,sizeof(buf), "%d", dv->ix);
 193   obj_updatestr_vstringls(o,
 194                           idds->valprefix, strlen(idds->valprefix),
 195                           buf, strlen(buf),
 196                           (char*)0);
 197 }
 198
 199 Tcl_ObjType tabledataid_nearlytype = {
 200   "tabledataid",
 201   tabledataid_nt_free, tabledataid_nt_dup,
 202   tabledataid_nt_ustr, tabledataid_nt_sfa
 203 };