adns compiles ish, working on transferring the rest

diff --git a/Makefile b/Makefile
new file mode 100644 (file)
index 0000000..9625b20
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,7 @@
+
+SUBDIRS=       base adns
+
+default: all
+
+clean all:
+       set -e; for d in $(SUBDIRS); do $(MAKE) -C $$d $@; done

diff --git a/adns/Makefile b/adns/Makefile
index da86a2440a9e33de4538e5501fa2bf6e96b10ddf..5b9ecec892c9afe5e495300542a85d85be559b2e 100644 (file)
--- a/adns/Makefile
+++ b/adns/Makefile
@@ -1,6 +1,7 @@
 BASE_DIR =     ../base
-EXTENSION =    chiark-tcl-adns
+EXTENSION =    chiark_tcl_adns
 CFILES =       adns
+LDLIBS +=      -ladns
 
 include ../base/extension.make
 

diff --git a/adns/adns.c b/adns/adns.c
index 5248c62efd37f830b1033c3b3470398d1c38c64f..2ff423e3b9cddfa45530da0af38e3333ae684e0c 100644 (file)
--- a/adns/adns.c
+++ b/adns/adns.c
@@ -64,7 +64,7 @@
 
 #include <adns.h>
 
-#include "adnstcl.h"
+#include "chiark_tcl_adns.h"
 
 /*---------- important types and forward declarations ----------*/
 
@@ -331,7 +331,7 @@ static int create_resolver(Tcl_Interp *ip, const OptionParse *op,
                      op->config_string,
                      op->errcallback ? adnslogfn_callback : 0,
                      op->errcallback ? (void*)res : (void*)op->errfile);
-  if (ec) { rc= posixerr(ip,ec,"create adns resolver"); goto x_rc; }
+  if (ec) { rc= cht_posixerr(ip,ec,"create adns resolver"); goto x_rc; }
 
   *res_r= res;
   return TCL_OK;
@@ -344,7 +344,7 @@ static int create_resolver(Tcl_Interp *ip, const OptionParse *op,
   return rc;
 }  
 
