/*
+ * base code for various Tcl extensions
+ * Copyright 2006 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, write to the Free Software
+ * Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+ * 02110-1301, USA.
*/
-#include "tables.h"
-#include "hbytes.h"
+#include "chiark-tcl-base.h"
/* Arg parsing */
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;
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;
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);
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 !
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));
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;
sv= src->internalRep.otherValuePtr;
dv= TALLOC(sizeof(*dv));
*dv= *sv;
- dup->typePtr= &tabledataid_nearlytype;
+ dup->typePtr= &cht_tabledataid_nearlytype;
dup->internalRep.otherValuePtr= dv;
}
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