tuntap: Do not build on non-Linux platforms.

[chiark-tcl.git] / base / idtable.c

diff --git a/base/idtable.c b/base/idtable.c
index c2f3aaa32f0dee504704dba14c182870c29bddf1..6e7aafaa1562c94b8f16398acc4a6acfb42622cc 100644 (file)
--- a/base/idtable.c
+++ b/base/idtable.c
@@ -1,60 +1,122 @@
 /*
 /*

- */
-/*
- * dgram-socket create <local>                        => <sockid>
- * dgram-socket close <sockid>
- * dgram-socket transmit <sockid> <data> <remote>
- * dgram-socket on-receive <sockid> [<script>]
- *    calls, effectively,  eval <script> [list <data> <remote-addr> <socket>]
- *    if script not supplied, cancel
+ * base code for various Tcl extensions
+ * Copyright 2006-2012 Ian Jackson
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License as
+ * published by the Free Software Foundation; either version 2 of the
+ * License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this library; if not, see <http://www.gnu.org/licenses/>.

  */
 
  */
 

-#include "tables.h"
-#include "hbytes.h"
+#include "chiark-tcl-base.h"

 
 /* Arg parsing */
 
 
 /* Arg parsing */
 

-static void setobjdataid(Tcl_Obj *o, int ix, IdDataTable *tab) {
-  unsigned long *ulp;
+typedef struct {
+  const IdDataSpec *idds;
+  int n;
+  void **a;
+} IdDataAssocData;
+
+typedef struct {
+  Tcl_Interp *interp;
+  IdDataAssocData *assoc;
+  int ix;
+} IdDataValue;
+
+static void assoc_del(ClientData assoc_cd, Tcl_Interp *ip) {
+  IdDataAssocData *assoc;
+  int ix;
+  void **p, *v;
+
+  assoc= assoc_cd;
+  for (ix=0, p=assoc->a; ix<assoc->n; ix++, p++) {
+    v= *p;
+    if (!v) continue;
+    assert(*(int*)v == ix);
+    *(int*)v= -1;
+    assoc->idds->destroyitem(ip,v);
+    *p= 0;
+  }
+  TFREE(assoc->a);
+  TFREE(assoc);
+}
+
+static void setobjdataid(Tcl_Interp *interp, Tcl_Obj *o,
+                        int ix, const IdDataSpec *idds) {
+  IdDataValue *dv;
+  IdDataAssocData *assoc;
+
+  assoc= Tcl_GetAssocData(interp, (char*)idds->assockey, 0);
+  if (!assoc) {
+    assoc= TALLOC(sizeof(*assoc));
+    assoc->idds= idds;
+    assoc->n= 0;
+    assoc->a= 0;
+    Tcl_SetAssocData(interp, (char*)idds->assockey, assoc_del, assoc);
+  }
+  
+  dv= TALLOC(sizeof(*dv));
+  dv->interp= interp;
+  dv->assoc= assoc;
+  dv->ix= ix;

   
   

-  ulp= TALLOC(sizeof(unsigned long));
-  *ulp= ix;
-  o->internalRep.twoPtrValue.ptr1= tab;
-  o->internalRep.twoPtrValue.ptr2= ulp;
-  o->typePtr= &tabledataid_nearlytype;
+  o->typePtr= &cht_tabledataid_nearlytype;
+  o->internalRep.otherValuePtr= dv;

 }
 
 }
 

