chiark / gitweb /
initial import and build-faff, wip
authorian <ian>
Sat, 7 Jan 2006 16:16:56 +0000 (16:16 +0000)
committerian <ian>
Sat, 7 Jan 2006 16:16:56 +0000 (16:16 +0000)
21 files changed:
adns/.cvsignore [new file with mode: 0644]
adns/Makefile [new file with mode: 0644]
adns/adns.c
adns/adns.tct [new file with mode: 0644]
adns/chiark_tcl_adns.h [new file with mode: 0644]
base/.cvsignore [new file with mode: 0644]
base/Makefile [new file with mode: 0644]
base/base.tct [new file with mode: 0644]
base/chiark-tcl.h
base/common.make [new file with mode: 0644]
base/extension.make [new file with mode: 0644]
base/hook.c
base/parse.c
base/shlib.make [new file with mode: 0644]
base/tables-examples.tct
base/tcmdifgen
base/tcmdiflib.c
base/tcmdiflib.h [deleted file]
base/troglodyte-Makefile
hbytes/hbglue.c [new file with mode: 0644]
hbytes/hbytes.h

diff --git a/adns/.cvsignore b/adns/.cvsignore
new file mode 100644 (file)
index 0000000..6796ef3
--- /dev/null
@@ -0,0 +1,2 @@
+tables.[ch]
+*.d
diff --git a/adns/Makefile b/adns/Makefile
new file mode 100644 (file)
index 0000000..da86a24
--- /dev/null
@@ -0,0 +1,6 @@
+BASE_DIR =     ../base
+EXTENSION =    chiark-tcl-adns
+CFILES =       adns
+
+include ../base/extension.make
+
index d57c49b..5248c62 100644 (file)
@@ -62,8 +62,9 @@
 
 #include <stdio.h>
 
-#include "tables.h"
-#include "hbytes.h"
+#include <adns.h>
+
+#include "adnstcl.h"
 
 /*---------- important types and forward declarations ----------*/
 