-int do_adns_new_resolver(ClientData cd, Tcl_Interp *ip,
+int cht_do_adns_new_resolver(ClientData cd, Tcl_Interp *ip,
                         int objc, Tcl_Obj *const *objv,
                         void **result) {
   OptionParse op;
@@ -367,14 +367,14 @@ int do_adns_new_resolver(ClientData cd, Tcl_Interp *ip,
   return TCL_OK;
 }
 
-int do_adns_set_default_resolver(ClientData cd, Tcl_Interp *ip, void *res_v) {
+int cht_do_adns_set_default_resolver(ClientData cd, Tcl_Interp *ip, void *res_v) {
   Resolver *res= res_v;
   Tcl_DeleteAssocData(ip,ASSOC_DEFAULTRES);
   Tcl_SetAssocData(ip, ASSOC_DEFAULTRES, 0, res);
   return TCL_OK;
 }
 
-static const IdDataSpec adnstcl_resolvers= {
+const IdDataSpec cht_adnstcl_resolvers= {
   "adns-res", "adns-resolvers-table", destroy_resolver_idtabcb
 };
 
@@ -385,7 +385,7 @@ static const IdDataSpec adnstcl_resolvers= {
 #define RRTYPE_PLUS(t) { #t "+", adns_r_##t }
 #define RRTYPE_MINUS(t) { #t "-", adns_r_##t##_raw }
 
-const AdnsTclRRTypeInfo adnstclrrtypeinfos[]= {
+const AdnsTclRRTypeInfo cht_adnstclrrtypeinfo_entries[]= {
   RRTYPE_EXACTLY(a),
   RRTYPE_EXACTLY(cname),
   RRTYPE_EXACTLY(hinfo),
@@ -409,7 +409,7 @@ static int oifn_resolver(Tcl_Interp *ip, const OptionInfo *oi,
   void *val_v;
   int rc;
   
-  rc= pat_iddata(ip,arg,&val_v,&adnstcl_resolvers);
+  rc= cht_pat_iddata(ip,arg,&val_v,&adnstcl_resolvers);
   if (rc) return rc;
   op->resolver= val_v;
   return TCL_OK;
@@ -469,7 +469,7 @@ static int query_submit(Tcl_Interp *ip,
       r= inet_pton(*af,domain,&sa);
       if (!r) goto af_found;
     }
-    return staticerr(ip,"invalid address for adns reverse submit","");
+    return cht_staticerr(ip,"invalid address for adns reverse submit","");
   af_found:;
   }
 
@@ -486,7 +486,7 @@ static int query_submit(Tcl_Interp *ip,
                    type->number, op.aflags, context, aqu_r);
   }
   if (ec)
-    return posixerr(ip,ec,"submit adns query");
+    return cht_posixerr(ip,ec,"submit adns query");
 
   return TCL_OK;
 }
@@ -496,10 +496,10 @@ static int query_submit(Tcl_Interp *ip,
 
 static void make_resultstatus(Tcl_Interp *ip, adns_status status,
                              Tcl_Obj *results[RESULTSTATUS_LLEN]) {
-  results[0]= ret_string(ip, adns_errtypeabbrev(status));
-  results[1]= ret_int(ip, status);
-  results[2]= ret_string(ip, adns_errabbrev(status));
-  results[3]= ret_string(ip, adns_strerror(status));
+  results[0]= cht_ret_string(ip, adns_errtypeabbrev(status));
+  results[1]= cht_ret_int(ip, status);
+  results[2]= cht_ret_string(ip, adns_errabbrev(status));
+  results[3]= cht_ret_string(ip, adns_strerror(status));
 }
 
 static Tcl_Obj *make_resultrdata(Tcl_Interp *ip, adns_answer *answer) {
@@ -514,7 +514,7 @@ static Tcl_Obj *make_resultrdata(Tcl_Interp *ip, adns_answer *answer) {
        i++, datap += rrsz) {
     st= adns_rr_info(answer->type, 0,0, &rrsz, datap, &rdatastring);
     assert(!st);
-    rdata[i]= ret_string(ip, rdatastring);
+    rdata[i]= cht_ret_string(ip, rdatastring);
     free(rdatastring);
   }
   rl= Tcl_NewListObj(answer->nrrs, rdata);
@@ -527,8 +527,8 @@ static void make_resultlist(Tcl_Interp *ip, adns_answer *answer,
 
   make_resultstatus(ip, answer->status, results);
   assert(RESULTSTATUS_LLEN==4);
-  results[4]= ret_string(ip, answer->owner);
-  results[5]= ret_string(ip, answer->cname ? answer->cname : "");
+  results[4]= cht_ret_string(ip, answer->owner);
+  results[5]= cht_ret_string(ip, answer->cname ? answer->cname : "");
   results[6]= make_resultrdata(ip, answer);
 }
 
@@ -551,7 +551,7 @@ static int synch(Tcl_Interp *ip, const AdnsTclRRTypeInfo *rrtype,
   return TCL_OK;
 }
 
-int do_adns_lookup(ClientData cd, Tcl_Interp *ip,
+int cht_do_adns_lookup(ClientData cd, Tcl_Interp *ip,
                   const AdnsTclRRTypeInfo *rrtype,
                   const char *domain,
                   int objc, Tcl_Obj *const *objv,
@@ -572,7 +572,7 @@ int do_adns_lookup(ClientData cd, Tcl_Interp *ip,
   return TCL_OK;
 }
 
-int do_adns_synch(ClientData cd, Tcl_Interp *ip,
+int cht_do_adns_synch(ClientData cd, Tcl_Interp *ip,
                  const AdnsTclRRTypeInfo *rrtype,
                  const char *domain,
                  int objc, Tcl_Obj *const *objv,
@@ -703,7 +703,7 @@ static void asynch_check_now(Resolver *res) {
     query= query_v;
 
     query->aqu= 0;
-    tabledataid_disposing(interp, query, &adnstcl_queries);
+    cht_tabledataid_disposing(interp, query, &adnstcl_queries);
 
     si= (!answer->status ? &query->on_yes
         : answer->status > adns_s_max_tempfail ? &query->on_no
@@ -711,7 +711,7 @@ static void asynch_check_now(Resolver *res) {
 
     make_resultlist(interp, answer, results);
     free(answer);
-    scriptinv_invoke(si, RESULTLIST_LLEN, results);
+    cht_scriptinv_invoke(si, RESULTLIST_LLEN, results);
     asynch_query_dispose(interp, query);
   }
 
@@ -720,7 +720,7 @@ static void asynch_check_now(Resolver *res) {
   Tcl_Release(res);
 }
     
-int do_adns_asynch(ClientData cd, Tcl_Interp *ip,
+int cht_do_adns_asynch(ClientData cd, Tcl_Interp *ip,
                   Tcl_Obj *on_yes, Tcl_Obj *on_no,
                   Tcl_Obj *on_fail, Tcl_Obj *xargs,
                   const AdnsTclRRTypeInfo *rrtype, const char *domain,
@@ -732,9 +732,9 @@ int do_adns_asynch(ClientData cd, Tcl_Interp *ip,
   query= TALLOC(sizeof(*query));
   query->ix= -1;
   query->aqu= 0;
-  scriptinv_init(&query->on_yes);
-  scriptinv_init(&query->on_no);
-  scriptinv_init(&query->on_fail);
+  cht_scriptinv_init(&query->on_yes);
+  cht_scriptinv_init(&query->on_no);
+  cht_scriptinv_init(&query->on_fail);
   query->xargs= 0;
 
   rc= query_submit(ip,rrtype,domain,objc,objv,&query->aqu,query,&query->res);
@@ -742,9 +742,9 @@ int do_adns_asynch(ClientData cd, Tcl_Interp *ip,
 
   res= query->res;
 
-  rc= scriptinv_set(&query->on_yes, ip,on_yes, xargs);  if (rc) goto x_rc;
-  rc= scriptinv_set(&query->on_no,  ip,on_no,  xargs);  if (rc) goto x_rc;
-  rc= scriptinv_set(&query->on_fail,ip,on_fail,xargs);  if (rc) goto x_rc;
+  rc= cht_scriptinv_set(&query->on_yes, ip,on_yes, xargs);  if (rc) goto x_rc;
+  rc= cht_scriptinv_set(&query->on_no,  ip,on_no,  xargs);  if (rc) goto x_rc;
+  rc= cht_scriptinv_set(&query->on_fail,ip,on_fail,xargs);  if (rc) goto x_rc;
   query->xargs= xargs;
   Tcl_IncrRefCount(xargs);
   *result= query;
@@ -757,7 +757,7 @@ int do_adns_asynch(ClientData cd, Tcl_Interp *ip,
   return rc;
 }
 
-int do_adns_asynch_cancel(ClientData cd, Tcl_Interp *ip, void *query_v) {
+int cht_do_adns_asynch_cancel(ClientData cd, Tcl_Interp *ip, void *query_v) {
   Query *query= query_v;
   Resolver *res= query->res;
   asynch_query_dispose(ip, query);
@@ -766,10 +766,10 @@ int do_adns_asynch_cancel(ClientData cd, Tcl_Interp *ip, void *query_v) {
 }
 
 static void asynch_query_dispose(Tcl_Interp *interp, Query *query) {
-  tabledataid_disposing(interp, query, &adnstcl_queries);
-  scriptinv_cancel(&query->on_yes);
-  scriptinv_cancel(&query->on_no);
-  scriptinv_cancel(&query->on_fail);
+  cht_tabledataid_disposing(interp, query, &adnstcl_queries);
+  cht_scriptinv_cancel(&query->on_yes);
+  cht_scriptinv_cancel(&query->on_no);
+  cht_scriptinv_cancel(&query->on_fail);
   if (query->xargs) Tcl_DecrRefCount(query->xargs);
   if (query->aqu) adns_cancel(query->aqu);
   TFREE(query);
@@ -785,16 +785,13 @@ const IdDataSpec adnstcl_queries= {
 
 /*---------- main hooks for tcl ----------*/
 
-int do_toplevel_adns(ClientData cd, Tcl_Interp *ip,
+int cht_do_adnstoplevel_adns(ClientData cd, Tcl_Interp *ip,
                      const Adns_SubCommand *subcmd,
                      int objc, Tcl_Obj *const *objv) {
   return subcmd->func(0,ip,objc,objv);
 }
 
-extern int Adns_Init(Tcl_Interp *ip); /* called by Tcl's "load" */
-int Adns_Init(
-  Tcl_RegisterObjType(&blockcipherkey_type);
-  Tcl_RegisterObjType(&sockaddr_type);
-  Tcl_RegisterObjType(&tabledataid_nearlytype);
-  Tcl_RegisterObjType(&ulong_type);
-  Tcl_RegisterObjType(&addrmap_type);
+extern int Chiark_tcl_adns_Init(Tcl_Interp *ip); /* called by Tcl's "load" */
+int Chiark_tcl_adns_Init(Tcl_Interp *ip) {
+  return cht_initextension(ip, cht_adnstoplevel_entries, 0);
+}

diff --git a/adns/adns.tct b/adns/adns.tct
index dc620179bebce37199bbd4eed169b7b0efdcfeff..6bb013933ac0787f38a07b056306581040b3f60d 100644 (file)
--- a/adns/adns.tct
+++ b/adns/adns.tct
@@ -1,22 +1,20 @@
-H-Include "adnstcl.h"
-
 Type adnsresults:              adns_answer *@
 Init adnsresults               @=0;
 Fini adnsresults               free(@);
 
-Table toplevel TopLevel_Command
+Table adnstoplevel TopLevel_Command
        adns
-               subcmd  enum(Adns_SubCommand,"adns subcommand")
+               subcmd  enum(Adns/_SubCommand, "adns subcommand")
                ...     obj
 
 Table adns Adns_SubCommand
        lookup
-               rrtype  enum(AdnsTclRRTypeInfo, "rrtype")
+               rrtype  enum(AdnsTclRRTypeInfo/, "rrtype")
                domain  string
                ...     obj
                =>      obj
        synch
-               rrtype  enum(AdnsTclRRTypeInfo, "rrtype")
+               rrtype  enum(AdnsTclRRTypeInfo/, "rrtype")
                domain  string
                ...     obj
                =>      obj
@@ -25,7 +23,7 @@ Table adns Adns_SubCommand
                on_no   obj
                on_fail obj
                xargs   obj
-               rrtype  enum(AdnsTclRRTypeInfo, "rrtype")
+               rrtype  enum(AdnsTclRRTypeInfo/, "rrtype")
                domain  string
                ...     obj
                =>      iddata(&adnstcl_queries)

diff --git a/base/Makefile b/base/Makefile
index 314b2df6006a283cf88f0f1b20ae66a9e3b5ecbb..958939dc4a80842da40bf88dc2cee1672f5049b5 100644 (file)
--- a/base/Makefile
+++ b/base/Makefile
@@ -1,17 +1,13 @@
 default:       all
 
 SHLIB =                chiark-tcl
-CFILES =       hook parse tcmdiflib
+CFILES =       enum hook idtable parse scriptinv tcmdiflib
 BASE_DIR =     .
 
 AUTO_HDRS +=   tables.h
-AUTO_SRCS +=   tables.c
 
 include common.make
 
-tables.c:      $(BASE_TCT) $(TCMDIFGEN)
-               $(TCMDIFGEN) -wc -o$@ $<
-
 tables.h:      $(BASE_TCT) $(TCMDIFGEN)
                $(TCMDIFGEN) -wh -o$@ $<
 

diff --git a/base/enum.c b/base/enum.c
index e3fa041b6d621875909bb06c84a0e23011555785..4f2a8b7d1868d72cd6de4ce971bf6e28a2c5d4b2 100644 (file)
--- a/base/enum.c
+++ b/base/enum.c
@@ -4,7 +4,8 @@
 
 #include <string.h>
 
-#include "hbytes.h"
+#include "chiark-tcl.h"
+#include "tables.h"
 
 static void enum_nt_dup(Tcl_Obj *src, Tcl_Obj *dup) {
   dup->internalRep= src->internalRep;
@@ -19,12 +20,12 @@ static int enum_nt_sfa(Tcl_Interp *ip, Tcl_Obj *o) {
   abort();
 }
 
-Tcl_ObjType enum_nearlytype = {
+Tcl_ObjType cht_enum_nearlytype = {
   "enum-nearly",
   0, enum_nt_dup, enum_nt_ustr, enum_nt_sfa
 };
 
-Tcl_ObjType enum1_nearlytype = {
+Tcl_ObjType cht_enum1_nearlytype = {
   "enum1-nearly",
   0, enum_nt_dup, enum_nt_ustr, enum_nt_sfa
 };
@@ -58,13 +59,13 @@ static void appres_enum(Tcl_Interp *ip, const void *p) {
   Tcl_AppendResult(ip, enum_str(p), (char*)0);
 }
 
-const void *enum_lookup_cached_func(Tcl_Interp *ip, Tcl_Obj *o,
+const void *cht_enum_lookup_cached_func(Tcl_Interp *ip, Tcl_Obj *o,
                                    const void *firstentry, size_t entrysize,
                                    const char *what) {
   const char *supplied, *found;
   const char *ep;
   
-  if (o->typePtr == &enum_nearlytype &&
+  if (o->typePtr == &cht_enum_nearlytype &&
       o->internalRep.twoPtrValue.ptr1 == firstentry)
     return o->internalRep.twoPtrValue.ptr2;
 
@@ -74,8 +75,8 @@ const void *enum_lookup_cached_func(Tcl_Interp *ip, Tcl_Obj *o,
        ep += entrysize);
 
   if (found) {
-    objfreeir(o);
-    o->typePtr= &enum_nearlytype;
+    cht_objfreeir(o);
+    o->typePtr= &cht_enum_nearlytype;
     o->internalRep.twoPtrValue.ptr1= (void*)firstentry;
     o->internalRep.twoPtrValue.ptr2= (void*)ep;
     return ep;
@@ -93,11 +94,11 @@ static void appres_enum1(Tcl_Interp *ip, const void *p) {
   Tcl_AppendResult(ip, buf, (char*)0);
 }
 
-int enum1_lookup_cached_func(Tcl_Interp *ip, Tcl_Obj *o,
+int cht_enum1_lookup_cached_func(Tcl_Interp *ip, Tcl_Obj *o,
                             const char *opts, const char *what) {
   const char *supplied, *fp;
   
-  if (o->typePtr != &enum1_nearlytype ||
+  if (o->typePtr != &cht_enum1_nearlytype ||
       o->internalRep.twoPtrValue.ptr1 != opts) {
 
     supplied= Tcl_GetStringFromObj(o,0);  assert(supplied);
@@ -108,8 +109,8 @@ int enum1_lookup_cached_func(Tcl_Interp *ip, Tcl_Obj *o,
       return -1;
     }
     
-    objfreeir(o);
-    o->typePtr= &enum1_nearlytype;
+    cht_objfreeir(o);
+    o->typePtr= &cht_enum1_nearlytype;
     o->internalRep.twoPtrValue.ptr1= (void*)opts;
     o->internalRep.twoPtrValue.ptr2= (void*)fp;
   }

diff --git a/base/extension.make b/base/extension.make
index 8522f48110731be354f0ec8e6a1fa6b890decc5c..775a409912f0f9ad84b53d5a1a570ebf3a0c5ff9 100644 (file)
--- a/base/extension.make
+++ b/base/extension.make
@@ -3,17 +3,19 @@ SHLIB ?=      $(EXTENSION)
 
 AUTO_HDRS +=   tables.h
 AUTO_SRCS +=   tables.c
+CFILES +=      tables
 
-LDLIBS +=      -L ../base $(addprefix -l,$(EXTDEPENDS)) -lchiark-tcl
+LDLIBS +=      $(BASE_DIR)/chiark-tcl.so
 
 include                $(BASE_DIR)/common.make
-
 include                $(BASE_DIR)/shlib.make
 
+TCMDIFARGS ?=  -p$(EXTENSION) -o$@ $(BASE_TCT) $<
+
 %.c:           %.tct $(BASE_TCT) $(TCMDIFGEN)
-               $(TCMDIFGEN) -wc -p$(EXTENSION) -o$@ $(BASE_TCT) $<
+               $(TCMDIFGEN) -wc $(TCMDIFARGS)
 
 %.h:           %.tct $(BASE_TCT) $(TCMDIFGEN)
-               $(TCMDIFGEN) -wh -p$(EXTENSION) -o$@ $(BASE_TCT) $<
+               $(TCMDIFGEN) -wh $(TCMDIFARGS)
 
 include                $(BASE_DIR)/final.make

diff --git a/base/final.make b/base/final.make
index c726253eca3f8820757b7725ecee9b1ee6a078cf..4df82bfc7dda25d8d85723edb07751972c1532b2 100644 (file)
--- a/base/final.make
+++ b/base/final.make
@@ -7,7 +7,7 @@ $(OBJS_CFILES): $(AUTO_HDRS)
 
 clean:
                rm -f $(AUTOS) *~ ./#*#
-               rm -f *.o $(CLEANS)
+               rm -f *.o *.so $(CLEANS)
 
 -include $(patsubst %.o,%.d, $(OBJS))
 

diff --git a/base/hook.c b/base/hook.c
index 56a32681a52756138a73cd4d5f5f42fbe5b7aeab..571bf07186c680c12b37979706eecd348df897f6 100644 (file)
--- a/base/hook.c
+++ b/base/hook.c
@@ -99,6 +99,7 @@ int cht_initextension(Tcl_Interp *ip, const TopLevel_Command *cmds,
 
   if (!cht_initd) {
     cht_initd= 1;
+    Tcl_RegisterObjType(&cht_tabledataid_nearlytype);
     Tcl_RegisterObjType(&cht_enum_nearlytype);
     Tcl_RegisterObjType(&cht_enum1_nearlytype);
   }

diff --git a/base/idtable.c b/base/idtable.c
index b23a97cebf686a4e82430b9f40467451180d5ea1..2d73e3d16d42667d26d98df46f3e35005cd8fc3a 100644 (file)
--- a/base/idtable.c
+++ b/base/idtable.c
@@ -1,8 +1,8 @@
 /*
  */
 
+#include "chiark-tcl.h"
 #include "tables.h"
-#include "hbytes.h"
 
 /* Arg parsing */
 
@@ -55,18 +55,18 @@ 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;
@@ -79,24 +79,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 +104,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 +112,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 !
@@ -147,7 +147,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 +175,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 +190,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

diff --git a/base/scriptinv.c b/base/scriptinv.c
index 482f4877e6f2683651aa2fadc665ab8938ed16e9..29651b254769d61680f542a4671d156847acea74 100644 (file)
--- a/base/scriptinv.c
+++ b/base/scriptinv.c
@@ -1,23 +1,23 @@
 /*
  */
 
-#include "hbytes.h"
+#include "chiark-tcl.h"
 
-void scriptinv_init(ScriptToInvoke *si) {
+void cht_scriptinv_init(ScriptToInvoke *si) {
   si->obj= 0;
   si->xargs= 0;
 }
 
-void scriptinv_cancel(ScriptToInvoke *si) {
+void cht_scriptinv_cancel(ScriptToInvoke *si) {
   if (si->obj) { Tcl_DecrRefCount(si->obj); si->obj= 0; }
   if (si->xargs) { Tcl_DecrRefCount(si->xargs); si->xargs= 0; }
 }
 
-int scriptinv_set(ScriptToInvoke *si, Tcl_Interp *ip,
+int cht_scriptinv_set(ScriptToInvoke *si, Tcl_Interp *ip,
                  Tcl_Obj *newscript, Tcl_Obj *xargs) {
   int rc, xlength;
   
-  scriptinv_cancel(si);
+  cht_scriptinv_cancel(si);
 
   rc= Tcl_ListObjLength(ip, newscript, &si->llength);  if (rc) return rc;
   Tcl_IncrRefCount(newscript);
@@ -34,7 +34,7 @@ int scriptinv_set(ScriptToInvoke *si, Tcl_Interp *ip,
   return 0;
 }  
   
-void scriptinv_invoke(ScriptToInvoke *si, int argc, Tcl_Obj *const *argv) {
+void cht_scriptinv_invoke(ScriptToInvoke *si, int argc, Tcl_Obj *const *argv) {
   Tcl_Obj *invoke=0;
   int i, rc;
 

diff --git a/base/tcmdifgen b/base/tcmdifgen
index f14249ca4dd2441e3b9745d1fa625f76fc9cf1aa..95329dd4e543ae9442f9e5882f23ba25989e6cc5 100755 (executable)
--- a/base/tcmdifgen
+++ b/base/tcmdifgen
@@ -63,8 +63,8 @@
 #         Tcl_ObjCmdProc *func;
 #     and the generated .c will contain
 #         const C-ENTRY-TYPE C-ARRAY-NAME[];
-#     where C-ARRAY-NAME is C-ENTRY-TYPE lowercased, with
-#     `s' appended.  The entries are indented one level (one
+#     where C-ARRAY-NAME is TABLENAME, with `_entries' appended
+#     and `cht_' prepended.  The entries are indented one level (one
 #     or more spaces) and look like this:
 #        ENTRYNAME
 #            FORMALARGNAME   TYPE
@@ -150,6 +150,17 @@ sub zilch () {
     undef $c_of;
 }
 
+sub enumargs ($) {
+    my ($a) = @_;
+    $a =~ m:/(.*),: or die "invalid enum type \`$a'\n";
+    my ($a_tab, $ee_type, $estr) = ($`,$1,$');
+    if ($ee_type !~ m/^[^_]/) {
+       $ee_type= $a_tab.$ee_type;
+       $a_tab= lc($a_tab).'_entries';
+    }
+    return ($a_tab, $ee_type, $estr);
+}
+
 sub parse ($$) {
     my ($wh,$f) = @_;
     while (defined($_= $f->getline)) {
@@ -167,7 +178,7 @@ sub parse ($$) {
            unshift @i, $this_indent;
        }
 
-       if (@i==0 && m/^Table\s+(\*toplevel\*|\w+)\s+(\w+)$/) {
+       if (@i==0 && m/^Table\s+(\w+)\s+(\w+)$/) {
            zilch();
            $c_table= $1;
            $table_x{$c_table}{C}= $2;
@@ -310,10 +321,9 @@ foreach $c_table (sort keys %tables) {
                $pa_vars .= "  const void *v_$n= 0;\n";
                $paarg= "&v_$n";
                $pafin= "\n  a_$n= v_$n; ";
-               $a =~ m/\,/ or die "invalid enum type \`$a'\n";
-               $a_tab = lc($`).'s';
-               $a = "$a_tab, sizeof($`), $'";
-               o('h', 210, "extern const $` $a_tab".'[]'.";\n");
+               ($a_tab, $ee_type, $estr) = enumargs($a);
+               $a = "cht_$a_tab, sizeof($ee_type), $estr";
+               o('h', 210, "extern const $ee_type cht_$a_tab".'[]'.";\n");
            }
            if (exists $type_fini{$t}) {
                $pa_fini .= '  '.subst_in("a_$n", $type_fini{$t})."\n";
@@ -369,7 +379,7 @@ foreach $c_table (sort keys %tables) {
            $pa_vars .= "  const char *e;\n";
            $pa_fini .= "\n";
            $pa_fini .= "e_err:\n";
-           $pa_fini .= "  setstringresult(ip,e);\n";
+           $pa_fini .= "  cht_setstringresult(ip,e);\n";
            $pa_fini .= "  rc= TCL_ERROR; goto rc_err;\n";
        }
        $pa_vars .= "\n";
@@ -402,7 +412,7 @@ foreach $c_table (sort keys %tables) {
                           $r_entry->{I});
     }
     if (length $c_table) {
-       $decl= "const $x_table->{C} ".lc($x_table->{C}).'s[]';
+       $decl= "const $x_table->{C} cht_${c_table}_entries[]";
        o('h', 500, "extern $decl;\n");
        o('c', 100,
          "$decl = {\n".
@@ -478,8 +488,8 @@ sub make_decl ($$$$) {
     my ($n, $t, $ta, $why) = @_;
     my ($type);
     if ($t eq 'enum') {
-       $ta =~ m/\,/ or die "invalid enum type \`$t' ($why)\n";
-       $c= "const $` *@";
+       ($a_tab, $ee_type, $estr) = enumargs($ta);
+       $c= "const $ee_type* @";
     } else { 
        defined $types{$t} or die "unknown type $t ($why)\n";
        $c= $types{$t}{C};

diff --git a/crypto/crypto.tct b/crypto/crypto.tct
new file mode 100644 (file)
index 0000000..c65db1a
--- /dev/null
+++ b/crypto/crypto.tct
@@ -0,0 +1,55 @@
+Table hbcrypto_SubCommand
+       blockcipher
+               op      enum(BlockCipherOp, "op")
+               ...     obj
+       hash
+               alg     enum(HashAlgInfo, "hash alg")
+               message hb
+               =>      hb
+       hmac
+               alg     enum(HashAlgInfo, "hash alg for hmac")
+               message hb
+               key     obj
+               ?maclen obj
+               =>      hb
+       hash-prop
+               prop    enum(HashAlgPropInfo, "prop")
+               alg     enum(HashAlgInfo, "alg")
+               =>      int
+
+Table padmethodinfo PadMethodInfo
+       pkcs5
+               =>      int
+       rfc2406
+               nxthdr  obj
+               =>      int
+
+Table blockcipherop BlockCipherOp
+       e       1
+               v       hbv
+               alg     enum(BlockCipherAlgInfo, "alg")
+               key     obj
+               mode    enum(BlockCipherModeInfo, "mode")
+               ?iv     hb
+               =>      hb
+       d       0
+               v       hbv
+               alg     enum(BlockCipherAlgInfo, "alg")
+               key     obj
+               mode    enum(BlockCipherModeInfo, "mode")
+               ?iv     hb
+               =>      hb
+       mac     -1
+               msg     hb
+               alg     enum(BlockCipherAlgInfo, "alg")
+               key     obj
+               mode    enum(BlockCipherModeInfo, "mode")
+               iv      hb
+               =>      hb
+       prop    -1
+               prop    enum(BlockCipherPropInfo, "prop")
+               alg     enum(BlockCipherAlgInfo, "alg")
+               =>      int
+
+EntryExtra BlockCipherOp
+       int encrypt;

diff --git a/dgram/dgram.tct b/dgram/dgram.tct
new file mode 100644 (file)
index 0000000..63337b4
--- /dev/null
+++ b/dgram/dgram.tct
@@ -0,0 +1,17 @@
+Table addrmap AddrMap_SubCommand
+       lookup
+               map     constv(&addrmap_type)
+               addr    hb
+               ?def    obj
+               =>      obj
+       amend-range
+               map     addrmapv
+               start   hb
+               end     hb
+               data    obj
+       amend-mask
+               map     addrmapv
+               prefix  hb
+               preflen obj
+               data    obj
+

diff --git a/hbytes/Makefile b/hbytes/Makefile
new file mode 100644 (file)
index 0000000..fe1a535
--- /dev/null
+++ b/hbytes/Makefile
@@ -0,0 +1,6 @@
+BASE_DIR =     ../base
+EXTENSION =    chiark_tcl_hbytees
+CFILES =       hbytes
+
+include ../base/extension.make
+

diff --git a/hbytes/hbytes.tct b/hbytes/hbytes.tct
new file mode 100644 (file)
index 0000000..727591d
--- /dev/null
+++ b/hbytes/hbytes.tct
@@ -0,0 +1,234 @@
+Type hb:                       HBytes_Value @
+Init hb                                hbytes_sentinel(&@);
+
+Type hbv:                      HBytes_Var @
+Init hbv                       @.hb=0; init_somethingv(&@.sth);
+Fini hbv                       fini_somethingv(ip, rc, &@.sth);
+
+Type addrmapv:                 AddrMap_Var @
+Init addrmapv                  @.am=0; init_somethingv(&@.sth);
+Fini addrmapv                  fini_somethingv(ip, rc, &@.sth);
+
+Type sockaddr:                 SockAddr_Value @
+Init sockaddr                  sockaddr_clear(&@);
+
+Table toplevel TopLevel_Command
+       hbytes
+               subcmd  enum(HBytes_SubCommand, "hbytes subcommand")
+               ...     obj
+       dgram-socket
+               subcmd  enum(DgramSocket_SubCommand,"dgram-socket subcommand")
+               ...     obj
+       tuntap-socket-raw
+           subcmd enum(TunSocket_SubCommand,"tuntap-socket-raw subcommand")
+           ... obj
+       ulong
+               subcmd  enum(ULong_SubCommand,"ulong subcommand")
+               ...     obj
+       adns
+               subcmd  enum(Adns_SubCommand,"adns subcommand")
+               ...     obj
+
+Table ulong ULong_SubCommand
+       ul2int
+               v       ulong
+               =>      int
+       int2ul
+               v       int
+               =>      ulong
+       mask
+               a       ulong
+               b       ulong
+               =>      ulong
+       add
+               a       ulong
+               b       ulong
+               =>      ulong
+       multiply
+               a       ulong
+               b       ulong
+               =>      ulong
+       subtract
+               a       ulong
+               b       ulong
+               =>      ulong
+       compare
+               a       ulong
+               b       ulong
+               =>      int
+       shift
+               right   charfrom("lr", "shift direction")
+               v       ulong
+               bits    int
+               =>      ulong
+       ul2bitfields
+               value   ulong
+               ...     obj
+               =>      int
+       bitfields2ul
+               base    ulong
+               ...     obj
+               =>      ulong
+
+Table hbytes HBytes_SubCommand
+       raw2h
+               binary  obj
+               =>      hb
+       h2raw
+               hex     hb
+               =>      obj
+       ushort2h
+               value   long
+               =>      hb
+       h2ushort
+               hex     hb
+               =>      long
+       length
+               v       hb
+               =>      int
+       compare
+               a       hb
+               b       hb
+               =>      int
+       range
+               v       hb
+               start   int
+               size    int
+               =>      hb
+       prepend
+               v       hbv
+               ...     str
+       append
+               v       hbv
+               ...     str
+       rep-info
+               v       obj
+               =>      obj
+       concat
+               ...     str
+               =>      hb
+       unprepend
+               v       hbv
+               length  int
+               =>      hb
+       unappend
+               v       hbv
+               length  int
+               =>      hb
+       chopto
+               v       hbv
+               length  int
+               =>      hb
+       overwrite
+               v       hbv
+               start   int
+               sub     hb
+       trimleft
+               v       hbv
+       zeroes
+               length  int
+               =>      hb
+       repeat
+               v       hb
+               count   int
+               =>      hb
+       xor
+               v       hbv
+               d       hb
+       random
+               length  int
+               =>      hb
+       pad
+               op      enum(PadOp, "hbytes pad subcommand")
+               v       hbv
+               blocksz obj
+               meth    enum(PadMethodInfo, "pad method")
+               ...     methargs
+       blockcipher
+               op      enum(BlockCipherOp, "op")
+               ...     obj
+       hash
+               alg     enum(HashAlgInfo, "hash alg")
+               message hb
+               =>      hb
+       hmac
+               alg     enum(HashAlgInfo, "hash alg for hmac")
+               message hb
+               key     obj
+               ?maclen obj
+               =>      hb
+       hash-prop
+               prop    enum(HashAlgPropInfo, "prop")
+               alg     enum(HashAlgInfo, "alg")
+               =>      int
+       addr-map
+               subcmd  enum(AddrMap_SubCommand, "hbytes addr-map subcommand")
+               ...     obj
+
+Table padmethodinfo PadMethodInfo
+       pkcs5
+               =>      int
+       rfc2406
+               nxthdr  obj
+               =>      int
+
+Table dgram_socket DgramSocket_SubCommand
+       create
+               local   sockaddr
+               =>      iddata(&dgram_socks)
+       close
+               sock    iddata(&dgram_socks)
+       transmit
+               sock    iddata(&dgram_socks)
+               data    hb
+               remote  sockaddr
+       on-receive
+               sock    iddata(&dgram_socks)
+               ?script obj
+
+Table tuntap_socket_raw TunSocket_SubCommand
+       create
+               ?ifname string
+               =>      iddata(&tuntap_socks)
+       close
+               sock    iddata(&tuntap_socks)
+       ifname
+               sock    iddata(&tuntap_socks)
+               =>      string
+       receive
+               sock    iddata(&tuntap_socks)
+               data    hb
+       on-transmit
+               sock    iddata(&tuntap_socks)
+               mtu     long
+               ?script obj
+
+Table blockcipherop BlockCipherOp
+       e       1
+               v       hbv
+               alg     enum(BlockCipherAlgInfo, "alg")
+               key     obj
+               mode    enum(BlockCipherModeInfo, "mode")
+               ?iv     hb
+               =>      hb
+       d       0
+               v       hbv
+               alg     enum(BlockCipherAlgInfo, "alg")
+               key     obj
+               mode    enum(BlockCipherModeInfo, "mode")
+               ?iv     hb
+               =>      hb
+       mac     -1
+               msg     hb
+               alg     enum(BlockCipherAlgInfo, "alg")
+               key     obj
+               mode    enum(BlockCipherModeInfo, "mode")
+               iv      hb
+               =>      hb
+       prop    -1
+               prop    enum(BlockCipherPropInfo, "prop")
+               alg     enum(BlockCipherAlgInfo, "alg")
+               =>      int
+
+EntryExtra BlockCipherOp
+       int encrypt;