Finalise 1.1.2

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

diff --git a/base/idtable.c b/base/idtable.c
index b23a97cebf686a4e82430b9f40467451180d5ea1..6e7aafaa1562c94b8f16398acc4a6acfb42622cc 100644 (file)
--- a/base/idtable.c
+++ b/base/idtable.c
@@ -1,8 +1,22 @@
 /*
+ * 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 */
 
@@ -55,22 +69,20 @@ static void setobjdataid(Tcl_Interp *interp, Tcl_Obj *o,
   dv->assoc= assoc;
   dv->ix= ix;
   
-  o->typePtr= &tabledataid_nearlytype;
+  o->typePtr= &cht_tabledataid_nearlytype;
   o->internalRep.otherValuePtr= dv;
 }
 
-int tabledataid_parse(Tcl_Interp *ip, Tcl_Obj *o, const IdDataSpec *idds) {
+int cht_tabledataid_parse(Tcl_Interp *ip, Tcl_Obj *o, const IdDataSpec *idds) {
   int l;
   unsigned long ul;
   IdDataValue *dv;
-  IdDataAssocData *assoc;
   char *ep, *str;
 
-  if (o->typePtr != &tabledataid_nearlytype) goto convert;
+  if (o->typePtr != &cht_tabledataid_nearlytype) goto convert;
 
   dv= o->internalRep.otherValuePtr;
   if (dv->interp != ip) goto convert;
-  assoc= dv->assoc;
   if (dv->assoc->idds != idds) goto convert;
 
   return TCL_OK;
@@ -79,24 +91,24 @@ convert:
   l= strlen(idds->valprefix);
   str= Tcl_GetStringFromObj(o,0);
   if (memcmp(str,idds->valprefix,l))
-    return staticerr(ip,"bad id (wrong prefix)",0);
+    return cht_staticerr(ip,"bad id (wrong prefix)",0);
 
   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);
+  cht_objfreeir(o);
   setobjdataid(ip,o,ul,idds);
   return TCL_OK;
 }
 
-int pat_iddata(Tcl_Interp *ip, Tcl_Obj *o, void **rv, const IdDataSpec *idds) {
+int cht_pat_iddata(Tcl_Interp *ip, Tcl_Obj *o, void **rv, const IdDataSpec *idds) {
   int rc, ix;
   IdDataValue *dv;
   IdDataAssocData *assoc;
   void *r;
   
-  rc= tabledataid_parse(ip,o,idds);
+  rc= cht_tabledataid_parse(ip,o,idds);
   if (rc) return rc;
 
   dv= o->internalRep.otherValuePtr;
@@ -104,7 +116,7 @@ int pat_iddata(Tcl_Interp *ip, Tcl_Obj *o, void **rv, const IdDataSpec *idds) {
   assoc= dv->assoc;
 
   if (ix >= assoc->n || !(r= assoc->a[ix]))
-    return staticerr(ip,"id not in use",0);
+    return cht_staticerr(ip,"id not in use",0);
 
   assert(*(int*)r == ix);
 
@@ -112,7 +124,7 @@ int pat_iddata(Tcl_Interp *ip, Tcl_Obj *o, void **rv, const IdDataSpec *idds) {
   return TCL_OK;
 }
 
-Tcl_Obj *ret_iddata(Tcl_Interp *ip, void *val, const IdDataSpec *idds) {
+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 !
@@ -131,6 +143,7 @@ Tcl_Obj *ret_iddata(Tcl_Interp *ip, void *val, const IdDataSpec *idds) {
   if (ix==-1) {
     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));
@@ -147,7 +160,7 @@ Tcl_Obj *ret_iddata(Tcl_Interp *ip, void *val, const IdDataSpec *idds) {
   return o;
 }
 
-void tabledataid_disposing(Tcl_Interp *ip, void *val, const IdDataSpec *idds) {
+void cht_tabledataid_disposing(Tcl_Interp *ip, void *val, const IdDataSpec *idds) {
   IdDataAssocData *assoc;
   int ix;
 
@@ -175,7 +188,7 @@ static void tabledataid_nt_dup(Tcl_Obj *src, Tcl_Obj *dup) {
   sv= src->internalRep.otherValuePtr;
   dv= TALLOC(sizeof(*dv));
   *dv= *sv;
-  dup->typePtr= &tabledataid_nearlytype;
+  dup->typePtr= &cht_tabledataid_nearlytype;
   dup->internalRep.otherValuePtr= dv;
 }
 
@@ -190,13 +203,13 @@ static void tabledataid_nt_ustr(Tcl_Obj *o) {
   idds= assoc->idds;
 
   snprintf(buf,sizeof(buf), "%d", dv->ix);
-  obj_updatestr_vstringls(o,
+  cht_obj_updatestr_vstringls(o,
                          idds->valprefix, strlen(idds->valprefix),
                          buf, strlen(buf),
                          (char*)0);
 }
 
-Tcl_ObjType tabledataid_nearlytype = {
+Tcl_ObjType cht_tabledataid_nearlytype = {
   "tabledataid",
   tabledataid_nt_free, tabledataid_nt_dup,
   tabledataid_nt_ustr, tabledataid_nt_sfa