base/idtable.c

   1 /*
   2  */
   3
   4 #include "tables.h"
   5 #include "hbytes.h"
   6
   7 /* Arg parsing */
   8
   9 static void setobjdataid(Tcl_Obj *o, int ix, IdDataTable *tab) {
  10   unsigned long *ulp;
  11
  12   ulp= TALLOC(sizeof(unsigned long));
  13   *ulp= ix;
  14   o->internalRep.twoPtrValue.ptr1= tab;
  15   o->internalRep.twoPtrValue.ptr2= ulp;
  16   o->typePtr= &tabledataid_nearlytype;
  17 }
  18
  19 int tabledataid_parse(Tcl_Interp *ip, Tcl_Obj *o, IdDataTable *tab) {
  20   int l;
  21   unsigned long ul;
  22   char *ep, *str;
  23
  24   if (o->typePtr == &tabledataid_nearlytype &&
  25       o->internalRep.twoPtrValue.ptr1 == tab) return TCL_OK;
  26
  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);
  34
  35   objfreeir(o);
  36   setobjdataid(o,ul,tab);
  37   return TCL_OK;
  38 }
  39
  40 void tabledataid_disposing(void *val, IdDataTable *tab) {
  41   int ix;
  42
  43   ix= *(int*)val;
  44   if (ix==-1) return;
  45   assert(tab->a[ix] == val);
  46   tab->a[ix]= 0;
  47   *(int*)val= -1;
  48 }
  49
  50 int pat_iddata(Tcl_Interp *ip, Tcl_Obj *o, void **rv, IdDataTable *tab) {
  51   int rc, ix;
  52   void *r;
  53
  54   rc= tabledataid_parse(ip,o,tab);
  55   if (rc) return rc;
  56
  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);
  60
  61   assert(*(int*)r == ix);
  62
  63   *rv= r;
  64   return TCL_OK;
  65 }
  66
  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 !
  71    */
  72   Tcl_Obj *o;
  73   int ix;
  74
  75   ix= *(int*)val;
  76   if (ix==-1) {
  77     for (ix=0; ix<tab->n && tab->a[ix]; ix++);
  78     if (ix>=tab->n) {
  79       tab->n += 2;
  80       tab->n *= 2;
  81       tab->a= (void*)Tcl_Realloc((void*)tab->a, tab->n*sizeof(*tab->a));
  82       while (ix<tab->n) tab->a[ix++]=0;
  83       ix--;
  84     }
  85     tab->a[ix]= val;
  86     *(int*)val= ix;
  87   } else {
  88     assert(val == tab->a[ix]);
  89   }
  90
  91   o= Tcl_NewObj();
  92   setobjdataid(o,ix,tab);
  93   Tcl_InvalidateStringRep(o);
  94   return o;
  95 }
  96
  97 static int tabledataid_nt_sfa(Tcl_Interp *ip, Tcl_Obj *o) {
  98   abort();
  99 }
 100
 101 static void tabledataid_nt_free(Tcl_Obj *o) {
 102   TFREE(o->internalRep.twoPtrValue.ptr2);
 103   o->internalRep.twoPtrValue.ptr2= 0;
 104 }
 105
 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);
 109 }
 110
 111 static void tabledataid_nt_ustr(Tcl_Obj *o) {
 112   char buf[75];
 113   const char *prefix;
 114
 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),
 120                           buf, strlen(buf),
 121                           (char*)0);
 122 }
 123
 124 Tcl_ObjType tabledataid_nearlytype = {
 125   "tabledataid",
 126   tabledataid_nt_free, tabledataid_nt_dup,
 127   tabledataid_nt_ustr, tabledataid_nt_sfa
 128 };