base/idtable.c

   1 /*
   2  */
   3 /*
   4  * dgram-socket create <local>                        => <sockid>
   5  * dgram-socket close <sockid>
   6  * dgram-socket transmit <sockid> <data> <remote>
   7  * dgram-socket on-receive <sockid> [<script>]
   8  *    calls, effectively,  eval <script> [list <data> <remote-addr> <socket>]
   9  *    if script not supplied, cancel
  10  */
  11
  12 #include "tables.h"
  13 #include "hbytes.h"
  14
  15 /* Arg parsing */
  16
  17 static void setobjdataid(Tcl_Obj *o, int ix, IdDataTable *tab) {
  18   unsigned long *ulp;
  19
  20   ulp= TALLOC(sizeof(unsigned long));
  21   *ulp= ix;
  22   o->internalRep.twoPtrValue.ptr1= tab;
  23   o->internalRep.twoPtrValue.ptr2= ulp;
  24   o->typePtr= &tabledataid_nearlytype;
  25 }
  26
  27 int tabledataid_parse(Tcl_Interp *ip, Tcl_Obj *o, IdDataTable *tab) {
  28   int l;
  29   unsigned long ul;
  30   char *ep, *str;
  31
  32   if (o->typePtr == &tabledataid_nearlytype &&
  33       o->internalRep.twoPtrValue.ptr1 == tab) return TCL_OK;
  34
  35   l= strlen(tab->prefix);
  36   str= Tcl_GetStringFromObj(o,0);
  37   if (memcmp(str,tab->prefix,l))
  38     return staticerr(ip,"bad id (wrong prefix)",0);
  39   errno=0; ul=strtoul(str+l,&ep,10);
  40   if (errno || *ep) return staticerr(ip,"bad id number",0);
  41   if (ul > INT_MAX) return staticerr(ip,"out of range id number",0);
  42
  43   objfreeir(o);
  44   setobjdataid(o,ul,tab);
  45   return TCL_OK;
  46 }
  47
  48 int pat_iddata(Tcl_Interp *ip, Tcl_Obj *o, void **rv, IdDataTable *tab) {
  49   int rc, ix;
  50   void *r;
  51
  52   rc= tabledataid_parse(ip,o,tab);
  53   if (rc) return rc;
  54
  55   ix= *(unsigned long*)o->internalRep.twoPtrValue.ptr2;
  56   if (ix >= tab->n || !(r= tab->a[ix]))
  57     return staticerr(ip,"id not in use",0);
  58
  59   assert(*(int*)r == ix);
  60
  61   *rv= r;
  62   return TCL_OK;
  63 }
  64
  65 Tcl_Obj *ret_iddata(Tcl_Interp *ip, void *val, IdDataTable *tab) {
  66   /* Command procedure implementation may set val->ix,
  67    * ie *(int*)val, to -1, to mean it's a new struct.  Otherwise
  68    * it had better be an old one !
  69    */
  70   Tcl_Obj *o;
  71   int ix;
  72
  73   ix= *(int*)val;
  74   if (ix==-1) {
  75     for (ix=0; ix<tab->n && tab->a[ix]; ix++);
  76     if (ix>=tab->n) {
  77       tab->n += 2;
  78       tab->n *= 2;
  79       tab->a= (void*)Tcl_Realloc((void*)tab->a, tab->n*sizeof(*tab->a));
  80       while (ix<tab->n) tab->a[ix++]=0;
  81       ix--;
  82     }
  83     tab->a[ix]= val;
  84     *(int*)val= ix;
  85   } else {
  86     assert(val == tab->a[ix]);
  87   }
  88
  89   o= Tcl_NewObj();
  90   setobjdataid(o,ix,tab);
  91   Tcl_InvalidateStringRep(o);
  92   return o;
  93 }
  94
  95 static int tabledataid_nt_sfa(Tcl_Interp *ip, Tcl_Obj *o) {
  96   abort();
  97 }
  98
  99 static void tabledataid_nt_free(Tcl_Obj *o) {
 100   TFREE(o->internalRep.twoPtrValue.ptr2);
 101   o->internalRep.twoPtrValue.ptr2= 0;
 102 }
 103
 104 static void tabledataid_nt_dup(Tcl_Obj *src, Tcl_Obj *dup) {
 105   setobjdataid(dup,*(unsigned long*)src->internalRep.twoPtrValue.ptr2,
 106                src->internalRep.twoPtrValue.ptr1);
 107 }
 108
 109 static void tabledataid_nt_ustr(Tcl_Obj *o) {
 110   char buf[75];
 111   const char *prefix;
 112
 113   prefix= ((IdDataTable*)o->internalRep.twoPtrValue.ptr1)->prefix;
 114   snprintf(buf,sizeof(buf), "%lu",
 115            *(unsigned long*)o->internalRep.twoPtrValue.ptr2);
 116   obj_updatestr_vstringls(o,
 117                           prefix, strlen(prefix),
 118                           buf, strlen(buf),
 119                           (char*)0);
 120 }
 121
 122 Tcl_ObjType tabledataid_nearlytype = {
 123   "tabledataid",
 124   tabledataid_nt_free, tabledataid_nt_dup,
 125   tabledataid_nt_ustr, tabledataid_nt_sfa
 126 };