-int tabledataid_parse(Tcl_Interp *ip, Tcl_Obj *o, IdDataTable *tab) {
+int cht_tabledataid_parse(Tcl_Interp *ip, Tcl_Obj *o, const IdDataSpec *idds) {

   int l;
   unsigned long ul;
   int l;
   unsigned long ul;

+  IdDataValue *dv;

   char *ep, *str;
 
   char *ep, *str;
 

-  if (o->typePtr == &tabledataid_nearlytype &&
-      o->internalRep.twoPtrValue.ptr1 == tab) return TCL_OK;
+  if (o->typePtr != &cht_tabledataid_nearlytype) goto convert;
+
+  dv= o->internalRep.otherValuePtr;
+  if (dv->interp != ip) goto convert;
+  if (dv->assoc->idds != idds) goto convert;
+
+  return TCL_OK;

 
 

-  l= strlen(tab->prefix);
+convert:
+  l= strlen(idds->valprefix);

   str= Tcl_GetStringFromObj(o,0);
   str= Tcl_GetStringFromObj(o,0);

-  if (memcmp(str,tab->prefix,l))
-    return staticerr(ip,"bad id (wrong prefix)",0);
+  if (memcmp(str,idds->valprefix,l))
+    return cht_staticerr(ip,"bad id (wrong prefix)",0);
+

   errno=0; ul=strtoul(str+l,&ep,10);
   errno=0; ul=strtoul(str+l,&ep,10);

-  if (errno || *ep) return staticerr(ip,"bad id number",0);
-  if (ul > INT_MAX) return staticerr(ip,"out of range id number",0);
+  if (errno || *ep) return cht_staticerr(ip,"bad id number",0);
+  if (ul > INT_MAX) return cht_staticerr(ip,"out of range id number",0);

 
 

-  objfreeir(o);
-  setobjdataid(o,ul,tab);
+  cht_objfreeir(o);
+  setobjdataid(ip,o,ul,idds);

   return TCL_OK;
 }
 
   return TCL_OK;
 }
 