@@ -119,7 +120,7 @@ static int oifn_fs(Tcl_Interp *ip, const OptionInfo *oi, Tcl_Obj *arg,
 
 static int oifn_reverse_any(Tcl_Interp *ip, const OptionInfo *oi,
                            Tcl_Obj *arg, OptionParse *op) {
-  return pat_string(ip,arg,&op->reverseany);
+  return cht_pat_string(ip,arg,&op->reverseany);
 }
 
 #define OIFA1(t,f,r) { "-" #f, oifn_fa, 0, adns_##t##_##f, r }
@@ -144,14 +145,14 @@ static int parse_options(Tcl_Interp *ip, int objc, Tcl_Obj *const *objv,
   objc--; objv++;
   for (;;) {
     if (!objc--) break;
-    rc= pat_enum(ip, *objv++, &oi_v, opttable, sizeof(OptionInfo),
+    rc= cht_pat_enum(ip, *objv++, &oi_v, opttable, sizeof(OptionInfo),
                 "query or resolver option");
     if (rc) return rc;
     oi= oi_v;
 
     if (oi->takesarg) {
       if (!objc--) {
-       setstringresult(ip,"missing value for option");
+       cht_setstringresult(ip,"missing value for option");
        return TCL_ERROR;
       }
       arg= *objv++;
@@ -189,10 +190,10 @@ static int oifn_errfile(Tcl_Interp *ip, const OptionInfo *oi,
   int rc;
   const char *str;
   
-  rc= pat_string(ip,arg,&str);  if (rc) return rc;
+  rc= cht_pat_string(ip,arg,&str);  if (rc) return rc;
   if (!strcmp(str,"stderr")) op->errfile= stderr;
   else if (!strcmp(str,"stdout")) op->errfile= stdout;
-  else return staticerr(ip,"-errfile argument must be stderr or stdout",0);
+  else return cht_staticerr(ip,"-errfile argument must be stderr or stdout",0);
 
   op->aflags &= ~adns_if_noerrprint;
   op->errcallback= 0;
@@ -209,7 +210,7 @@ static int oifn_errcallback(Tcl_Interp *ip, const OptionInfo *oi,
 
 static int oifn_config(Tcl_Interp *ip, const OptionInfo *oi,
                       Tcl_Obj *arg, OptionParse *op) {
-  return pat_string(ip,arg,&op->config_string);
+  return cht_pat_string(ip,arg,&op->config_string);
 }
 
 static const OptionInfo resolver_optioninfos[]= {
@@ -226,7 +227,7 @@ static const OptionInfo resolver_optioninfos[]= {
 };
 
 static void adnslogfn_flushmessage(Resolver *res) {
-  scriptinv_invoke(&res->errcallback, 1, &res->errstring_accum);
+  cht_scriptinv_invoke(&res->errcallback, 1, &res->errstring_accum);
   Tcl_SetObjLength(res->errstring_accum, 0);
 }
 
@@ -238,7 +239,7 @@ static void adnslogfn_callback(adns_state ads, void *logfndata,
 
   l= vasprintf(&str,fmt,al);
   if (l<0) {
-    posixerr(res->interp,errno,"construct adns log callback string");
+    cht_posixerr(res->interp,errno,"construct adns log callback string");
     Tcl_BackgroundError(res->interp);
   }
 
@@ -290,7 +291,7 @@ static void destroy_resolver(Tcl_Interp *ip, Resolver *res) {
     res->ads= 0;
   }
   asynch_cancelhandlers(res);
-  scriptinv_cancel(&res->errcallback);
+  cht_scriptinv_cancel(&res->errcallback);
   Tcl_EventuallyFree(res, Tcl_Free);
 }
 
@@ -301,8 +302,8 @@ static void destroy_resolver_defcb(ClientData resolver_v, Tcl_Interp *ip) {
   destroy_resolver(ip,resolver_v);
 }
 
-int do_adns_destroy_resolver(ClientData cd, Tcl_Interp *ip, void *res_v) {
-  tabledataid_disposing(ip,res_v,&adnstcl_resolvers);
+int cht_do_adns_destroy_resolver(ClientData cd, Tcl_Interp *ip, void *res_v) {
+  cht_tabledataid_disposing(ip,res_v,&adnstcl_resolvers);
   destroy_resolver(ip,res_v);
   return TCL_OK;
 }
@@ -319,11 +320,11 @@ static int create_resolver(Tcl_Interp *ip, const OptionParse *op,
   res->timertoken= 0;
   res->maxfd= 0;
   for (i=0; i<3; i++) FD_ZERO(&res->handling[i]);
-  scriptinv_init(&res->errcallback);
+  cht_scriptinv_init(&res->errcallback);
   res->errstring_accum= 0;
 
   if (op->errcallback)
-    scriptinv_set(&res->errcallback, ip, op->errcallback, 0);
+    cht_scriptinv_set(&res->errcallback, ip, op->errcallback, 0);
 
   ec= adns_init_logfn(&res->ads,
                      op->aflags | adns_if_noautosys,
@@ -373,7 +374,7 @@ int do_adns_set_default_resolver(ClientData cd, Tcl_Interp *ip, void *res_v) {
   return TCL_OK;
 }
 
-const IdDataSpec adnstcl_resolvers= {
+static const IdDataSpec adnstcl_resolvers= {
   "adns-res", "adns-resolvers-table", destroy_resolver_idtabcb
 };
 
@@ -781,3 +782,19 @@ static void destroy_query_idtabcb(Tcl_Interp *interp, void *query_v) {
 const IdDataSpec adnstcl_queries= {
   "adns", "adns-query-table", destroy_query_idtabcb
 };
+
+/*---------- main hooks for tcl ----------*/
+
+int do_toplevel_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);
diff --git a/adns/adns.tct b/adns/adns.tct
new file mode 100644 (file)
index 0000000..dc62017
--- /dev/null
@@ -0,0 +1,41 @@
+H-Include "adnstcl.h"
+
+Type adnsresults:              adns_answer *@
+Init adnsresults               @=0;
+Fini adnsresults               free(@);
+
+Table toplevel TopLevel_Command
+       adns
+               subcmd  enum(Adns_SubCommand,"adns subcommand")
+               ...     obj
+
+Table adns Adns_SubCommand
+       lookup
+               rrtype  enum(AdnsTclRRTypeInfo, "rrtype")
+               domain  string
+               ...     obj
+               =>      obj
+       synch
+               rrtype  enum(AdnsTclRRTypeInfo, "rrtype")
+               domain  string
+               ...     obj
+               =>      obj
+       asynch
+               on_yes  obj
+               on_no   obj
+               on_fail obj
+               xargs   obj
+               rrtype  enum(AdnsTclRRTypeInfo, "rrtype")
+               domain  string
+               ...     obj
+               =>      iddata(&adnstcl_queries)
+       asynch-cancel
+               query   iddata(&adnstcl_queries)
+       new-resolver
+               ...     obj
+               =>      iddata(&adnstcl_resolvers)
+       set-default-resolver
+               res     iddata(&adnstcl_resolvers)
+       destroy-resolver
+               res     iddata(&adnstcl_resolvers)
+
diff --git a/adns/chiark_tcl_adns.h b/adns/chiark_tcl_adns.h
new file mode 100644 (file)
index 0000000..de58251
--- /dev/null
@@ -0,0 +1,18 @@
+/*
+ */
+
+#ifndef ADNSTCL_H
+#define ADNSTCL_H
+
+#include "chiark-tcl.h"
+
+typedef struct {
+  const char *name;
+  adns_rrtype number;
+} AdnsTclRRTypeInfo;
+
+const IdDataSpec adnstcl_queries, adnstcl_resolvers;
+
+#include "tables.h"
+
+#endif /*ADNSTCL_H*/
diff --git a/base/.cvsignore b/base/.cvsignore
new file mode 100644 (file)
index 0000000..6796ef3
--- /dev/null
@@ -0,0 +1,2 @@
+tables.[ch]
+*.d
diff --git a/base/Makefile b/base/Makefile
new file mode 100644 (file)
index 0000000..314b2df
--- /dev/null
@@ -0,0 +1,19 @@
+default:       all
+
+SHLIB =                chiark-tcl
+CFILES =       hook parse 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$@ $<
+
+include shlib.make
+include final.make
diff --git a/base/base.tct b/base/base.tct
new file mode 100644 (file)
index 0000000..0c4a5e6
--- /dev/null
@@ -0,0 +1,11 @@
+Type iddata(const IdDataSpec *idds):   void *@
+Type ulong:                    uint32_t @
+Type long:                     long @
+Type string:                   const char *@
+Type constv(Tcl_ObjType*):     Tcl_Obj *@
+
+Type charfrom(const char *opts, const char *what):     int
+
+NoEntryDefine  TopLevel_Command
+
+H-Include      "chiark-tcl.h"
index 206f97e..4c022cb 100644 (file)
@@ -1,130 +1,8 @@
 /*
  */
-/*
- *  hbytes raw2h BINARY                          => hex
- *  hbytes h2raw HEX                             => binary
- *
- *  hbytes length VALUE                          => count
- *  hbytes prepend VAR [VALUE ...]         = set VAR [concat VALUE ... $VAR]
- *  hbytes append VAR [VALUE ...]          = set VAR [concat $VAR VALUE ...]
- *  hbytes concat VAR [VALUE ...]          = set VAR [concat VALUE ...]
- *  hbytes unprepend VAR PREFIXLENGTH            => prefix (removed from VAR)
- *  hbytes unappend VAR SUFFIXLENGTH             => suffix (removed from VAR)
- *  hbytes chopto VAR NEWVARLENGTH               => suffix (removed from VAR)
- *                                                  (too short? error)
- *
- *  hbytes range VALUE START SIZE                => substring (or error)
- *  hbytes overwrite VAR START VALUE
- *  hbytes trimleft VAR                         removes any leading 0 octets
- *  hbytes repeat VALUE COUNT                    => COUNT copies of VALUE
- *  hbytes zeroes COUNT                          => COUNT zero bytes
- *  hbytes random COUNT                          => COUNT random bytes
- *  hbytes xor VAR VALUE                         $VAR (+)= VALUE
- *
- *  hbytes ushort2h LONG           => LONG must be <2^16, returns as hex
- *  hbytes h2ushort HEX            => |HEX| must be 2 bytes, returns as ulong
- *
- *  hbytes compare A B
- *      =>  -2   A is lexically earlier than B and not a prefix of B  (A<B)
- *          -1   A is prefix of B but not equal                       (A<B)
- *           0   A == B
- *          +1   A is B plus a nonempty suffix (ie, A has B as a prefix)
- *          +2   A is lexically later than B and does not have B as a prefix
- *
- *  hbytes pad pa|ua VAR ALG METH [METHARGS]       => worked? (always 1 for p)
- *  hbytes pad pn|un VAR BS METH [METHARGS]        => worked? (always 1 for p)
- *  hbytes pad pa|pn VAR ALG|BS pkcs5              => 1
- *  hbytes pad ua|un VAR ALG|BS pkcs5              => worked?
- *  hbytes pad pa|pn VAR ALG|BS rfc2406 NXTHDR     => 1
- *  hbytes pad ua|un VAR ALG|BS rfc2406 NXTHDRVAR  => worked?
- *
- *  hbytes blockcipher d|e VAR ALG KEY MODE [IV] => IV
- *  hbytes blockcipher mac MSG ALG KEY MODE IV   => final block
- *  hbytes blockcipher prop PROPERTY ALG         => property value
- *
- *  hbytes hash ALG MESSAGE                      => hash
- *  hbytes hmac ALG MESSAGE KEY [MACLENGTH]      => mac
- *  hbytes hash-prop PROPERTY ALG                => property value
- *
- *  ulong ul2int ULONG    => INT           can fail if >INT_MAX
- *  ulong int2ul INT      => ULONG         can fail if <0
- *  ulong mask A B                         => A & B
- *  ulong add A B                          => A + B  (mod 2^32)
- *  ulong subtract A B                     => A - B  (mod 2^32)
- *  ulong compare A B                      => 0  -1 (A<B)  +1 (A>B)
- *  ulong shift l|r ULONG BITS             fails if BITS >32
- *
- *  ulong ul2bitfields VALUE [SIZE TYPE [TYPE-ARG...] ...]  => 0/1
- *  ulong bitfields2ul BASE  [SIZE TYPE [TYPE-ARG...] ...]  => ULONG
- *      goes from left (MSbit) to right (LSbit) where
- *            SIZE is size in bits
- *            TYPE [TYPE-ARGS...] is as below
- *               zero
- *               ignore
- *               fixed ULONG-VALUE
- *               uint VARNAME/VALUE         (VARNAME if ul2bitfields;
- *               ulong VARNAME/VALUE         VALUE if bitfields2ul)
- *
- * Address ranges (addrmap.c):
- *
- *  An address range is a slightly efficient partial mapping from
- *  addresses to arbitrary data values.  An address is a number of
- *  octets expressed as an hbytes.  All the addresses covered by the
- *  same addrmap should have the same length.
- *
- *  hbytes addr-map lookup MAP-VAR ADDRESS [DEFAULT]   => DATA
- *     Error on missing default or if any prefix longer than ADDRESS.
- *
- *  hbytes addr-map amend-range MAP-VAR START END DATA
- *  hbytes addr-map amend-mask MAP-VAR PREFIX PREFIX-LENGTH DATA
- *     Sets all of the addresses in PREFIX/PREFIX-LENGTH to the
- *     relevant value.
- *
- *  Representation:
- *     An address map MAP is
- *           [list BIT-LENGTH                           \
- *                 [list START END DATA-VALUE]          \
- *                 [list START' END' DATA-VALUE']       \
- *                 ...
- *            ]
- *     The list is sorted by ascending START and entries do not overlap.
- *     START and END are both inclusive.  BIT-LENGTH is in usual Tcl
- *     integer notation and must be a multiple of 8.
- *
- * Error codes
- *
- * HBYTES BLOCKCIPHER CRYPTFAIL CRYPT  block cipher mode failed somehow (!)
- * HBYTES BLOCKCIPHER CRYPTFAIL MAC    HMAC failed somehow (!)
- * HBYTES BLOCKCIPHER LENGTH           block cipher input has unsuitable length
- * HBYTES BLOCKCIPHER PARAMS           key or iv not suitable
- * HBYTES HMAC PARAMS                  key, input or output size not suitable
- * HBYTES LENGTH OVERRUN               block too long
- * HBYTES LENGTH RANGE                 input length or offset is -ve or silly
- * HBYTES LENGTH UNDERRUN              block too short (or offset too big)
- * HBYTES LENGTH MISMATCH              when blocks must be exactly same length
- * HBYTES SYNTAX                       supposed hex block had wrong syntax
- * HBYTES VALUE OVERFLOW               value to be conv'd to hex too big/long
- * HBYTES ADDRMAP NOMATCH              no addr/mask matches address for lookup
- * HBYTES ADDRMAP UNDERRUN             addr for lookup or amend is too short
- * HBYTES ADDRMAP OVERRUN              addr for lookup or amend is too long
- * HBYTES ADDRMAP EXCLBITS             amend-mask 1-bits outside prefix len
- * HBYTES ADDRMAP BADRANGE             amend-range start > end
- * HBYTES ADDRMAP VALUE                addr-map string value is erroneous
- * SOCKADDR AFUNIX LENGTH              path for AF_UNIX socket too long
- * SOCKADDR SYNTAX IPV4                bad IPv4 socket address &/or port
- * SOCKADDR SYNTAX OTHER               bad socket addr, couldn't tell what kind
- * ULONG BITCOUNT NEGATIVE             -ve bitcount specified where not allowed
- * ULONG BITCOUNT OVERRUN              attempt to use more than 32 bits
- * ULONG BITCOUNT UNDERRUN             bitfields add up to less than 32
- * ULONG VALUE NEGATIVE                attempt convert -ve integers to ulong
- * ULONG VALUE OVERFLOW                converted value does not fit in result
- * TUNTAP IFNAME LENGTH                tun/tap interface name too long
- * TUNTAP MTU OVERRUN                  tun/tap mtu limited to 2^16 bytes
- *
- * Refs: HMAC: RFC2104 */
-
-#ifndef HBYTES_H
-#define HBYTES_H
+
+#ifndef CHIARK_TCL_H
+#define CHIARK_TCL_H
 
 #include <assert.h>
 #include <stdlib.h>
 
 typedef unsigned char Byte;
 
-/* from hbytes.c */
-
-int Hbytes_Init(Tcl_Interp *ip); /* called by Tcl's "load" */
-
-/* Internal representation details: */
-#define HBYTES_ISEMPTY(hb)    (!(hb)->begin_complex && !(hb)->end_0)
-#define HBYTES_ISSENTINEL(hb) (!(hb)->begin_complex && (hb)->end_0)
-#define HBYTES_ISSIMPLE(hb)   ((hb)->begin_complex && (hb)->end_0)
-#define HBYTES_ISCOMPLEX(hb)  ((hb)->begin_complex && !(hb)->end_0)
-
-typedef struct {
-  void *begin_complex, *end_0;
-} HBytes_Value; /* overlays internalRep */
-
-typedef struct {
-  Byte *dstart; /* always allocated dynamically */
-  int prespace, len, avail;
-  /*        
-   * | SPARE      | USED  | SPARE |
-   * |<-prespace->|<-len->|       |
-   * |            |<----avail---->|
-   *              ^start
-   */
-} HBytes_ComplexValue; /* pointed to from internalRep.otherValuePtr */
+/* for assisting tcmdifgen and tcmdiflib.c */
 
-/* Public interfaces: */
+typedef struct TopLevel_Command TopLevel_Command;
 
-extern Tcl_ObjType hbytes_type;
-
-int hbytes_len(const HBytes_Value *v);
-Byte *hbytes_data(const HBytes_Value *v); /* caller may then modify data! */
-int hbytes_issentinel(const HBytes_Value *v);
-
-Byte *hbytes_prepend(HBytes_Value *upd, int el);
-Byte *hbytes_append(HBytes_Value *upd, int el);
-  /* return value is where to put the data */
-
-const Byte *hbytes_unprepend(HBytes_Value *upd, int rl);
-const Byte *hbytes_unappend(HBytes_Value *upd, int rl);
-  /* return value points to the removed data, which remains valid
-   * until next op on the HBytes_Value.  If original value is
-   * shorter than rl or negative, returns 0 and does nothing. */
-
-void hbytes_empty(HBytes_Value *returns);
-void hbytes_sentinel(HBytes_Value *returns);
-void hbytes_array(HBytes_Value *returns, const Byte *array, int l);
-Byte *hbytes_arrayspace(HBytes_Value *returns, int l);
-void hbytes_free(const HBytes_Value *frees);
-  /* _empty, _sentinel and _array do not free or read the old value;
-   * _free it first if needed.  _free leaves it garbage, so you
-   * have to call _empty to reuse it.  _arrayspace doesn't fill
-   * the array; you get a pointer and must fill it with data
-   * yourself. */
-
-/* The value made by hbytes_sentinel should not be passed to
- * anything except HBYTES_IS..., and hbytes_free. */
-
-/* from sockaddr.c */
-
-typedef struct {
-  Byte *begin, *end;
-} SockAddr_Value;
-
-extern Tcl_ObjType sockaddr_type;
+struct TopLevel_Command {
+  const char *name;
+  Tcl_ObjCmdProc *func;
+};
 
-void sockaddr_clear(SockAddr_Value*);
-void sockaddr_create(SockAddr_Value*, const struct sockaddr *addr, int len);
-int sockaddr_len(const SockAddr_Value*);
-const struct sockaddr *sockaddr_addr(const SockAddr_Value*);
-void sockaddr_free(const SockAddr_Value*);
+void cht_setstringresult(Tcl_Interp*, const char*);
+int cht_pat_enum(Tcl_Interp*, Tcl_Obj*, const void**,
+                const void*, size_t, const char *what);
 
 /* from scriptinv.c */
 
@@ -222,13 +42,13 @@ typedef struct { /* semi-opaque - read only, and then only where commented */
   int llength;
 } ScriptToInvoke;
 
-void scriptinv_init(ScriptToInvoke *si);
-int scriptinv_set(ScriptToInvoke *si, Tcl_Interp *ip,
+void cht_scriptinv_init(ScriptToInvoke *si);
+int cht_scriptinv_set(ScriptToInvoke *si, Tcl_Interp *ip,
                  Tcl_Obj *newscript, Tcl_Obj *xargs);
-void scriptinv_cancel(ScriptToInvoke *si); /* then don't invoke */
+void cht_scriptinv_cancel(ScriptToInvoke *si); /* then don't invoke */
   /* no separate free function - just cancel */
 
-void scriptinv_invoke(ScriptToInvoke *si, int argc, Tcl_Obj *const *argv);
+void cht_scriptinv_invoke(ScriptToInvoke *si, int argc, Tcl_Obj *const *argv);
 
 /* from idtable.c */
 
@@ -242,45 +62,32 @@ typedef struct {
  * be -1; on subsequent occasions it must be >=0.  ix will be -1 iff
  * the struct is registered by the iddatatable machinery. */
 
-extern Tcl_ObjType tabledataid_nearlytype;
-int tabledataid_parse(Tcl_Interp *ip, Tcl_Obj *o, const IdDataSpec *idds);
-void tabledataid_disposing(Tcl_Interp *ip, void *val, const IdDataSpec *idds);
+extern Tcl_ObjType cht_tabledataid_nearlytype;
+int cht_tabledataid_parse(Tcl_Interp *ip, Tcl_Obj *o, const IdDataSpec *idds);
+void cht_tabledataid_disposing(Tcl_Interp *ip, void *val, const IdDataSpec *idds);
   /* call this when you destroy the struct, to remove its name;
    * _disposing is idempotent */
 
-/* from adns.c */
-
-typedef struct {
-  const char *name;
-  adns_rrtype number;
-} AdnsTclRRTypeInfo;
-
-extern const IdDataSpec adnstcl_queries, adnstcl_resolvers;
-
-/* from dgram.c */
-
-extern const IdDataSpec dgram_socks;
-int newfdposixerr(Tcl_Interp *ip, int fd, const char *m);
-
-/* from tuntap.c */
-
-extern const IdDataSpec tuntap_socks;
-
 /* from hook.c */
 
-int staticerr(Tcl_Interp *ip, const char *m, const char *ec);
-int posixerr(Tcl_Interp *ip, int errnoval, const char *m);
-void objfreeir(Tcl_Obj *o);
-int get_urandom(Tcl_Interp *ip, Byte *buffer, int l);
+int cht_initextension(Tcl_Interp *ip, const TopLevel_Command *cmds,
+                     int *donep /* or 0, meaning no types follow */,
+                     ... /* types, terminated by 0 */);
+
+int cht_staticerr(Tcl_Interp *ip, const char *m, const char *ec);
+int cht_posixerr(Tcl_Interp *ip, int errnoval, const char *m);
+int cht_newfdposixerr(Tcl_Interp *ip, int fd, const char *m);
+void cht_objfreeir(Tcl_Obj *o);
+int cht_get_urandom(Tcl_Interp *ip, Byte *buffer, int l);
 
-void obj_updatestr_array(Tcl_Obj *o, const Byte *array, int l);
-void obj_updatestr_array_prefix(Tcl_Obj *o, const Byte *byte,
+void cht_obj_updatestr_array(Tcl_Obj *o, const Byte *array, int l);
+void cht_obj_updatestr_array_prefix(Tcl_Obj *o, const Byte *byte,
                                int l, const char *prefix);
 
-void obj_updatestr_vstringls(Tcl_Obj *o, ...);
+void cht_obj_updatestr_vstringls(Tcl_Obj *o, ...);
   /* const char*, int, const char*, int, ..., (const char*)0 */
-void obj_updatestr_string_len(Tcl_Obj *o, const char *str, int l);
-void obj_updatestr_string(Tcl_Obj *o, const char *str);
+void cht_obj_updatestr_string_len(Tcl_Obj *o, const char *str, int l);
+void cht_obj_updatestr_string(Tcl_Obj *o, const char *str);
 
 /* from parse.c */
 
@@ -289,44 +96,21 @@ typedef struct {
   int copied;
 } Something_Var;
 
-void init_somethingv(Something_Var *sth);
-void fini_somethingv(Tcl_Interp *ip, int rc, Something_Var *sth);
-int pat_somethingv(Tcl_Interp *ip, Tcl_Obj *var,
+void cht_init_somethingv(Something_Var *sth);
+void cht_fini_somethingv(Tcl_Interp *ip, int rc, Something_Var *sth);
+int cht_pat_somethingv(Tcl_Interp *ip, Tcl_Obj *var,
                   Something_Var *sth, Tcl_ObjType *type);
 
-typedef struct {
-  HBytes_Value *hb;
-  Something_Var sth;
-} HBytes_Var;
-
-/* from addrmap.c */
-
-typedef struct AddrMap_Value AddrMap_Value;
-
-typedef struct {
-  AddrMap_Value *am;
-  Something_Var sth;
-} AddrMap_Var;
-
-extern Tcl_ObjType addrmap_type;
-
-/* from chop.c */
-  /* only do_... functions declared in tables.h */
-
-/* from ulong.c */
-
-Tcl_ObjType ulong_type;
-
 /* from enum.c */
 
-extern Tcl_ObjType enum_nearlytype;
-extern Tcl_ObjType enum1_nearlytype;
+extern Tcl_ObjType cht_enum_nearlytype;
+extern Tcl_ObjType cht_enum1_nearlytype;
 
-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);
 #define enum_lookup_cached(ip,o,table,what)                    \
-    (enum_lookup_cached_func((ip),(o),                         \
+    (cht_enum_lookup_cached_func((ip),(o),                             \
                             &(table)[0],sizeof((table)[0]),    \
                             (what)))
   /* table should be a pointer to an array of structs of size
@@ -336,98 +120,14 @@ const void *enum_lookup_cached_func(Tcl_Interp *ip, Tcl_Obj *o,
    * set to the error message.
    */
 
-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);
   /* -1 => error */
 
-/* from crypto.c */
-
-void memxor(Byte *dest, const Byte *src, int l);
-
-typedef struct {
-  const char *name;
-  int pad, use_algname;
-} PadOp;
-
-extern Tcl_ObjType blockcipherkey_type;
-
-/* from algtables.c */
-
-typedef struct {
-  const char *name;
-  int int_offset;
-} BlockCipherPropInfo, HashAlgPropInfo;
-
-typedef struct {
-  const char *name;
-  int hashsize, blocksize, statesize;
-  void (*init)(void *state);
-  void (*update)(void *state, const void *data, int len);
-  void (*final)(void *state, void *digest);
-  void (*oneshot)(void *digest, const void *data, int len);
-} HashAlgInfo;
-
-extern const HashAlgInfo hashalginfos[];
-
-typedef struct {
-  void (*make_schedule)(void *schedule, const void *key, int keylen);
-  void (*crypt)(const void *schedule, const void *in, void *out);
-     /* in and out may be the same, but if they aren't they may not overlap */
-     /* in and out for crypt will have been through block_byteswap */
-} BlockCipherPerDirectionInfo;
-
-typedef struct {
-  const char *name;
-  int blocksize, schedule_size, key_min, key_max;
-  BlockCipherPerDirectionInfo encrypt, decrypt;
-} BlockCipherAlgInfo;
-
-extern const BlockCipherAlgInfo blockcipheralginfos[];
-
-/* from bcmode.c */
-
-typedef struct {
-  const char *name;
-  int iv_blocks, buf_blocks, mac_blocks;
-
-  /* Each function is allowed to use up to buf_blocks * blocksize
-   * bytes of space in buf.  data is blocks * blocksize bytes
-   * long.  data should be modified in place by encrypt and decrypt;
-   * modes may not change the size of data.  iv is always provided and
-   * is always of length iv_blocks * blocksize; encrypt and
-   * decrypt may modify the iv value (in which case the Tcl caller
-   * will get the modified IV) but this is not recommended.  mac
-   * should leave the mac, which must be mac_blocks * blocksize
-   * bytes, in buf.  (Therefore mac_blocks must be at least
-   * buf_blocks.)
-   */
-  const char *(*encrypt)(Byte *data, int nblocks,
-                        const Byte *iv, Byte *buf,
-                        const BlockCipherAlgInfo *alg, int encr,
-                        const void *sch);
-  const char *(*decrypt)(Byte *data, int nblocks,
-                        const Byte *iv, Byte *buf,
-                        const BlockCipherAlgInfo *alg, int encr,
-                        const void *sch);
-  const char *(*mac)(const Byte *data, int nblocks,
-                    const Byte *iv, Byte *buf,
-                    const BlockCipherAlgInfo *alg,
-                    const void *sch);
-} BlockCipherModeInfo;
-
-extern const BlockCipherModeInfo blockciphermodeinfos[];
-
-/* from misc.c */
-
-int setnonblock(int fd, int isnonblock);
-
 /* useful macros */
 
-#define OBJ_HBYTES(o) ((HBytes_Value*)&(o)->internalRep.twoPtrValue)
-#define OBJ_SOCKADDR(o) ((SockAddr_Value*)&(o)->internalRep.twoPtrValue)
-
 #define TALLOC(s) ((void*)Tcl_Alloc((s)))
 #define TFREE(f) (Tcl_Free((void*)(f)))
 #define TREALLOC(p,l) ((void*)Tcl_Realloc((void*)(p),(l)))
 
-#endif /*HBYTES_H*/
+#endif /*CHIARK_TCL_H*/
diff --git a/base/common.make b/base/common.make
new file mode 100644 (file)
index 0000000..c24170e
--- /dev/null
@@ -0,0 +1,15 @@
+OPTIMISE ?=            -O2
+TCL_MEM_DEBUG ?=       -DTCL_MEM_DEBUG
+
+TCMDIFGEN ?=   $(BASE_DIR)/tcmdifgen
+BASE_TCT ?=    $(BASE_DIR)/base.tct
+
+CFLAGS +=      -g -Wall -Wmissing-prototypes -Wstrict-prototypes -Werror \
+               $(OPTIMISE)
+CPPFLAGS +=    -I$(BASE_DIR)
+CPPFLAGS +=    $(TCL_MEM_DEBUG)
+
+AUTOS +=       $(AUTO_SRCS) $(AUTO_HDRS)
+
+default:       all
+
diff --git a/base/extension.make b/base/extension.make
new file mode 100644 (file)
index 0000000..8522f48
--- /dev/null
@@ -0,0 +1,19 @@
+
+SHLIB ?=       $(EXTENSION)
+
+AUTO_HDRS +=   tables.h
+AUTO_SRCS +=   tables.c
+
+LDLIBS +=      -L ../base $(addprefix -l,$(EXTDEPENDS)) -lchiark-tcl
+
+include                $(BASE_DIR)/common.make
+
+include                $(BASE_DIR)/shlib.make
+
+%.c:           %.tct $(BASE_TCT) $(TCMDIFGEN)
+               $(TCMDIFGEN) -wc -p$(EXTENSION) -o$@ $(BASE_TCT) $<
+
+%.h:           %.tct $(BASE_TCT) $(TCMDIFGEN)
+               $(TCMDIFGEN) -wh -p$(EXTENSION) -o$@ $(BASE_TCT) $<
+
+include                $(BASE_DIR)/final.make
index 5b163b3..56a3268 100644 (file)
@@ -3,16 +3,15 @@
 
 #include <errno.h>
 
-#include "hbytes.h"
-#include "tables.h"
+#include "chiark-tcl.h"
 
-int staticerr(Tcl_Interp *ip, const char *m, const char *ec) {
+int cht_staticerr(Tcl_Interp *ip, const char *m, const char *ec) {
   Tcl_SetResult(ip, (char*)m, TCL_STATIC);
   if (ec) Tcl_SetObjErrorCode(ip, Tcl_NewStringObj(ec,-1));
   return TCL_ERROR;
 }
 
-int posixerr(Tcl_Interp *ip, int errnoval, const char *m) {
+int cht_posixerr(Tcl_Interp *ip, int errnoval, const char *m) {
   const char *em;
   
   Tcl_ResetResult(ip);
@@ -22,87 +21,20 @@ int posixerr(Tcl_Interp *ip, int errnoval, const char *m) {
   return TCL_ERROR;
 }
 
-int newfdposixerr(Tcl_Interp *ip, int fd, const char *m) {
+int cht_newfdposixerr(Tcl_Interp *ip, int fd, const char *m) {
   int e;
   e= errno;
   close(fd);
-  return posixerr(ip,e,m);
+  return cht_posixerr(ip,e,m);
 }
 
-void objfreeir(Tcl_Obj *o) {
+void cht_objfreeir(Tcl_Obj *o) {
   if (o->typePtr && o->typePtr->freeIntRepProc)
     o->typePtr->freeIntRepProc(o);
   o->typePtr= 0;
 }  
 
-int do_hbytes_rep_info(ClientData cd, Tcl_Interp *ip,
-                      Tcl_Obj *obj, Tcl_Obj **result) {
-  const char *tn;
-  int nums[3], i, lnl;
-  Tcl_Obj *objl[4];
-
-  if (obj->typePtr == &hbytes_type) {
-    HBytes_Value *v= OBJ_HBYTES(obj);
-    memset(nums,0,sizeof(nums));
-    nums[1]= hbytes_len(v);
-  
-    if (HBYTES_ISEMPTY(v)) tn= "empty";
-    else if (HBYTES_ISSENTINEL(v)) tn= "sentinel!";
-    else if (HBYTES_ISSIMPLE(v)) tn= "simple";
-    else {
-      HBytes_ComplexValue *cx= v->begin_complex;
-      tn= "complex";
-      nums[0]= cx->prespace;
-      nums[2]= cx->avail - cx->len;
-    }
-    lnl= 3;
-  } else {
-    tn= "other";
-    lnl= 0;
-  }
-    
-  objl[0]= Tcl_NewStringObj((char*)tn,-1);
-  for (i=0; i<lnl; i++) objl[i+1]= Tcl_NewIntObj(nums[i]);
-  *result= Tcl_NewListObj(lnl+1,objl);
-    
-  return TCL_OK;
-}
-
-static void hbytes_t_dup(Tcl_Obj *src, Tcl_Obj *dup) {
-  hbytes_array(OBJ_HBYTES(dup),
-              hbytes_data(OBJ_HBYTES(src)),
-              hbytes_len(OBJ_HBYTES(src)));
-  dup->typePtr= &hbytes_type;
-}
-
-static void hbytes_t_free(Tcl_Obj *o) {
-  hbytes_free(OBJ_HBYTES(o));
-}
-
-void obj_updatestr_array_prefix(Tcl_Obj *o, const Byte *byte,
-                               int l, const char *prefix) {
-  char *str;
-  int pl;
-
-  pl= strlen(prefix);
-  o->length= l*2+pl;
-  str= o->bytes= TALLOC(o->length+1);
-  
-  memcpy(str,prefix,pl);
-  str += pl;
-
-  while (l>0) {
-    sprintf(str,"%02x",*byte);
-    str+=2; byte++; l--;
-  }
-  *str= 0;
-}
-
-void obj_updatestr_array(Tcl_Obj *o, const Byte *byte, int l) {
-  obj_updatestr_array_prefix(o,byte,l,"");
-}
-
-void obj_updatestr_vstringls(Tcl_Obj *o, ...) {
+void cht_obj_updatestr_vstringls(Tcl_Obj *o, ...) {
   va_list al;
   char *p;
   const char *part;
@@ -126,282 +58,20 @@ void obj_updatestr_vstringls(Tcl_Obj *o, ...) {
   *p= 0;
 }
 
-void obj_updatestr_string(Tcl_Obj *o, const char *str) {
-  obj_updatestr_vstringls(o, str, strlen(str), (char*)0);
-}
-
-static void hbytes_t_ustr(Tcl_Obj *o) {
-  obj_updatestr_array(o,
-                     hbytes_data(OBJ_HBYTES(o)),
-                     hbytes_len(OBJ_HBYTES(o)));
-}
-
-static int hbytes_t_sfa(Tcl_Interp *ip, Tcl_Obj *o) {
-  char *str, *ep, *os;
-  Byte *startbytes, *bytes;
-  int l;
-  char cbuf[3];
-
-  if (o->typePtr == &ulong_type) {
-    uint32_t ul;
-
-    ul= htonl(*(const uint32_t*)&o->internalRep.longValue);
-    hbytes_array(OBJ_HBYTES(o), (const Byte*)&ul, 4);
-
-  } else {
-  
-    os= str= Tcl_GetStringFromObj(o,&l);  assert(str);
-    objfreeir(o);
-
-    if (l & 1) return staticerr(ip, "hbytes: conversion from hex:"
-                               " odd length in hex", "HBYTES SYNTAX");
-
-    startbytes= bytes= hbytes_arrayspace(OBJ_HBYTES(o), l/2);
-
-    cbuf[2]= 0;
-    while (l>0) {
-      cbuf[0]= *str++;
-      cbuf[1]= *str++;
-      *bytes++= strtoul(cbuf,&ep,16);
-      if (ep != cbuf+2) {
-       hbytes_free(OBJ_HBYTES(o));
-       return staticerr(ip, "hbytes: conversion from hex:"
-                        " bad hex digit", "HBYTES SYNTAX");
-      }
-      l -= 2;
-    }
-
-  }
-
-  o->typePtr = &hbytes_type;
-  return TCL_OK;
-}
-
-Tcl_ObjType hbytes_type = {
-  "hbytes",
-  hbytes_t_free, hbytes_t_dup, hbytes_t_ustr, hbytes_t_sfa
-};
-
-int do_hbytes_raw2h(ClientData cd, Tcl_Interp *ip,
-                   Tcl_Obj *binary, HBytes_Value *result) {
-  const unsigned char *str;
-  int l;
-
-  str= Tcl_GetByteArrayFromObj(binary,&l);
-  hbytes_array(result, str, l);
-  return TCL_OK;
-}
-
-int do_hbytes_h2raw(ClientData cd, Tcl_Interp *ip,
-                   HBytes_Value hex, Tcl_Obj **result) {
-  *result= Tcl_NewByteArrayObj(hbytes_data(&hex), hbytes_len(&hex));
-  return TCL_OK;
-}
-
-int do_hbytes_length(ClientData cd, Tcl_Interp *ip,
-                    HBytes_Value v, int *result) {
-  *result= hbytes_len(&v);
-  return TCL_OK;
-}
-
-int do_hbytes_random(ClientData cd, Tcl_Interp *ip,
-                    int length, HBytes_Value *result) {
-  Byte *space;
-  int rc;
-  
-  space= hbytes_arrayspace(result, length);
-  rc= get_urandom(ip, space, length);
-  if (rc) { hbytes_free(result); return rc; }
-  return TCL_OK;
-}  
-  
-int do_hbytes_overwrite(ClientData cd, Tcl_Interp *ip,
-                       HBytes_Var v, int start, HBytes_Value sub) {
-  int sub_l;
-
-  sub_l= hbytes_len(&sub);
-  if (start < 0)
-    return staticerr(ip, "hbytes overwrite start -ve",
-                    "HBYTES LENGTH RANGE");
-  if (start + sub_l > hbytes_len(v.hb))
-    return staticerr(ip, "hbytes overwrite out of range",
-                    "HBYTES LENGTH UNDERRUN");
-  memcpy(hbytes_data(v.hb) + start, hbytes_data(&sub), sub_l);
-  return TCL_OK;
-}
-
-int do_hbytes_trimleft(ClientData cd, Tcl_Interp *ip, HBytes_Var v) {
-  const Byte *o, *p, *e;
-  o= p= hbytes_data(v.hb);
-  e= p + hbytes_len(v.hb);
-
-  while (p<e && !*p) p++;
-  if (p != o)
-    hbytes_unprepend(v.hb, p-o);
-
-  return TCL_OK;
-}
-
-int do_hbytes_repeat(ClientData cd, Tcl_Interp *ip,
-                    HBytes_Value sub, int count, HBytes_Value *result) {
-  int sub_l;
-  Byte *data;
-  const Byte *sub_d;
-
-  sub_l= hbytes_len(&sub);
-  if (count < 0) return staticerr(ip, "hbytes repeat count -ve",
-                                 "HBYTES LENGTH RANGE");
-  if (count > INT_MAX/sub_l) return staticerr(ip, "hbytes repeat too long", 0);
-
-  data= hbytes_arrayspace(result, sub_l*count);
-  sub_d= hbytes_data(&sub);
-  while (count) {
-    memcpy(data, sub_d, sub_l);
-    count--; data += sub_l;
-  }
-  return TCL_OK;
-}  
-
-int do_hbytes_xor(ClientData cd, Tcl_Interp *ip,
-                 HBytes_Var v, HBytes_Value d) {
-  int l;
-  Byte *dest;
-  const Byte *source;
-
-  l= hbytes_len(v.hb);
-  if (hbytes_len(&d) != l) return
-    staticerr(ip, "hbytes xor lengths do not match", "HBYTES LENGTH MISMATCH");
-
-  dest= hbytes_data(v.hb);
-  source= hbytes_data(&d);
-  memxor(dest,source,l);
-  return TCL_OK;
-}
-  
-int do_hbytes_zeroes(ClientData cd, Tcl_Interp *ip,
-                    int length, HBytes_Value *result) {
-  Byte *space;
-  space= hbytes_arrayspace(result, length);
-  memset(space,0,length);
-  return TCL_OK;
-}
-
-int do_hbytes_compare(ClientData cd, Tcl_Interp *ip,
-                     HBytes_Value a, HBytes_Value b, int *result) {
-  int al, bl, minl, r;
-
-  al= hbytes_len(&a);
-  bl= hbytes_len(&b);
-  minl= al<bl ? al : bl;
-
-  r= memcmp(hbytes_data(&a), hbytes_data(&b), minl);
-  
-  if (r<0) *result= -2;
-  else if (r>0) *result= +2;
-  else {
-    if (al<bl) *result= -1;
-    else if (al>bl) *result= +1;
-    else *result= 0;
-  }
-  return TCL_OK;
-}
-
-int do_hbytes_range(ClientData cd, Tcl_Interp *ip,
-                   HBytes_Value v, int start, int size,
-                   HBytes_Value *result) {
-  const Byte *data;
-  int l;
-
-  l= hbytes_len(&v);
-  if (start<0 || size<0)
-    return staticerr(ip,"hbytes range subscript(s) -ve","HBYTES LENGTH RANGE");
-  if (l<start+size)
-    return staticerr(ip, "hbytes range subscripts too big",
-                    "HBYTES LENGTH UNDERRUN");
-
-  data= hbytes_data(&v);
-  hbytes_array(result, data+start, size);
-  return TCL_OK;
-}
-
-int do_hbytes_addr_map(ClientData cd, Tcl_Interp *ip,
-                      const AddrMap_SubCommand *subcmd,
-                      int objc, Tcl_Obj *const *objv) {
-  return subcmd->func(0,ip,objc,objv);
-}
-
-/* hbytes representing uint16_t's */
-
-int do_hbytes_h2ushort(ClientData cd, Tcl_Interp *ip,
-                      HBytes_Value hex, long *result) {
-  const Byte *data;
-  int l;
-
-  l= hbytes_len(&hex);
-  if (l>2)
-    return staticerr(ip, "hbytes h2ushort input more than 4 hex digits",
-                    "HBYTES VALUE OVERFLOW");
-
-  data= hbytes_data(&hex);
-  *result= data[l-1] | (l>1 ? data[0]<<8 : 0);
-  return TCL_OK;
-}
-
-int do_hbytes_ushort2h(ClientData cd, Tcl_Interp *ip,
-                      long input, HBytes_Value *result) {
-  uint16_t us;
-
-  if (input > 0x0ffff)
-    return staticerr(ip, "hbytes ushort2h input >2^16",
-                    "HBYTES VALUE OVERFLOW");
-
-  us= htons(input);
-  hbytes_array(result,(const Byte*)&us,2);
-  return TCL_OK;
-}
-
-/* toplevel functions */
-
-int do_toplevel_hbytes(ClientData cd, Tcl_Interp *ip,
-                      const HBytes_SubCommand *subcmd,
-                      int objc, Tcl_Obj *const *objv) {
-  return subcmd->func(0,ip,objc,objv);
-}
-
-int do_toplevel_dgram_socket(ClientData cd, Tcl_Interp *ip,
-                            const DgramSocket_SubCommand *subcmd,
-                            int objc, Tcl_Obj *const *objv) {
-  return subcmd->func(0,ip,objc,objv);
-}
-
-int do_toplevel_tuntap_socket_raw(ClientData cd, Tcl_Interp *ip,
-                                 const TunSocket_SubCommand *subcmd,
-                                 int objc, Tcl_Obj *const *objv) {
-  return subcmd->func(0,ip,objc,objv);
-}
-
-int do_toplevel_ulong(ClientData cd, Tcl_Interp *ip,
-                     const ULong_SubCommand *subcmd,
-                     int objc, Tcl_Obj *const *objv) {
-  return subcmd->func(0,ip,objc,objv);
-}
-
-int do_toplevel_adns(ClientData cd, Tcl_Interp *ip,
-                     const Adns_SubCommand *subcmd,
-                     int objc, Tcl_Obj *const *objv) {
-  return subcmd->func(0,ip,objc,objv);
+void cht_obj_updatestr_string(Tcl_Obj *o, const char *str) {
+  cht_obj_updatestr_vstringls(o, str, strlen(str), (char*)0);
 }
 
 #define URANDOM "/dev/urandom"
 
-int get_urandom(Tcl_Interp *ip, Byte *buffer, int l) {
+int cht_get_urandom(Tcl_Interp *ip, Byte *buffer, int l) {
   static FILE *urandom;
 
   int r, esave;
 
   if (!urandom) {
     urandom= fopen(URANDOM,"rb");
-    if (!urandom) return posixerr(ip,errno,"open " URANDOM);
+    if (!urandom) return cht_posixerr(ip,errno,"open " URANDOM);
   }
   r= fread(buffer,1,l,urandom);
   if (r==l) return 0;
@@ -410,26 +80,37 @@ int get_urandom(Tcl_Interp *ip, Byte *buffer, int l) {
   fclose(urandom); urandom=0;
 
   if (ferror(urandom)) {
-    return posixerr(ip,errno,"read " URANDOM);
+    return cht_posixerr(ip,errno,"read " URANDOM);
   } else {
     assert(feof(urandom));
-    return staticerr(ip, URANDOM " gave eof!", 0);
+    return cht_staticerr(ip, URANDOM " gave eof!", 0);
   }
 }
 
-int Hbytes_Init(Tcl_Interp *ip) {
+int cht_initextension(Tcl_Interp *ip, const TopLevel_Command *cmds,
+                       int *donep /* or 0, meaning no types follow */,
+                       ... /* types, terminated by 0 */) {
+  static int cht_initd;
+
   const TopLevel_Command *cmd;
+  Tcl_ObjType *ot;
+
+  va_list al;
 
-  Tcl_RegisterObjType(&hbytes_type);
-  Tcl_RegisterObjType(&blockcipherkey_type);
-  Tcl_RegisterObjType(&enum_nearlytype);
-  Tcl_RegisterObjType(&enum1_nearlytype);
-  Tcl_RegisterObjType(&sockaddr_type);
-  Tcl_RegisterObjType(&tabledataid_nearlytype);
-  Tcl_RegisterObjType(&ulong_type);
-  Tcl_RegisterObjType(&addrmap_type);
+  if (!cht_initd) {
+    cht_initd= 1;
+    Tcl_RegisterObjType(&cht_enum_nearlytype);
+    Tcl_RegisterObjType(&cht_enum1_nearlytype);
+  }
+
+  if (donep && !*donep) {
+    *donep= 1;
+    va_start(al, donep);
+    while ((ot= va_arg(al, Tcl_ObjType*)))
+      Tcl_RegisterObjType(ot);
+  }
 
-  for (cmd=toplevel_commands;
+  for (cmd= cmds;
        cmd->name;
        cmd++)
     Tcl_CreateObjCommand(ip, (char*)cmd->name, cmd->func, 0,0);
index 0fa5acd..341c389 100644 (file)
@@ -1,29 +1,30 @@
 /*
  */
 
+#include "chiark-tcl.h"
 #include "tables.h"
 
-int pat_charfrom(Tcl_Interp *ip, Tcl_Obj *obj, int *val,
+int cht_pat_charfrom(Tcl_Interp *ip, Tcl_Obj *obj, int *val,
                 const char *opts, const char *what) {
-  *val= enum1_lookup_cached_func(ip,obj,opts,what);
+  *val= cht_enum1_lookup_cached_func(ip,obj,opts,what);
   if (*val==-1) return TCL_ERROR;
   return TCL_OK;
 }
 
-int pat_int(Tcl_Interp *ip, Tcl_Obj *obj, int *val) {
+int cht_pat_int(Tcl_Interp *ip, Tcl_Obj *obj, int *val) {
   return Tcl_GetIntFromObj(ip, obj, val);
 }
   
-int pat_long(Tcl_Interp *ip, Tcl_Obj *obj, long *val) {
+int cht_pat_long(Tcl_Interp *ip, Tcl_Obj *obj, long *val) {
   return Tcl_GetLongFromObj(ip, obj, val);
 }
   
-int pat_string(Tcl_Interp *ip, Tcl_Obj *obj, const char **val) {
+int cht_pat_string(Tcl_Interp *ip, Tcl_Obj *obj, const char **val) {
   *val= Tcl_GetString(obj);
   return TCL_OK;
 }
 
-int pat_constv(Tcl_Interp *ip, Tcl_Obj *var,
+int cht_pat_constv(Tcl_Interp *ip, Tcl_Obj *var,
               Tcl_Obj **val_r, Tcl_ObjType *type) {
   int rc;
   Tcl_Obj *val;
@@ -40,11 +41,11 @@ int pat_constv(Tcl_Interp *ip, Tcl_Obj *var,
   return TCL_OK;
 }
 
-void init_somethingv(Something_Var *sth) {
+void cht_init_somethingv(Something_Var *sth) {
   sth->obj=0; sth->var=0; sth->copied=0;
 }
 
-int pat_somethingv(Tcl_Interp *ip, Tcl_Obj *var,
+int cht_pat_somethingv(Tcl_Interp *ip, Tcl_Obj *var,
                   Something_Var *sth, Tcl_ObjType *type) {
   int rc;
   Tcl_Obj *val;
@@ -67,14 +68,7 @@ int pat_somethingv(Tcl_Interp *ip, Tcl_Obj *var,
   return TCL_OK;
 }
 
-int pat_hbv(Tcl_Interp *ip, Tcl_Obj *var, HBytes_Var *agg) {
-  int rc;
-  rc= pat_somethingv(ip,var,&agg->sth,&hbytes_type);  if (rc) return rc;
-  agg->hb= OBJ_HBYTES(agg->sth.obj);
-  return TCL_OK;
-}
-
-void fini_somethingv(Tcl_Interp *ip, int rc, Something_Var *sth) {
+void cht_fini_somethingv(Tcl_Interp *ip, int rc, Something_Var *sth) {
   Tcl_Obj *ro;
   
   if (!rc) {
@@ -86,26 +80,10 @@ void fini_somethingv(Tcl_Interp *ip, int rc, Something_Var *sth) {
     Tcl_DecrRefCount(sth->obj);
 }
 
-int pat_hb(Tcl_Interp *ip, Tcl_Obj *obj, HBytes_Value *val) {
-  int rc;
-  rc= Tcl_ConvertToType(ip,obj,&hbytes_type);  if (rc) return rc;
-  *val= *OBJ_HBYTES(obj);
-  return TCL_OK;
-}
-
-Tcl_Obj *ret_hb(Tcl_Interp *ip, HBytes_Value val) {
-  Tcl_Obj *obj;
-  obj= Tcl_NewObj();
-  Tcl_InvalidateStringRep(obj);
-  *OBJ_HBYTES(obj)= val;
-  obj->typePtr= &hbytes_type;
-  return obj;
-}
-
-Tcl_Obj *ret_long(Tcl_Interp *ip, long val) {
+Tcl_Obj *cht_ret_long(Tcl_Interp *ip, long val) {
   return Tcl_NewLongObj(val);
 }
 
-Tcl_Obj *ret_string(Tcl_Interp *ip, const char *val) {
+Tcl_Obj *cht_ret_string(Tcl_Interp *ip, const char *val) {
   return Tcl_NewStringObj(val,-1);
 }
diff --git a/base/shlib.make b/base/shlib.make
new file mode 100644 (file)
index 0000000..50eeae0
--- /dev/null
@@ -0,0 +1,8 @@
+
+OBJS_CFILES += $(addsuffix .o, $(CFILES))
+OBJS +=                $(OBJS_CFILES)
+
+TARGETS +=     $(SHLIB).so
+
+$(SHLIB).so:   $(OBJS)
+               $(CC) $(CFLAGS) $(LDFLAGS) -o $@ -shared $(OBJS) $(LDLIBS)
index 7ce5dc7..6630736 100644 (file)
@@ -14,19 +14,6 @@ Fini addrmapv                        fini_somethingv(ip, rc, &@.sth);
 Type sockaddr:                 SockAddr_Value @
 Init sockaddr                  sockaddr_clear(&@);
 
-Type iddata(const IdDataSpec *idds):   void *@
-Type ulong:                    uint32_t @
-Type long:                     long @
-Type string:                   const char *@
-
-Type adnsresults:              adns_answer *@
-Init adnsresults               @=0;
-Fini adnsresults               free(@);
-
-Type charfrom(const char *opts, const char *what):     int
-
-H-Include      "hbytes.h"
-
 Table toplevel TopLevel_Command
        hbytes
                subcmd  enum(HBytes_SubCommand, "hbytes subcommand")
@@ -44,36 +31,6 @@ Table toplevel TopLevel_Command
                subcmd  enum(Adns_SubCommand,"adns subcommand")
                ...     obj
 
-Table adns Adns_SubCommand
-       lookup
-               rrtype  enum(AdnsTclRRTypeInfo, "rrtype")
-               domain  string
-               ...     obj
-               =>      obj
-       synch
-               rrtype  enum(AdnsTclRRTypeInfo, "rrtype")
-               domain  string
-               ...     obj
-               =>      obj
-       asynch
-               on_yes  obj
-               on_no   obj
-               on_fail obj
-               xargs   obj
-               rrtype  enum(AdnsTclRRTypeInfo, "rrtype")
-               domain  string
-               ...     obj
-               =>      iddata(&adnstcl_queries)
-       asynch-cancel
-               query   iddata(&adnstcl_queries)
-       new-resolver
-               ...     obj
-               =>      iddata(&adnstcl_resolvers)
-       set-default-resolver
-               res     iddata(&adnstcl_resolvers)
-       destroy-resolver
-               res     iddata(&adnstcl_resolvers)
-
 Table addrmap AddrMap_SubCommand
        lookup
                map     constv(&addrmap_type)
index 22da4ae..f14249c 100755 (executable)
 #     functions.
 #
 #     `Type' causes declarations in the .h file of these functions:
-#        int pat_TYPENAME(Tcl_Interp*, Tcl_Obj *obj, C-TYPE *val, ARGS);
-#        Tcl_Obj *ret_TYPENAME(Tcl_Interp*, C-TYPE val, ARGS);
+#        int cht_pat_TYPENAME(Tcl_Interp*, Tcl_Obj *obj, C-TYPE *val, ARGS);
+#        Tcl_Obj *cht_ret_TYPENAME(Tcl_Interp*, C-TYPE val, ARGS);
 #
-#     pat_... must attempt to parse obj into the appropriate type.
+#     cht_pat_... must attempt to parse obj into the appropriate type.
 #     val will already have been initialised with `Init' statements if
-#     relevant.  Whether pat_... fails or succeeds it may allocate
+#     relevant.  Whether cht_pat_... fails or succeeds it may allocate
 #     memory into the object and must leave the object valid (for
 #     `Fini').
 #
-#     ret_... must convert the value back to a new Tcl_Obj.  It may
+#     cht_ret_... must convert the value back to a new Tcl_Obj.  It may
 #     not fail.
 #
 #  Init TYPENAME    C-STATEMENTS
 #            ...
 #          [ =>  RESULT-TYPE ]
 #     This will cause the declaration of
-#        int do_TABLENAME_ENTRYNAME(ClientData cd, Tcl_Interp *ip,
+#        int cht_do_TABLENAME_ENTRYNAME(ClientData cd, Tcl_Interp *ip,
 #                                   FORMAL-ARGUMENTS, RESULT-C-TYPE*);
 #     which is the procedure which the application must supply to
 #     implement the function.  If the `=> RESULT-TYPE' is omitted, so
 #     is the result argument to the function.  Each argument to the
 #     function is of the C type corresponding to the specified type.
-#     The do_... function should not eat any memory associated with
+#     The cht_do_... function should not eat any memory associated with
 #     the arguments.  The result buffer (if any) will be initialised
 #     using the `Init' and should on success contain the relevant
 #     result.  On failure it should leave the result unmodified (or at
 #     EXTRA-VALUES; the EXTRA-VALUES are used as initialisers for the
 #     additional structure elements.
 #
-#  Also declared are these functions:
-#    void setstringresult(Tcl_Interp*, const char*);
+#  NoEntryDefine C-ENTRY-TYPE
+#     Prevents the definition of C-ENTRY-TYPE by Table.
+#     The C type must be defined elsewhere.
+#
+#  Also expected are these functions:
+#    void cht_setstringresult(Tcl_Interp*, const char*);
 #        sets the Tcl result from the supplied string
-#    int pat_enum(Tcl_Interp*, Tcl_Obj*, const void **c_e_t_array,
+#    int cht_pat_enum(Tcl_Interp*, Tcl_Obj*, const void **c_e_t_array,
 #                 const void *c_e_t_return, size_t c_e_t_sz, const char *what);
 #        scans a table of C-ENTRY-TYPEs looking for the
 #        string matching the string supplied by the script
 #        are in the same places no matter what the rest of
 #        the struct contains.
 #  and the two predefined types `int' (C `int') and `obj' (Tcl_Obj*,
-#  unmodified.)  The corresponding definitions are in tcmdiflib.c
-#  which #includes "tcmdiflib.h" (not supplied).
+#  unmodified.)  The corresponding definitions are in tcmdiflib.c.
 
 use IO;
 use Data::Dumper;
@@ -123,8 +126,9 @@ parse('builtins','DATA');
 
 while (@ARGV) {
     $_= shift @ARGV;
-    if (m/^\-p(\w+)/) {
+    if (m/^\-p([-_0-9a-z]+)$/) {
        $prefix= $1;
+       $prefix =~ y/-/_/;
     } elsif (m/^\-w(c|h)$/) {
        $write= $1;
     } elsif (m/^\-o(.+)$/) {
@@ -163,11 +167,11 @@ sub parse ($$) {
            unshift @i, $this_indent;
        }
 
-       if (@i==0 && m/^Table\s+(\w+)\s+(\w+)$/) {
+       if (@i==0 && m/^Table\s+(\*toplevel\*|\w+)\s+(\w+)$/) {
            zilch();
            $c_table= $1;
            $table_x{$c_table}{C}= $2;
-           $entrytype_x{$2}= '';
+           $entrytype_x{$2}= '' unless exists $entrytype_x{$2};
        } elsif (@i==0 && m/^Untabled$/) {
            zilch();
            $c_table= '';
@@ -176,6 +180,9 @@ sub parse ($$) {
        } elsif (@i==0 && m/^EntryExtra\s+(\w+)$/) {
            zilch();
            $c_entryextra= $1;
+       } elsif (@i==0 && m/^NoEntryDefine\s+(\w+)$/) {
+           zilch();
+           $entrytype_x{$1}= " ";
        } elsif (@i>=1 && defined $c_entryextra) {
            $entrytype_x{$c_entryextra} .= "  $_\n";
        } elsif (@i==1 && m/^[a-z].*$/ && defined $c_table) {
@@ -225,19 +232,20 @@ foreach $t (sort keys %types) {
     $type= $types{$t};
     $c= $type->{C};
     $xta= $type->{X};
-    $decl= "int pat_$t(Tcl_Interp *ip, Tcl_Obj *obj, ";
+    $decl= "int cht_pat_$t(Tcl_Interp *ip, Tcl_Obj *obj, ";
     $decl .= subst_in_decl('*val', $c, "type $t");
     $decl .= ", $xta",  if length $xta;
     $decl .= ");\n";
     o('h',160, $decl);
 
-    $decl= "Tcl_Obj *ret_$t(Tcl_Interp *ip, ".subst_in_decl('val',$c);
+    $decl= "Tcl_Obj *cht_ret_$t(Tcl_Interp *ip, ".subst_in_decl('val',$c);
     $decl .= ", $xta" if length $xta;
     $decl .= ");\n";
     o('h',170, $decl);
 }
 
 foreach $c_entrytype (sort keys %entrytype_x) {
+    next if $entrytype_x{$c_entrytype} =~ m/^\s$/;
     o('h', 20, "typedef struct $c_entrytype $c_entrytype;\n");
     o('h', 100,
       "struct $c_entrytype {\n".
@@ -257,7 +265,7 @@ foreach $c_table (sort keys %tables) {
        $r_entry= $r_table->{$c_entry};
        $pa_decl= "int pa_${c_table}_${c_entry_c}(ClientData cd,".
            " Tcl_Interp *ip, int objc, Tcl_Obj *const *objv)";
-       $do_decl= "int do_${c_table}_${c_entry_c}(";
+       $do_decl= "int cht_do_${c_table}_${c_entry_c}(";
        @do_al= ('ClientData cd', 'Tcl_Interp *ip');
        @do_aa= qw(cd ip);
        $pa_init= '';
@@ -310,7 +318,7 @@ foreach $c_table (sort keys %tables) {
            if (exists $type_fini{$t}) {
                $pa_fini .= '  '.subst_in("a_$n", $type_fini{$t})."\n";
            }
-           $pa_body .= "  rc= pat_$t(ip, *objv++, $paarg";
+           $pa_body .= "  rc= cht_pat_$t(ip, *objv++, $paarg";
            $pa_body .= ", ".$a if length $a;
            $pa_body .= ");$pafin if (rc) goto rc_err;\n";
            push @do_aa, "a_$n";
@@ -333,16 +341,16 @@ foreach $c_table (sort keys %tables) {
        if (exists $r_entry->{R}) {
            $t= $r_entry->{R};
            $xta= $r_entry->{X};
-           push @do_al, make_decl("*result", $t, "do_al result");
+           push @do_al, make_decl("*result", $t, "cht_do_al result");
            $pa_vars .= make_decl_init("result", $t, $xta, \$pa_init,
                                       "pa_vars result");
            push @do_aa, "&result";
-           $pa_rslt .= "  Tcl_SetObjResult(ip, ret_$t(ip, result";
+           $pa_rslt .= "  Tcl_SetObjResult(ip, cht_ret_$t(ip, result";
            $pa_rslt .= ", $xta" if length $xta;
            $pa_rslt .= "));\n";
        }
        $pa_body .= "\n";
-       $pa_body .= "  rc= do_${c_table}_${c_entry_c}(";
+       $pa_body .= "  rc= cht_do_${c_table}_${c_entry_c}(";
        $pa_body .= join ', ', @do_aa;
        $pa_body .= ");\n";
        $pa_body .= "  if (rc) goto rc_err;\n";
@@ -411,11 +419,6 @@ o(h, 0,
   "#define INCLUDED_\U${prefix}_H\n\n".
   "#include <tcl8.3/tcl.h>\n");
 
-o(h, 400,
-  "void setstringresult(Tcl_Interp*, const char*);\n".
-  "int pat_enum(Tcl_Interp*, Tcl_Obj*, const void**,".
-  "             const void*, size_t, const char *what);\n");
-
 o(h, 999,
   "#endif /*INCLUDED_\U${prefix}_H*/\n");
 
index 8bddc02..25f0084 100644 (file)
@@ -1,29 +1,30 @@
 /*
  */
 
-#include "tcmdiflib.h"
+#include "chiark-tcl.h"
+#include "tables.h"
 
-int pat_enum(Tcl_Interp *ip, Tcl_Obj *obj, const void **val,
+int cht_pat_enum(Tcl_Interp *ip, Tcl_Obj *obj, const void **val,
             const void *opts, size_t sz, const char *what) {
-  *val= enum_lookup_cached_func(ip,obj,opts,sz,what);
+  *val= cht_enum_lookup_cached_func(ip,obj,opts,sz,what);
   if (!*val) return TCL_ERROR;
   return TCL_OK;
 }
   
-int pat_obj(Tcl_Interp *ip, Tcl_Obj *obj, Tcl_Obj **val) {
+int cht_pat_obj(Tcl_Interp *ip, Tcl_Obj *obj, Tcl_Obj **val) {
   *val= obj;
   return TCL_OK;
 }
 
-Tcl_Obj *ret_int(Tcl_Interp *ip, int val) {
+Tcl_Obj *cht_ret_int(Tcl_Interp *ip, int val) {
   return Tcl_NewIntObj(val);
 }
 
-Tcl_Obj *ret_obj(Tcl_Interp *ip, Tcl_Obj *val) {
+Tcl_Obj *cht_ret_obj(Tcl_Interp *ip, Tcl_Obj *val) {
   return val;
 }
 
-void setstringresult(Tcl_Interp *ip, const char *m) {
+void cht_setstringresult(Tcl_Interp *ip, const char *m) {
   Tcl_ResetResult(ip);
   Tcl_AppendResult(ip, m, (char*)0);
 }
diff --git a/base/tcmdiflib.h b/base/tcmdiflib.h
deleted file mode 100644 (file)
index 0944e20..0000000
+++ /dev/null
@@ -1,2 +0,0 @@
-#include "tables.h"
-#include "hbytes.h"
index e458511..ed38b04 100644 (file)
@@ -1,58 +1,3 @@
-OBJS=          tables.o \
-               tcmdiflib.o \
-               hbytes.o \
-               adns.o \
-               enum.o \
-               idtable.o \
-               scriptinv.o \
-               ulongs.o \
-               sockaddr.o \
-               dgram.o \
-               tuntap.o \
-               chop.o \
-               hook.o \
-               bcmode.o \
-               misc.o \
-               algtables.o \
-               crypto.o \
-               parse.o \
-               addrmap.o
-
-HDRS=          hbytes.h \
-               $(AUTO_HDRS)
-
-AUTO_HDRS=     tables.h
-AUTO_SRCS=     tables.c
-AUTOS=         $(AUTO_HDRS) $(AUTO_SRCS)
-
-TARGETS=       hbytes.so autocode.tcl autococo.tcl
-
-CC_CRYPTO=     $(CC) $(CFLAGS) $(CPPFLAGS) -O3
-CPPFLAGS=      -I../plocal/include $(TCL_MEM_DEBUG) $(CMDLINE_CPPFLAGS)
-LDFLAGS=       -L../plocal/lib
-LDLIBS=                -lnettle -ladns
-CFLAGS=                -g -Wall -Wmissing-prototypes -Wstrict-prototypes -Werror \
-               $(OPTIMISE)
-OPTIMISE=      -O2
-TCL_MEM_DEBUG= -DTCL_MEM_DEBUG
-
-all:           $(TARGETS) $(AUTOS)
-
-hbytes.so:     $(OBJS)
-               $(CC) $(CFLAGS) $(LDFLAGS) -o $@ -shared $(OBJS) $(LDLIBS)
-
-autoco%.tcl:   deco%gen.tcl decobogen.tcl general.tcl ./hbytes.so \
-                       protocol.deco
-               ./$< protocol.deco >$@.new && mv -f $@.new $@           
-
-%.c:           %.tct tcmdifgen
-               ./tcmdifgen -wc -o$@ $<
-
-%.h:           %.tct tcmdifgen
-               ./tcmdifgen -wh -o$@ $<
-
-%.o:           %.c $(HDRS)
-               $(CC) $(CFLAGS) $(CPPFLAGS) -o $@ -c $<
 
 #alg.o:                alg.c alg.h alg2.h
 #              $(CC_CRYPTO) -o $@ -c $<
diff --git a/hbytes/hbglue.c b/hbytes/hbglue.c
new file mode 100644 (file)
index 0000000..1ac833d
--- /dev/null
@@ -0,0 +1,23 @@
+int cht_pat_hbv(Tcl_Interp *ip, Tcl_Obj *var, HBytes_Var *agg) {
+  int rc;
+  rc= pat_somethingv(ip,var,&agg->sth,&hbytes_type);  if (rc) return rc;
+  agg->hb= OBJ_HBYTES(agg->sth.obj);
+  return TCL_OK;
+}
+
+int cht_pat_hb(Tcl_Interp *ip, Tcl_Obj *obj, HBytes_Value *val) {
+  int rc;
+  rc= Tcl_ConvertToType(ip,obj,&hbytes_type);  if (rc) return rc;
+  *val= *OBJ_HBYTES(obj);
+  return TCL_OK;
+}
+
+Tcl_Obj *cht_ret_hb(Tcl_Interp *ip, HBytes_Value val) {
+  Tcl_Obj *obj;
+  obj= Tcl_NewObj();
+  Tcl_InvalidateStringRep(obj);
+  *OBJ_HBYTES(obj)= val;
+  obj->typePtr= &hbytes_type;
+  return obj;
+}
+
index 206f97e..55a2286 100644 (file)
@@ -260,7 +260,6 @@ extern const IdDataSpec adnstcl_queries, adnstcl_resolvers;
 /* from dgram.c */
 
 extern const IdDataSpec dgram_socks;
-int newfdposixerr(Tcl_Interp *ip, int fd, const char *m);
 
 /* from tuntap.c */