-int pat_iddata(Tcl_Interp *ip, Tcl_Obj *o, void **rv, IdDataTable *tab) {
+int cht_pat_iddata(Tcl_Interp *ip, Tcl_Obj *o, void **rv, const IdDataSpec *idds) {

   int rc, ix;
   int rc, ix;

+  IdDataValue *dv;
+  IdDataAssocData *assoc;

   void *r;
   
   void *r;
   

-  rc= tabledataid_parse(ip,o,tab);
+  rc= cht_tabledataid_parse(ip,o,idds);

   if (rc) return rc;
 
   if (rc) return rc;
 

-  ix= *(unsigned long*)o->internalRep.twoPtrValue.ptr2;
-  if (ix >= tab->n || !(r= tab->a[ix]))
-    return staticerr(ip,"id not in use",0);
+  dv= o->internalRep.otherValuePtr;
+  ix= dv->ix;
+  assoc= dv->assoc;
+
+  if (ix >= assoc->n || !(r= assoc->a[ix]))
+    return cht_staticerr(ip,"id not in use",0);

 
   assert(*(int*)r == ix);
 
 
   assert(*(int*)r == ix);
 


@@ -62,64 +124,92 @@ int pat_iddata(Tcl_Interp *ip, Tcl_Obj *o, void **rv, IdDataTable *tab) {
   return TCL_OK;
 }
 
   return TCL_OK;
 }
 

-Tcl_Obj *ret_iddata(Tcl_Interp *ip, void *val, IdDataTable *tab) {
+Tcl_Obj *cht_ret_iddata(Tcl_Interp *ip, void *val, const IdDataSpec *idds) {

   /* Command procedure implementation may set val->ix,
    * ie *(int*)val, to -1, to mean it's a new struct.  Otherwise
    * it had better be an old one !
    */
   Tcl_Obj *o;
   /* Command procedure implementation may set val->ix,
    * ie *(int*)val, to -1, to mean it's a new struct.  Otherwise
    * it had better be an old one !
    */
   Tcl_Obj *o;

+  IdDataValue *dv;
+  IdDataAssocData *assoc;

   int ix;
 
   int ix;
 

+  o= Tcl_NewObj();
+  setobjdataid(ip,o,0,idds);
+  dv= o->internalRep.otherValuePtr;
+  assoc= dv->assoc;
+

   ix= *(int*)val;
   if (ix==-1) {
   ix= *(int*)val;
   if (ix==-1) {

-    for (ix=0; ix<tab->n && tab->a[ix]; ix++);
-    if (ix>=tab->n) {
-      tab->n += 2;
-      tab->n *= 2;
-      tab->a= (void*)Tcl_Realloc((void*)tab->a, tab->n*sizeof(*tab->a));
-      while (ix<tab->n) tab->a[ix++]=0;
+    for (ix=0; ix<assoc->n && assoc->a[ix]; ix++);
+    if (ix>=assoc->n) {
+      assert(assoc->n < INT_MAX/4);
+      assoc->n += 2;
+      assoc->n *= 2;
+      assoc->a= TREALLOC(assoc->a, assoc->n*sizeof(*assoc->a));
+      while (ix<assoc->n) assoc->a[ix++]=0;

       ix--;
     }
       ix--;
     }

-    tab->a[ix]= val;
+    assoc->a[ix]= val;

     *(int*)val= ix;
   } else {
     *(int*)val= ix;
   } else {

-    assert(val == tab->a[ix]);
+    assert(val == assoc->a[ix]);

   }
   }

-
-  o= Tcl_NewObj();
-  setobjdataid(o,ix,tab);
+  dv->ix= ix;

   Tcl_InvalidateStringRep(o);
   return o;
 }
 
   Tcl_InvalidateStringRep(o);
   return o;
 }
 

+void cht_tabledataid_disposing(Tcl_Interp *ip, void *val, const IdDataSpec *idds) {
+  IdDataAssocData *assoc;
+  int ix;
+
+  ix= *(int*)val;
+  if (ix==-1) return;
+
+  assoc= Tcl_GetAssocData(ip, (char*)idds->assockey, 0);
+  assert(assoc->a[ix] == val);
+  assoc->a[ix]= 0;
+  *(int*)val= -1;
+}
+

 static int tabledataid_nt_sfa(Tcl_Interp *ip, Tcl_Obj *o) {
   abort();
 }
 
 static void tabledataid_nt_free(Tcl_Obj *o) {
 static int tabledataid_nt_sfa(Tcl_Interp *ip, Tcl_Obj *o) {
   abort();
 }
 
 static void tabledataid_nt_free(Tcl_Obj *o) {

-  TFREE(o->internalRep.twoPtrValue.ptr2);
-  o->internalRep.twoPtrValue.ptr2= 0;
+  TFREE(o->internalRep.otherValuePtr);
+  o->internalRep.otherValuePtr= 0;

 }
 
 static void tabledataid_nt_dup(Tcl_Obj *src, Tcl_Obj *dup) {
 }
 
 static void tabledataid_nt_dup(Tcl_Obj *src, Tcl_Obj *dup) {

-  setobjdataid(dup,*(unsigned long*)src->internalRep.twoPtrValue.ptr2,
-              src->internalRep.twoPtrValue.ptr1);
+  IdDataValue *sv, *dv;
+
+  sv= src->internalRep.otherValuePtr;
+  dv= TALLOC(sizeof(*dv));
+  *dv= *sv;
+  dup->typePtr= &cht_tabledataid_nearlytype;
+  dup->internalRep.otherValuePtr= dv;

 }
 
 static void tabledataid_nt_ustr(Tcl_Obj *o) {
 }
 
 static void tabledataid_nt_ustr(Tcl_Obj *o) {

+  const IdDataValue *dv;
+  const IdDataAssocData *assoc;
+  const IdDataSpec *idds;

   char buf[75];
   char buf[75];

-  const char *prefix;

 
 

-  prefix= o->internalRep.twoPtrValue.ptr2;
-  snprintf(buf,sizeof(buf), "%lu",
-          *(unsigned long*)o->internalRep.twoPtrValue.ptr2);
-  obj_updatestr_vstringls(o,
-                         prefix, strlen(prefix),
+  dv= o->internalRep.otherValuePtr;
+  assoc= dv->assoc;
+  idds= assoc->idds;
+
+  snprintf(buf,sizeof(buf), "%d", dv->ix);
+  cht_obj_updatestr_vstringls(o,
+                         idds->valprefix, strlen(idds->valprefix),

                          buf, strlen(buf),
                          (char*)0);
 }
 
                          buf, strlen(buf),
                          (char*)0);
 }
 

-Tcl_ObjType tabledataid_ntype = {
+Tcl_ObjType cht_tabledataid_nearlytype = {

   "tabledataid",
   tabledataid_nt_free, tabledataid_nt_dup,
   tabledataid_nt_ustr, tabledataid_nt_sfa
   "tabledataid",
   tabledataid_nt_free, tabledataid_nt_dup,
   tabledataid_nt_ustr, tabledataid_nt_sfa