chiark / gitweb /
working on compiling out of troglodyte; before relegage maskmap
authorian <ian>
Sat, 7 Jan 2006 20:05:38 +0000 (20:05 +0000)
committerian <ian>
Sat, 7 Jan 2006 20:05:38 +0000 (20:05 +0000)
30 files changed:
Makefile
adns/Makefile
adns/chiark_tcl_adns.h
base/.cvsignore
base/Makefile
base/base.tct
base/common.make
base/enum.c
base/extension.make
base/final.make
base/hook.c
base/idtable.c
base/parse.c
base/scriptinv.c
base/tables-examples.tct
base/tcmdifgen
base/tcmdiflib.c
crypto/crypto.c
crypto/crypto.tct
dgram/dgram.tct
hbytes/Makefile
hbytes/chop.c
hbytes/hbytes.c
hbytes/hbytes.h
hbytes/hbytes.tct
hbytes/hook.c
hbytes/parse.c
hbytes/ulongs.c
maskmap/addrmap.c
maskmap/maskmap.c

index 9625b20..1ccf437 100644 (file)
--- a/Makefile
+++ b/Makefile
@@ -1,5 +1,5 @@
 
-SUBDIRS=       base adns
+SUBDIRS=       base adns hbytes crypto dgram tuntap
 
 default: all
 
index 5b9ecec..31e3df9 100644 (file)
@@ -1,5 +1,6 @@
 BASE_DIR =     ../base
-EXTENSION =    chiark_tcl_adns
+EXTBASE =      adns
+TABLE =                adnscmds
 CFILES =       adns
 LDLIBS +=      -ladns
 
index de58251..0881253 100644 (file)
@@ -13,6 +13,6 @@ typedef struct {
 
 const IdDataSpec adnstcl_queries, adnstcl_resolvers;
 
-#include "tables.h"
+#include "adnscmds.h"
 
 #endif /*ADNSTCL_H*/
index 6796ef3..e7a6c22 100644 (file)
@@ -1,2 +1,2 @@
-tables.[ch]
+adns+tcmdif.[ch]
 *.d
index 958939d..ad7479c 100644 (file)
@@ -4,11 +4,11 @@ SHLIB =               chiark-tcl
 CFILES =       enum hook idtable parse scriptinv tcmdiflib
 BASE_DIR =     .
 
-AUTO_HDRS +=   tables.h
+AUTO_HDRS +=   base+tcmdif.h
 
 include common.make
 
-tables.h:      $(BASE_TCT) $(TCMDIFGEN)
+base+tcmdif.h: $(BASE_TCT) $(TCMDIFGEN)
                $(TCMDIFGEN) -wh -o$@ $<
 
 include shlib.make
index 0c4a5e6..425cb99 100644 (file)
@@ -7,5 +7,3 @@ Type constv(Tcl_ObjType*):      Tcl_Obj *@
 Type charfrom(const char *opts, const char *what):     int
 
 NoEntryDefine  TopLevel_Command
-
-H-Include      "chiark-tcl.h"
index c24170e..2ebd133 100644 (file)
@@ -5,6 +5,7 @@ TCMDIFGEN ?=    $(BASE_DIR)/tcmdifgen
 BASE_TCT ?=    $(BASE_DIR)/base.tct
 
 CFLAGS +=      -g -Wall -Wmissing-prototypes -Wstrict-prototypes -Werror \
+               -Wno-pointer-sign \
                $(OPTIMISE)
 CPPFLAGS +=    -I$(BASE_DIR)
 CPPFLAGS +=    $(TCL_MEM_DEBUG)
index 4f2a8b7..e40b513 100644 (file)
@@ -2,10 +2,7 @@
  *
  */
 
-#include <string.h>
-
-#include "chiark-tcl.h"
-#include "tables.h"
+#include "chiark-tcl-base.h"
 
 static void enum_nt_dup(Tcl_Obj *src, Tcl_Obj *dup) {
   dup->internalRep= src->internalRep;
index 775a409..d9ae479 100644 (file)
@@ -1,9 +1,11 @@
 
+EXTENSION ?=   chiark_tcl_$(EXTBASE)
 SHLIB ?=       $(EXTENSION)
+TABLE ?=       $(EXTBASE)
 
-AUTO_HDRS +=   tables.h
-AUTO_SRCS +=   tables.c
-CFILES +=      tables
+AUTO_HDRS +=   $(TABLE)+tcmdif.h
+AUTO_SRCS +=   $(TABLE)+tcmdif.c
+CFILES +=      $(TABLE)+tcmdif
 
 LDLIBS +=      $(BASE_DIR)/chiark-tcl.so
 
@@ -12,10 +14,10 @@ include             $(BASE_DIR)/shlib.make
 
 TCMDIFARGS ?=  -p$(EXTENSION) -o$@ $(BASE_TCT) $<
 
-%.c:           %.tct $(BASE_TCT) $(TCMDIFGEN)
+%+tcmdif.c:    %.tct $(BASE_TCT) $(TCMDIFGEN)
                $(TCMDIFGEN) -wc $(TCMDIFARGS)
 
-%.h:           %.tct $(BASE_TCT) $(TCMDIFGEN)
+%+tcmdif.h:    %.tct $(BASE_TCT) $(TCMDIFGEN)
                $(TCMDIFGEN) -wh $(TCMDIFARGS)
 
 include                $(BASE_DIR)/final.make
index 4df82bf..1100e8b 100644 (file)
@@ -6,7 +6,7 @@ $(OBJS_CFILES): $(AUTO_HDRS)
                $(CC) $(CFLAGS) $(CPPFLAGS) -MMD -o $@ -c $<
 
 clean:
-               rm -f $(AUTOS) *~ ./#*#
+               rm -f $(AUTOS) *~ ./#*# *.d *+tcmdif.*
                rm -f *.o *.so $(CLEANS)
 
 -include $(patsubst %.o,%.d, $(OBJS))
index 571bf07..9243724 100644 (file)
@@ -1,9 +1,7 @@
 /*
  */
 
-#include <errno.h>
-
-#include "chiark-tcl.h"
+#include "chiark-tcl-base.h"
 
 int cht_staticerr(Tcl_Interp *ip, const char *m, const char *ec) {
   Tcl_SetResult(ip, (char*)m, TCL_STATIC);
index 2d73e3d..554f999 100644 (file)
@@ -1,8 +1,7 @@
 /*
  */
 
-#include "chiark-tcl.h"
-#include "tables.h"
+#include "chiark-tcl-base.h"
 
 /* Arg parsing */
 
index 341c389..035e531 100644 (file)
@@ -1,8 +1,7 @@
 /*
  */
 
-#include "chiark-tcl.h"
-#include "tables.h"
+#include "chiark-tcl-base.h"
 
 int cht_pat_charfrom(Tcl_Interp *ip, Tcl_Obj *obj, int *val,
                 const char *opts, const char *what) {
index 29651b2..3bc383d 100644 (file)
@@ -1,7 +1,7 @@
 /*
  */
 
-#include "chiark-tcl.h"
+#include "chiark-tcl-base.h"
 
 void cht_scriptinv_init(ScriptToInvoke *si) {
   si->obj= 0;
index 6630736..e69de29 100644 (file)
@@ -1,253 +0,0 @@
-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 constv(Tcl_ObjType*):     Tcl_Obj *@
-
-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 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
-
-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;
index 95329dd..d5e6622 100755 (executable)
@@ -426,8 +426,7 @@ o(c, 0, "#include \"$prefix.h\"\n");
 
 o(h, 0,
   "#ifndef INCLUDED_\U${prefix}_H\n".
-  "#define INCLUDED_\U${prefix}_H\n\n".
-  "#include <tcl8.3/tcl.h>\n");
+  "#define INCLUDED_\U${prefix}_H\n\n");
 
 o(h, 999,
   "#endif /*INCLUDED_\U${prefix}_H*/\n");
index 25f0084..984c75f 100644 (file)
@@ -1,8 +1,7 @@
 /*
  */
 
-#include "chiark-tcl.h"
-#include "tables.h"
+#include "chiark-tcl-base.h"
 
 int cht_pat_enum(Tcl_Interp *ip, Tcl_Obj *obj, const void **val,
             const void *opts, size_t sz, const char *what) {
index 97f4d1d..cf50712 100644 (file)
@@ -6,10 +6,6 @@
 #include "hbytes.h"
 #include "tables.h"
 
-void memxor(Byte *dest, const Byte *src, int l) {
-  while (l--) *dest++ ^= *src++;
-}
-
 const PadOp padops[]= {
   { "un", 0, 0 },
   { "ua", 0, 1 },
index c65db1a..fa9de22 100644 (file)
@@ -1,4 +1,10 @@
 Table hbcrypto_SubCommand
+       pad
+               op      enum(PadOp, "hbytes pad subcommand")
+               v       hbv
+               blocksz obj
+               meth    enum(PadMethodInfo, "pad method")
+               ...     methargs
        blockcipher
                op      enum(BlockCipherOp, "op")
                ...     obj
index 63337b4..3c56b76 100644 (file)
@@ -1,17 +1,24 @@
-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
+Type sockaddr:                 SockAddr_Value @
+Init sockaddr                  sockaddr_clear(&@);
 
+Table toplevel TopLevel_Command
+       dgram-socket
+               subcmd  enum(DgramSocket_SubCommand,"dgram-socket subcommand")
+               ...     obj
+       tuntap-socket-raw
+           subcmd enum(TunSocket_SubCommand,"tuntap-socket-raw subcommand")
+           ... obj
+
+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
index fe1a535..a1955b7 100644 (file)
@@ -1,6 +1,6 @@
 BASE_DIR =     ../base
-EXTENSION =    chiark_tcl_hbytees
-CFILES =       hbytes
+EXTBASE =      hbytes
+CFILES =       addrmap chop hbytes hook parse ulongs
 
 include ../base/extension.make
 
index cccd43f..ef0e5f0 100644 (file)
@@ -1,19 +1,16 @@
 /*
  */
 
-#include <string.h>
-
-#include "hbytes.h"
-#include "tables.h"
+#include "chiark_tcl_hbytes.h"
 
 static int strs1(Tcl_Interp *ip, int strc, Tcl_Obj *const *strv, int *l_r) {
   int rc, l, i;
 
   l= 0;
   for (i=1; i<strc; i++) {
-    rc= Tcl_ConvertToType(ip,strv[i],&hbytes_type);
+    rc= Tcl_ConvertToType(ip,strv[i],&cht_hbytes_type);
     if (rc) return rc;
-    l += hbytes_len(OBJ_HBYTES(strv[i]));
+    l += cht_hb_len(OBJ_HBYTES(strv[i]));
   }
   *l_r= l;
   return TCL_OK;
@@ -23,67 +20,67 @@ static void strs2(Byte *dest, int strc, Tcl_Obj *const *strv) {
   int tl, i;
   
   for (i=1; i<strc; i++) {
-    tl= hbytes_len(OBJ_HBYTES(strv[i]));
-    memcpy(dest, hbytes_data(OBJ_HBYTES(strv[i])), tl);
+    tl= cht_hb_len(OBJ_HBYTES(strv[i]));
+    memcpy(dest, cht_hb_data(OBJ_HBYTES(strv[i])), tl);
     dest += tl;
   }
 }
 
-int do_hbytes_prepend(ClientData cd, Tcl_Interp *ip,
+int cht_do_hbytes_prepend(ClientData cd, Tcl_Interp *ip,
                      HBytes_Var v, int strc, Tcl_Obj *const *strv) {
   int rc, el;
   Byte *dest;
   
   rc= strs1(ip,strc,strv,&el);  if (rc) return rc;
-  dest= hbytes_prepend(v.hb, el);
+  dest= cht_hb_prepend(v.hb, el);
   strs2(dest, strc,strv);
   return TCL_OK;
 }
   
-int do_hbytes_append(ClientData cd, Tcl_Interp *ip,
+int cht_do_hbytes_append(ClientData cd, Tcl_Interp *ip,
                     HBytes_Var v, int strc, Tcl_Obj *const *strv) {
   int rc, el;
   Byte *dest;
 
   rc= strs1(ip,strc,strv,&el);  if (rc) return rc;
-  dest= hbytes_append(v.hb, el);
+  dest= cht_hb_append(v.hb, el);
   strs2(dest,  strc,strv);
   return TCL_OK;
 }
 
-int do_hbytes_concat(ClientData cd, Tcl_Interp *ip,
+int cht_do_hbytes_concat(ClientData cd, Tcl_Interp *ip,
                     int strc, Tcl_Obj *const *strv, HBytes_Value *result) {
   int rc, l;
   Byte *dest;
   
   rc= strs1(ip,strc,strv,&l);  if (rc) return rc;
-  dest= hbytes_arrayspace(result,l);
+  dest= cht_hb_arrayspace(result,l);
   strs2(dest, strc,strv);
   return TCL_OK;
 }
 
 static int underrun(Tcl_Interp *ip) {
-  return staticerr(ip,"data underrun","HBYTES LENGTH UNDERRUN");
+  return cht_staticerr(ip,"data underrun","HBYTES LENGTH UNDERRUN");
 }
 
-int do_hbytes_unprepend(ClientData cd, Tcl_Interp *ip,
+int cht_do_hbytes_unprepend(ClientData cd, Tcl_Interp *ip,
                        HBytes_Var v, int preflength, HBytes_Value *result) {
-  const Byte *rdata= hbytes_unprepend(v.hb, preflength);
+  const Byte *rdata= cht_hb_unprepend(v.hb, preflength);
   if (!rdata) return underrun(ip);
-  hbytes_array(result, rdata, preflength);
+  cht_hb_array(result, rdata, preflength);
   return TCL_OK;
 }
 
-int do_hbytes_unappend(ClientData cd, Tcl_Interp *ip,
+int cht_do_hbytes_unappend(ClientData cd, Tcl_Interp *ip,
                       HBytes_Var v, int suflength, HBytes_Value *result) {
-  const Byte *rdata= hbytes_unappend(v.hb, suflength);
+  const Byte *rdata= cht_hb_unappend(v.hb, suflength);
   if (!rdata) return underrun(ip);
-  hbytes_array(result, rdata, suflength);
+  cht_hb_array(result, rdata, suflength);
   return TCL_OK;
 }
 
-int do_hbytes_chopto(ClientData cd, Tcl_Interp *ip,
+int cht_do_hbytes_chopto(ClientData cd, Tcl_Interp *ip,
                     HBytes_Var v, int newlength, HBytes_Value *result) {
-  int suflength= hbytes_len(v.hb) - newlength;
-  return do_hbytes_unappend(0,ip,v, suflength, result);
+  int suflength= cht_hb_len(v.hb) - newlength;
+  return cht_do_hbytes_unappend(0,ip,v, suflength, result);
 }
index b941937..22383df 100644 (file)
@@ -2,57 +2,54 @@
  *
  */
 
-#include <string.h>
-
 #include "hbytes.h"
-#include "tables.h"
 
 #define COMPLEX(hb) ((HBytes_ComplexValue*)hb->begin_complex)
 #define SIMPLE_LEN(hb) ((Byte*)(hb)->end_0 - (Byte*)(hb)->begin_complex)
 
 /* enquirers */
 
-int hbytes_len(const HBytes_Value *hb) {
+int cht_hb_len(const HBytes_Value *hb) {
   if (HBYTES_ISEMPTY(hb)) return 0;
   else if (HBYTES_ISCOMPLEX(hb)) return COMPLEX(hb)->len;
   else return SIMPLE_LEN(hb);
 }
 
-Byte *hbytes_data(const HBytes_Value *hb) {
+Byte *cht_hb_data(const HBytes_Value *hb) {
   if (HBYTES_ISEMPTY(hb)) return 0;
   else if (HBYTES_ISCOMPLEX(hb)) return COMPLEX(hb)->dstart;
   else return hb->begin_complex;
 }
 
-int hbytes_issentinel(const HBytes_Value *hb) {
+int cht_hb_issentinel(const HBytes_Value *hb) {
   return HBYTES_ISSENTINEL(hb);
 }
 
 /* constructors */
 
-void hbytes_empty(HBytes_Value *returns) {
+void cht_hb_empty(HBytes_Value *returns) {
   returns->begin_complex= returns->end_0= 0;
 }
 
-void hbytes_sentinel(HBytes_Value *returns) {
+void cht_hb_sentinel(HBytes_Value *returns) {
   returns->begin_complex= 0;
-  returns->end_0= (void*)&hbytes_type;
+  returns->end_0= (void*)&cht_hbytes_type;
 }
 
-Byte *hbytes_arrayspace(HBytes_Value *returns, int l) {
-  if (!l) { hbytes_empty(returns); return 0; }
+Byte *cht_hb_arrayspace(HBytes_Value *returns, int l) {
+  if (!l) { cht_hb_empty(returns); return 0; }
   returns->begin_complex= TALLOC(l);
   returns->end_0= returns->begin_complex + l;
   return returns->begin_complex;
 }
   
-void hbytes_array(HBytes_Value *returns, const Byte *array, int l) {
-  memcpy(hbytes_arrayspace(returns,l), array, l);
+void cht_hb_array(HBytes_Value *returns, const Byte *array, int l) {
+  memcpy(cht_hb_arrayspace(returns,l), array, l);
 }
 
 /* destructor */
 
-void hbytes_free(const HBytes_Value *frees) {
+void cht_hb_free(const HBytes_Value *frees) {
   if (HBYTES_ISCOMPLEX(frees)) {
     HBytes_ComplexValue *cx= COMPLEX(frees);
     TFREE(cx->dstart - cx->prespace);
@@ -78,7 +75,7 @@ static HBytes_ComplexValue *complex(HBytes_Value *hb) {
   return cx;
 }
 
-Byte *hbytes_prepend(HBytes_Value *hb, int el) {
+Byte *cht_hb_prepend(HBytes_Value *hb, int el) {
   HBytes_ComplexValue *cx;
   int new_prespace;
   Byte *old_block, *new_block, *new_dstart;
@@ -101,7 +98,7 @@ Byte *hbytes_prepend(HBytes_Value *hb, int el) {
   return cx->dstart;
 }
 
-Byte *hbytes_append(HBytes_Value *hb, int el) {
+Byte *cht_hb_append(HBytes_Value *hb, int el) {
   HBytes_ComplexValue *cx;
   int new_len, new_avail;
   Byte *newpart, *new_block, *old_block;
@@ -126,14 +123,14 @@ prechop(HBytes_Value *hb, int cl, const Byte **rv) {
   HBytes_ComplexValue *cx;
 
   if (cl<0) { *rv=0; return 0; }
-  if (cl==0) { *rv= (const void*)&hbytes_type; return 0; }
+  if (cl==0) { *rv= (const void*)&cht_hbytes_type; return 0; }
   
   cx= complex(hb);
   if (cl > cx->len) { *rv=0; return 0; }
   return cx;
 }
 
-const Byte *hbytes_unprepend(HBytes_Value *hb, int pl) {
+const Byte *cht_hb_unprepend(HBytes_Value *hb, int pl) {
   const Byte *chopped;
   HBytes_ComplexValue *cx= prechop(hb,pl,&chopped);
   if (!cx) return chopped;
@@ -146,7 +143,7 @@ const Byte *hbytes_unprepend(HBytes_Value *hb, int pl) {
   return chopped;
 }
 
-const Byte *hbytes_unappend(HBytes_Value *hb, int sl) {
+const Byte *cht_hb_unappend(HBytes_Value *hb, int sl) {
   const Byte *chopped;
   HBytes_ComplexValue *cx= prechop(hb,sl,&chopped);
   if (!cx) return chopped;
@@ -154,3 +151,7 @@ const Byte *hbytes_unappend(HBytes_Value *hb, int sl) {
   cx->len -= sl;
   return cx->dstart + cx->len;
 }
+
+void memxor(Byte *dest, const Byte *src, int l) {
+  while (l--) *dest++ ^= *src++;
+}
index 55a2286..4a2f394 100644 (file)
 #include <sys/uio.h>
 #include <sys/un.h>
 #include <arpa/inet.h>
+#include <string.h>
 
-#include <tcl8.3/tcl.h>
-
-#include <adns.h>
-
-typedef unsigned char Byte;
+#include "chiark-tcl.h"
 
 /* from hbytes.c */
 
@@ -167,133 +164,49 @@ typedef struct {
    */
 } HBytes_ComplexValue; /* pointed to from internalRep.otherValuePtr */
 
+void memxor(Byte *dest, const Byte *src, int l);
+
 /* Public interfaces: */
 
-extern Tcl_ObjType hbytes_type;
+extern Tcl_ObjType cht_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);
+int cht_hb_len(const HBytes_Value *v);
+Byte *cht_hb_data(const HBytes_Value *v); /* caller may then modify data! */
+int cht_hb_issentinel(const HBytes_Value *v);
 
-Byte *hbytes_prepend(HBytes_Value *upd, int el);
-Byte *hbytes_append(HBytes_Value *upd, int el);
+Byte *cht_hb_prepend(HBytes_Value *upd, int el);
+Byte *cht_hb_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);
+const Byte *cht_hb_unprepend(HBytes_Value *upd, int rl);
+const Byte *cht_hb_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);
+void cht_hb_empty(HBytes_Value *returns);
+void cht_hb_sentinel(HBytes_Value *returns);
+void cht_hb_array(HBytes_Value *returns, const Byte *array, int l);
+Byte *cht_hb_arrayspace(HBytes_Value *returns, int l);
+void cht_hb_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;
-
-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*);
-
-/* from scriptinv.c */
-
-typedef struct { /* semi-opaque - read only, and then only where commented */
-  Tcl_Interp *ip; /* valid, non-0 and useable if set */
-  Tcl_Obj *obj; /* non-0 iff set (but only test for 0/non-0) */
-  Tcl_Obj *xargs;
-  int llength;
-} ScriptToInvoke;
-
-void scriptinv_init(ScriptToInvoke *si);
-int scriptinv_set(ScriptToInvoke *si, Tcl_Interp *ip,
-                 Tcl_Obj *newscript, Tcl_Obj *xargs);
-void 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);
-
-/* from idtable.c */
-
-typedef struct {
-  const char *valprefix, *assockey;
-  void (*destroyitem)(Tcl_Interp *ip, void *val);
-} IdDataSpec;
-
-/* The stored struct must start with a single int, conventionally
- * named `ix'.  When the struct is returned for the first time ix must
- * 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);
-  /* 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;
-
-/* from tuntap.c */
-
-extern const IdDataSpec tuntap_socks;
+/* The value made by cht_hb_sentinel should not be passed to
+ * anything except HBYTES_IS..., and cht_hb_free. */
 
 /* 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);
-
 void obj_updatestr_array(Tcl_Obj *o, const Byte *array, int l);
 void obj_updatestr_array_prefix(Tcl_Obj *o, const Byte *byte,
                                int l, const char *prefix);
 
-void 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);
-
 /* from parse.c */
 
 typedef struct {
-  Tcl_Obj *obj, *var;
-  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,
-                  Something_Var *sth, Tcl_ObjType *type);
-
-typedef struct {
   HBytes_Value *hb;
   Something_Var sth;
 } HBytes_Var;
@@ -307,126 +220,18 @@ typedef struct {
   Something_Var sth;
 } AddrMap_Var;
 
-extern Tcl_ObjType addrmap_type;
+extern Tcl_ObjType cht_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;
-
-const void *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),                         \
-                            &(table)[0],sizeof((table)[0]),    \
-                            (what)))
-  /* table should be a pointer to an array of structs of size
-   * entrysize, the first member of which should be a const char*.
-   * The table should finish with a null const char *.
-   * On error, 0 is returned and the ip->result will have been
-   * set to the error message.
-   */
-
-int 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);
+Tcl_ObjType cht_ulong_type;
 
 /* 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*/
index 727591d..abfd45a 100644 (file)
@@ -1,32 +1,20 @@
 Type hb:                       HBytes_Value @
-Init hb                                hbytes_sentinel(&@);
+Init hb                                cht_hb_sentinel(&@);
 
 Type hbv:                      HBytes_Var @
-Init hbv                       @.hb=0; init_somethingv(&@.sth);
-Fini hbv                       fini_somethingv(ip, rc, &@.sth);
+Init hbv                       @.hb=0; cht_init_somethingv(&@.sth);
+Fini hbv                       cht_fini_somethingv(ip, rc, &@.sth);
 
 Type addrmapv:                 AddrMap_Var @
-Init addrmapv                  @.am=0; init_somethingv(&@.sth);
-Fini addrmapv                  fini_somethingv(ip, rc, &@.sth);
+Init addrmapv                  @.am=0; cht_init_somethingv(&@.sth);
+Fini addrmapv                  cht_fini_somethingv(ip, rc, &@.sth);
 
-Type sockaddr:                 SockAddr_Value @
-Init sockaddr                  sockaddr_clear(&@);
-
-Table toplevel TopLevel_Command
+Table hbytestoplevel TopLevel_Command
        hbytes
-               subcmd  enum(HBytes_SubCommand, "hbytes subcommand")
-               ...     obj
-       dgram-socket
-               subcmd  enum(DgramSocket_SubCommand,"dgram-socket subcommand")
+               subcmd  enum(HBytes/_SubCommand, "hbytes 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")
+               subcmd  enum(ULong/_SubCommand, "ulong subcommand")
                ...     obj
 
 Table ulong ULong_SubCommand
@@ -138,97 +126,24 @@ Table hbytes HBytes_SubCommand
        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
+#      addr-map
+#              subcmd  enum(AddrMap/_SubCommand, "hbytes addr-map subcommand")
+#              ...     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
+#Table addrmap AddrMap_SubCommand
+#      lookup
+#              map     constv(&cht_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
 
-EntryExtra BlockCipherOp
-       int encrypt;
index 3f28bbb..4c742f3 100644 (file)
@@ -1,52 +1,20 @@
 /*
-/* WARNING - FILE COPIED IN REPO TO CHIARK-TCL THEN
-   EDITED - THIS VERSION IS OBSOLETE */
  */
 
 #include <errno.h>
 
-#include "hbytes.h"
-#include "tables.h"
+#include "chiark_tcl_hbytes.h"
 
-int 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) {
-  const char *em;
-  
-  Tcl_ResetResult(ip);
-  errno= errnoval;
-  em= Tcl_PosixError(ip);
-  Tcl_AppendResult(ip, m, ": ", em, (char*)0);
-  return TCL_ERROR;
-}
-
-int newfdposixerr(Tcl_Interp *ip, int fd, const char *m) {
-  int e;
-  e= errno;
-  close(fd);
-  return posixerr(ip,e,m);
-}
-
-void 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,
+int cht_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) {
+  if (obj->typePtr == &cht_hbytes_type) {
     HBytes_Value *v= OBJ_HBYTES(obj);
     memset(nums,0,sizeof(nums));
-    nums[1]= hbytes_len(v);
+    nums[1]= cht_hb_len(v);
   
     if (HBYTES_ISEMPTY(v)) tn= "empty";
     else if (HBYTES_ISSENTINEL(v)) tn= "sentinel!";
@@ -71,14 +39,14 @@ int do_hbytes_rep_info(ClientData cd, Tcl_Interp *ip,
 }
 
 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;
+  cht_hb_array(OBJ_HBYTES(dup),
+              cht_hb_data(OBJ_HBYTES(src)),
+              cht_hb_len(OBJ_HBYTES(src)));
+  dup->typePtr= &cht_hbytes_type;
 }
 
 static void hbytes_t_free(Tcl_Obj *o) {
-  hbytes_free(OBJ_HBYTES(o));
+  cht_hb_free(OBJ_HBYTES(o));
 }
 
 void obj_updatestr_array_prefix(Tcl_Obj *o, const Byte *byte,
@@ -104,38 +72,10 @@ 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, ...) {
-  va_list al;
-  char *p;
-  const char *part;
-  int l, pl;
-
-  va_start(al,o);
-  for (l=0; (part= va_arg(al, const char*)); )
-    l+= va_arg(al, int);
-  va_end(al);
-  
-  o->length= l;
-  o->bytes= TALLOC(l+1);
-
-  va_start(al,o);
-  for (p= o->bytes; (part= va_arg(al, const char*)); p += pl) {
-    pl= va_arg(al, int);
-    memcpy(p, part, pl);
-  }
-  va_end(al);
-
-  *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)));
+                     cht_hb_data(OBJ_HBYTES(o)),
+                     cht_hb_len(OBJ_HBYTES(o)));
 }
 
 static int hbytes_t_sfa(Tcl_Interp *ip, Tcl_Obj *o) {
@@ -144,21 +84,21 @@ static int hbytes_t_sfa(Tcl_Interp *ip, Tcl_Obj *o) {
   int l;
   char cbuf[3];
 
-  if (o->typePtr == &ulong_type) {
+  if (o->typePtr == &cht_ulong_type) {
     uint32_t ul;
 
     ul= htonl(*(const uint32_t*)&o->internalRep.longValue);
-    hbytes_array(OBJ_HBYTES(o), (const Byte*)&ul, 4);
+    cht_hb_array(OBJ_HBYTES(o), (const Byte*)&ul, 4);
 
   } else {
   
     os= str= Tcl_GetStringFromObj(o,&l);  assert(str);
-    objfreeir(o);
+    cht_objfreeir(o);
 
-    if (l & 1) return staticerr(ip, "hbytes: conversion from hex:"
+    if (l & 1) return cht_staticerr(ip, "hbytes: conversion from hex:"
                                " odd length in hex", "HBYTES SYNTAX");
 
-    startbytes= bytes= hbytes_arrayspace(OBJ_HBYTES(o), l/2);
+    startbytes= bytes= cht_hb_arrayspace(OBJ_HBYTES(o), l/2);
 
     cbuf[2]= 0;
     while (l>0) {
@@ -166,8 +106,8 @@ static int hbytes_t_sfa(Tcl_Interp *ip, Tcl_Obj *o) {
       cbuf[1]= *str++;
       *bytes++= strtoul(cbuf,&ep,16);
       if (ep != cbuf+2) {
-       hbytes_free(OBJ_HBYTES(o));
-       return staticerr(ip, "hbytes: conversion from hex:"
+       cht_hb_free(OBJ_HBYTES(o));
+       return cht_staticerr(ip, "hbytes: conversion from hex:"
                         " bad hex digit", "HBYTES SYNTAX");
       }
       l -= 2;
@@ -175,88 +115,88 @@ static int hbytes_t_sfa(Tcl_Interp *ip, Tcl_Obj *o) {
 
   }
 
-  o->typePtr = &hbytes_type;
+  o->typePtr = &cht_hbytes_type;
   return TCL_OK;
 }
 
-Tcl_ObjType hbytes_type = {
+Tcl_ObjType cht_hbytes_type = {
   "hbytes",
   hbytes_t_free, hbytes_t_dup, hbytes_t_ustr, hbytes_t_sfa
 };
 
-int do_hbytes_raw2h(ClientData cd, Tcl_Interp *ip,
+int cht_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);
+  cht_hb_array(result, str, l);
   return TCL_OK;
 }
 
-int do_hbytes_h2raw(ClientData cd, Tcl_Interp *ip,
+int cht_do_hbytes_h2raw(ClientData cd, Tcl_Interp *ip,
                    HBytes_Value hex, Tcl_Obj **result) {
-  *result= Tcl_NewByteArrayObj(hbytes_data(&hex), hbytes_len(&hex));
+  *result= Tcl_NewByteArrayObj(cht_hb_data(&hex), cht_hb_len(&hex));
   return TCL_OK;
 }
 
-int do_hbytes_length(ClientData cd, Tcl_Interp *ip,
+int cht_do_hbytes_length(ClientData cd, Tcl_Interp *ip,
                     HBytes_Value v, int *result) {
-  *result= hbytes_len(&v);
+  *result= cht_hb_len(&v);
   return TCL_OK;
 }
 
-int do_hbytes_random(ClientData cd, Tcl_Interp *ip,
+int cht_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; }
+  space= cht_hb_arrayspace(result, length);
+  rc= cht_get_urandom(ip, space, length);
+  if (rc) { cht_hb_free(result); return rc; }
   return TCL_OK;
 }  
   
-int do_hbytes_overwrite(ClientData cd, Tcl_Interp *ip,
+int cht_do_hbytes_overwrite(ClientData cd, Tcl_Interp *ip,
                        HBytes_Var v, int start, HBytes_Value sub) {
   int sub_l;
 
-  sub_l= hbytes_len(&sub);
+  sub_l= cht_hb_len(&sub);
   if (start < 0)
-    return staticerr(ip, "hbytes overwrite start -ve",
+    return cht_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",
+  if (start + sub_l > cht_hb_len(v.hb))
+    return cht_staticerr(ip, "hbytes overwrite out of range",
                     "HBYTES LENGTH UNDERRUN");
-  memcpy(hbytes_data(v.hb) + start, hbytes_data(&sub), sub_l);
+  memcpy(cht_hb_data(v.hb) + start, cht_hb_data(&sub), sub_l);
   return TCL_OK;
 }
 
-int do_hbytes_trimleft(ClientData cd, Tcl_Interp *ip, HBytes_Var v) {
+int cht_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);
+  o= p= cht_hb_data(v.hb);
+  e= p + cht_hb_len(v.hb);
 
   while (p<e && !*p) p++;
   if (p != o)
-    hbytes_unprepend(v.hb, p-o);
+    cht_hb_unprepend(v.hb, p-o);
 
   return TCL_OK;
 }
 
-int do_hbytes_repeat(ClientData cd, Tcl_Interp *ip,
+int cht_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",
+  sub_l= cht_hb_len(&sub);
+  if (count < 0) return cht_staticerr(ip, "hbytes repeat count -ve",
                                  "HBYTES LENGTH RANGE");
-  if (count > INT_MAX/sub_l) return staticerr(ip, "hbytes repeat too long", 0);
+  if (count > INT_MAX/sub_l) return cht_staticerr(ip, "hbytes repeat too long", 0);
 
-  data= hbytes_arrayspace(result, sub_l*count);
-  sub_d= hbytes_data(&sub);
+  data= cht_hb_arrayspace(result, sub_l*count);
+  sub_d= cht_hb_data(&sub);
   while (count) {
     memcpy(data, sub_d, sub_l);
     count--; data += sub_l;
@@ -264,39 +204,39 @@ int do_hbytes_repeat(ClientData cd, Tcl_Interp *ip,
   return TCL_OK;
 }  
 
-int do_hbytes_xor(ClientData cd, Tcl_Interp *ip,
+int cht_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");
+  l= cht_hb_len(v.hb);
+  if (cht_hb_len(&d) != l) return
+    cht_staticerr(ip, "hbytes xor lengths do not match", "HBYTES LENGTH MISMATCH");
 
-  dest= hbytes_data(v.hb);
-  source= hbytes_data(&d);
+  dest= cht_hb_data(v.hb);
+  source= cht_hb_data(&d);
   memxor(dest,source,l);
   return TCL_OK;
 }
   
-int do_hbytes_zeroes(ClientData cd, Tcl_Interp *ip,
+int cht_do_hbytes_zeroes(ClientData cd, Tcl_Interp *ip,
                     int length, HBytes_Value *result) {
   Byte *space;
-  space= hbytes_arrayspace(result, length);
+  space= cht_hb_arrayspace(result, length);
   memset(space,0,length);
   return TCL_OK;
 }
 
-int do_hbytes_compare(ClientData cd, Tcl_Interp *ip,
+int cht_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);
+  al= cht_hb_len(&a);
+  bl= cht_hb_len(&b);
   minl= al<bl ? al : bl;
 
-  r= memcmp(hbytes_data(&a), hbytes_data(&b), minl);
+  r= memcmp(cht_hb_data(&a), cht_hb_data(&b), minl);
   
   if (r<0) *result= -2;
   else if (r>0) *result= +2;
@@ -308,25 +248,25 @@ int do_hbytes_compare(ClientData cd, Tcl_Interp *ip,
   return TCL_OK;
 }
 
-int do_hbytes_range(ClientData cd, Tcl_Interp *ip,
+int cht_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);
+  l= cht_hb_len(&v);
   if (start<0 || size<0)
-    return staticerr(ip,"hbytes range subscript(s) -ve","HBYTES LENGTH RANGE");
+    return cht_staticerr(ip,"hbytes range subscript(s) -ve","HBYTES LENGTH RANGE");
   if (l<start+size)
-    return staticerr(ip, "hbytes range subscripts too big",
+    return cht_staticerr(ip, "hbytes range subscripts too big",
                     "HBYTES LENGTH UNDERRUN");
 
-  data= hbytes_data(&v);
-  hbytes_array(result, data+start, size);
+  data= cht_hb_data(&v);
+  cht_hb_array(result, data+start, size);
   return TCL_OK;
 }
 
-int do_hbytes_addr_map(ClientData cd, Tcl_Interp *ip,
+int cht_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);
@@ -334,107 +274,55 @@ int do_hbytes_addr_map(ClientData cd, Tcl_Interp *ip,
 
 /* hbytes representing uint16_t's */
 
-int do_hbytes_h2ushort(ClientData cd, Tcl_Interp *ip,
+int cht_do_hbytes_h2ushort(ClientData cd, Tcl_Interp *ip,
                       HBytes_Value hex, long *result) {
   const Byte *data;
   int l;
 
-  l= hbytes_len(&hex);
+  l= cht_hb_len(&hex);
   if (l>2)
-    return staticerr(ip, "hbytes h2ushort input more than 4 hex digits",
+    return cht_staticerr(ip, "hbytes h2ushort input more than 4 hex digits",
                     "HBYTES VALUE OVERFLOW");
 
-  data= hbytes_data(&hex);
+  data= cht_hb_data(&hex);
   *result= data[l-1] | (l>1 ? data[0]<<8 : 0);
   return TCL_OK;
 }
 
-int do_hbytes_ushort2h(ClientData cd, Tcl_Interp *ip,
+int cht_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",
+    return cht_staticerr(ip, "hbytes ushort2h input >2^16",
                     "HBYTES VALUE OVERFLOW");
 
   us= htons(input);
-  hbytes_array(result,(const Byte*)&us,2);
+  cht_hb_array(result,(const Byte*)&us,2);
   return TCL_OK;
 }
 
 /* toplevel functions */
 
-int do_toplevel_hbytes(ClientData cd, Tcl_Interp *ip,
+int cht_do_hbytestoplevel_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,
+int cht_do_hbytestoplevel_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);
-}
-
-#define URANDOM "/dev/urandom"
-
-int 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);
-  }
-  r= fread(buffer,1,l,urandom);
-  if (r==l) return 0;
-
-  esave= errno;
-  fclose(urandom); urandom=0;
-
-  if (ferror(urandom)) {
-    return posixerr(ip,errno,"read " URANDOM);
-  } else {
-    assert(feof(urandom));
-    return staticerr(ip, URANDOM " gave eof!", 0);
-  }
-}
-
-int Hbytes_Init(Tcl_Interp *ip) {
-  const TopLevel_Command *cmd;
-
-  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);
-
-  for (cmd=toplevel_commands;
-       cmd->name;
-       cmd++)
-    Tcl_CreateObjCommand(ip, (char*)cmd->name, cmd->func, 0,0);
-
-  return TCL_OK;
+extern int Chiark_tcl_hbytes_Init(Tcl_Interp *ip); /*called by load(3tcl)*/
+int Chiark_tcl_hbytes_Init(Tcl_Interp *ip) {
+  static int initd;
+  
+  return cht_initextension(ip, cht_hbytestoplevel_entries, &initd,
+                          &cht_hbytes_type,
+                          &cht_ulong_type,
+                          &cht_addrmap_type,
+                          (Tcl_ObjType*)0);
 }
index 389f580..a363514 100644 (file)
 /*
  */
-/* WARNING - FILE COPIED IN REPO TO CHIARK-TCL - THIS VERSION IS OBSOLETE */
 
-#include "tables.h"
+#include "chiark_tcl_hbytes.h"
 
-int 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);
-  if (*val==-1) return TCL_ERROR;
-  return TCL_OK;
-}
-
-int 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) {
-  return Tcl_GetLongFromObj(ip, obj, val);
-}
-  
-int 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,
-              Tcl_Obj **val_r, Tcl_ObjType *type) {
-  int rc;
-  Tcl_Obj *val;
-  
-  val= Tcl_ObjGetVar2(ip,var,0,TCL_LEAVE_ERR_MSG);
-  if (!val) return TCL_ERROR;
-
-  if (type) {
-    rc= Tcl_ConvertToType(ip,val,type);
-    if (rc) return rc;
-  }
-
-  *val_r= val;
-  return TCL_OK;
-}
-
-void init_somethingv(Something_Var *sth) {
-  sth->obj=0; sth->var=0; sth->copied=0;
-}
-
-int pat_somethingv(Tcl_Interp *ip, Tcl_Obj *var,
-                  Something_Var *sth, Tcl_ObjType *type) {
+int cht_pat_hb(Tcl_Interp *ip, Tcl_Obj *obj, HBytes_Value *val) {
   int rc;
-  Tcl_Obj *val;
-
-  sth->var= var;
-
-  val= Tcl_ObjGetVar2(ip,var,0,TCL_LEAVE_ERR_MSG);
-  if (!val) return TCL_ERROR;
-
-  rc= Tcl_ConvertToType(ip,val,type);
-  if (rc) return rc;
-
-  if (Tcl_IsShared(val)) {
-    val= Tcl_DuplicateObj(val);
-    sth->copied= 1;
-  }
-  Tcl_InvalidateStringRep(val);
-  sth->obj= val;
-
-  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) {
-  Tcl_Obj *ro;
-  
-  if (!rc) {
-    assert(sth->obj);
-    ro= Tcl_ObjSetVar2(ip,sth->var,0,sth->obj,TCL_LEAVE_ERR_MSG);
-    if (!ro) rc= TCL_ERROR;
-  }
-  if (rc && sth->copied)
-    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;
+  rc= Tcl_ConvertToType(ip,obj,&cht_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 *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;
+  obj->typePtr= &cht_hbytes_type;
   return obj;
 }
-
-Tcl_Obj *ret_long(Tcl_Interp *ip, long val) {
-  return Tcl_NewLongObj(val);
-}
-
-Tcl_Obj *ret_string(Tcl_Interp *ip, const char *val) {
-  return Tcl_NewStringObj(val,-1);
-}
index 4652fd6..0f99db3 100644 (file)
@@ -1,38 +1,37 @@
 /*
  */
 
-#include "hbytes.h"
-#include "tables.h"
+#include "chiark_tcl_hbytes.h"
 
 /* nice simple functions */
 
-int do_ulong_int2ul(ClientData cd, Tcl_Interp *ip, int v,
+int cht_do_ulong_int2ul(ClientData cd, Tcl_Interp *ip, int v,
                    uint32_t *result) {
-  if (v<0) return
-    staticerr(ip,"cannot convert -ve integer to ulong","ULONG VALUE NEGATIVE");
+  if (v<0) return cht_staticerr(ip,"cannot convert"
+      " -ve integer to ulong","ULONG VALUE NEGATIVE");
   *result= v;
   return TCL_OK;
 }
   
-int do_ulong_add(ClientData cd, Tcl_Interp *ip,
+int cht_do_ulong_add(ClientData cd, Tcl_Interp *ip,
                 uint32_t a, uint32_t b, uint32_t *result) {
   *result= a + b;
   return TCL_OK;
 }
   
-int do_ulong_multiply(ClientData cd, Tcl_Interp *ip,
+int cht_do_ulong_multiply(ClientData cd, Tcl_Interp *ip,
                      uint32_t a, uint32_t b, uint32_t *result) {
   *result= a * b;
   return TCL_OK;
 }
   
-int do_ulong_subtract(ClientData cd, Tcl_Interp *ip,
+int cht_do_ulong_subtract(ClientData cd, Tcl_Interp *ip,
                      uint32_t a, uint32_t b, uint32_t *result) {
   *result= a - b;
   return TCL_OK;
 }
   
-int do_ulong_compare(ClientData cd, Tcl_Interp *ip,
+int cht_do_ulong_compare(ClientData cd, Tcl_Interp *ip,
                     uint32_t a, uint32_t b, int *result) {
   *result=
     a == b ? 0 :
@@ -40,25 +39,26 @@ int do_ulong_compare(ClientData cd, Tcl_Interp *ip,
   return TCL_OK;
 }
 
-int do_ulong_ul2int(ClientData cd, Tcl_Interp *ip,
+int cht_do_ulong_ul2int(ClientData cd, Tcl_Interp *ip,
                    uint32_t v, int *result) {
   if (v>INT_MAX) return
-    staticerr(ip,"ulong too large to fit in an int", "ULONG VALUE OVERFLOW");
+                  cht_staticerr(ip,"ulong too large"
+                                " to fit in an int", "ULONG VALUE OVERFLOW");
   *result= v;
   return TCL_OK;
 }
 
-int do_ulong_mask(ClientData cd, Tcl_Interp *ip,
+int cht_do_ulong_mask(ClientData cd, Tcl_Interp *ip,
                  uint32_t a, uint32_t b, uint32_t *result) {
   *result= a & b;
   return TCL_OK;
 }
   
-int do_ulong_shift(ClientData cd, Tcl_Interp *ip, int right,
+int cht_do_ulong_shift(ClientData cd, Tcl_Interp *ip, int right,
                   uint32_t v, int bits, uint32_t *result) {
   if (bits < 0) { bits= -bits; right= !right; }
-  if (bits > 32) return
-    staticerr(ip,"shift out of range (32) bits", "ULONG BITCOUNT OVERRUN");
+  if (bits > 32) return cht_staticerr(ip,"shift out of range (32) bits",
+                                     "ULONG BITCOUNT OVERRUN");
   *result= (bits==32 ? 0 :
            right ? v >> bits : v << bits);
   return TCL_OK;
@@ -95,7 +95,7 @@ static int bf_fixed_read(Tcl_Interp *ip, uint32_t *value_io,
   uint32_t ul;
   int rc;
   
-  rc= pat_ulong(ip, arg, &ul);  if (rc) return rc;
+  rc= cht_pat_ulong(ip, arg, &ul);  if (rc) return rc;
   if (*value_io != ul) *ok_io= 0;
   return TCL_OK;
 }
@@ -105,7 +105,7 @@ static int bf_ulong_write(Tcl_Interp *ip, uint32_t *value_io,
   uint32_t ul;
   int rc;
   
-  rc= pat_ulong(ip, arg, &ul);  if (rc) return rc;
+  rc= cht_pat_ulong(ip, arg, &ul);  if (rc) return rc;
   *value_io= ul;
   return TCL_OK;
 }
@@ -119,24 +119,25 @@ static int bf_var_read(Tcl_Interp *ip, Tcl_Obj *varname, Tcl_Obj *val) {
 
 static int bf_ulong_read(Tcl_Interp *ip, uint32_t *value_io,
                         int *ok_io, Tcl_Obj *arg) {
-  return bf_var_read(ip,arg, ret_ulong(ip,*value_io));
+  return bf_var_read(ip,arg, cht_ret_ulong(ip,*value_io));
 }
 
 static int bf_uint_write(Tcl_Interp *ip, uint32_t *value_io,
                         int *ok_io, Tcl_Obj *arg) {
   int rc, v;
-  rc= pat_int(ip, arg, &v);  if (rc) return rc;
-  if (v<0) return
-    staticerr(ip,"value for bitfield is -ve", "ULONG VALUE NEGATIVE");
+  rc= cht_pat_int(ip, arg, &v);  if (rc) return rc;
+  if (v<0) return cht_staticerr(ip,"value for bitfield is -ve",
+                               "ULONG VALUE NEGATIVE");
   *value_io= v;
   return TCL_OK;
 }
 
 static int bf_uint_read(Tcl_Interp *ip, uint32_t *value_io,
                        int *ok_io, Tcl_Obj *arg) {
-  if (*value_io > INT_MAX) return
-    staticerr(ip,"value from bitfield exceeds INT_MAX","ULONG VALUE OVERFLOW");
-  return bf_var_read(ip,arg, ret_int(ip,*value_io));
+  if (*value_io > INT_MAX)
+    return cht_staticerr(ip,"value from bitfield"
+                        " exceeds INT_MAX","ULONG VALUE OVERFLOW");
+  return bf_var_read(ip,arg, cht_ret_int(ip,*value_io));
 }
 
 #define BFT(t,a) { #t, a, { bf_read_##t, bf_write_##t } }
@@ -163,12 +164,15 @@ static int do_bitfields(Tcl_Interp *ip, int writing, int *ok_r,
 
   while (--objc) {
     rc= Tcl_GetIntFromObj(ip,*++objv,&sz);  if (rc) return rc;
-    if (!--objc) return staticerr(ip,"wrong # args: missing bitfield type",0);
+    if (!--objc)
+      return cht_staticerr(ip,"wrong # args: missing bitfield type",0);
 
     if (sz<0)
-      return staticerr(ip,"bitfield size is -ve", "ULONG BITCOUNT NEGATIVE");
-    if (sz>pos) return
-      staticerr(ip,"total size of bitfields >32", "ULONG BITCOUNT OVERRUN");
+      return cht_staticerr(ip,"bitfield size is -ve",
+                          "ULONG BITCOUNT NEGATIVE");
+    if (sz>pos)
+      return cht_staticerr(ip,"total size of bitfields >32",
+                          "ULONG BITCOUNT OVERRUN");
 
     pos -= sz;
 
@@ -181,7 +185,7 @@ static int do_bitfields(Tcl_Interp *ip, int writing, int *ok_r,
 
     if (ftype->want_arg) {
       if (!--objc)
-       return staticerr(ip,"wrong # args: missing arg for bitfield",0);
+       return cht_staticerr(ip,"wrong # args: missing arg for bitfield",0);
       arg= *++objv;
     } else {
       arg= 0;
@@ -192,7 +196,7 @@ static int do_bitfields(Tcl_Interp *ip, int writing, int *ok_r,
     if (!*ok_r) return TCL_OK;
 
     if (this_field & ~sz_mask)
-      return staticerr(ip,"bitfield value has more bits than bitfield",
+      return cht_staticerr(ip,"bitfield value has more bits than bitfield",
                       "ULONG VALUE OVERFLOW");
     
     value &= ~this_mask;
@@ -200,13 +204,13 @@ static int do_bitfields(Tcl_Interp *ip, int writing, int *ok_r,
   }
 
   if (pos != 0) return
-    staticerr(ip,"bitfield sizes add up to <32","ULONG BITCOUNT UNDERRUN");
+    cht_staticerr(ip,"bitfield sizes add up to <32","ULONG BITCOUNT UNDERRUN");
 
   *value_io= value;
   return TCL_OK;
 }
 
-int do_ulong_bitfields2ul(ClientData cd, Tcl_Interp *ip,
+int cht_do_ulong_bitfields2ul(ClientData cd, Tcl_Interp *ip,
                          uint32_t base,
                          int objc, Tcl_Obj *const *objv,
                          uint32_t *result) {
@@ -218,7 +222,7 @@ int do_ulong_bitfields2ul(ClientData cd, Tcl_Interp *ip,
   return rc;
 }
 
-int do_ulong_ul2bitfields(ClientData cd, Tcl_Interp *ip,
+int cht_do_ulong_ul2bitfields(ClientData cd, Tcl_Interp *ip,
                          uint32_t value,
                          int objc, Tcl_Obj *const *objv,
                          int *result) {
@@ -227,22 +231,22 @@ int do_ulong_ul2bitfields(ClientData cd, Tcl_Interp *ip,
 
 /* Arg parsing */
 
-int pat_ulong(Tcl_Interp *ip, Tcl_Obj *o, uint32_t *val) {
+int cht_pat_ulong(Tcl_Interp *ip, Tcl_Obj *o, uint32_t *val) {
   int rc;
   
-  rc= Tcl_ConvertToType(ip,o,&ulong_type);
+  rc= Tcl_ConvertToType(ip,o,&cht_ulong_type);
   if (rc) return rc;
   *val= *(const uint32_t*)&o->internalRep.longValue;
   return TCL_OK;
 }
 
-Tcl_Obj *ret_ulong(Tcl_Interp *ip, uint32_t val) {
+Tcl_Obj *cht_ret_ulong(Tcl_Interp *ip, uint32_t val) {
   Tcl_Obj *o;
 
   o= Tcl_NewObj();
   Tcl_InvalidateStringRep(o);
   *(uint32_t*)&o->internalRep.longValue= val;
-  o->typePtr= &ulong_type;
+  o->typePtr= &cht_ulong_type;
   return o;
 }
 
@@ -252,7 +256,7 @@ static void ulong_t_free(Tcl_Obj *o) { }
 
 static void ulong_t_dup(Tcl_Obj *src, Tcl_Obj *dup) {
   dup->internalRep= src->internalRep;
-  dup->typePtr= &ulong_type;
+  dup->typePtr= &cht_ulong_type;
 }
 
 static void ulong_t_ustr(Tcl_Obj *o) {
@@ -264,21 +268,21 @@ static void ulong_t_ustr(Tcl_Obj *o) {
   assert(val <= 0xffffffffUL);
   snprintf(buf,sizeof(buf), "%08lx", (unsigned long)val);
 
-  obj_updatestr_vstringls(o, buf, sizeof(buf)-1, (char*)0);
+  cht_obj_updatestr_vstringls(o, buf, sizeof(buf)-1, (char*)0);
 }
 
 static int ulong_t_sfa(Tcl_Interp *ip, Tcl_Obj *o) {
   char *str, *ep;
   uint32_t ul;
 
-  if (o->typePtr == &hbytes_type) {
+  if (o->typePtr == &cht_hbytes_type) {
     int l;
 
-    l= hbytes_len(OBJ_HBYTES(o));
-    if (l > 4) return
-      staticerr(ip,"hbytes as ulong with length >4","HBYTES LENGTH OVERRUN");
+    l= cht_hb_len(OBJ_HBYTES(o));
+    if (l > 4) return cht_staticerr(ip,"hbytes as ulong with length >4",
+                                   "HBYTES LENGTH OVERRUN");
     ul= 0;
-    memcpy((Byte*)&ul + 4 - l, hbytes_data(OBJ_HBYTES(o)), l);
+    memcpy((Byte*)&ul + 4 - l, cht_hb_data(OBJ_HBYTES(o)), l);
     ul= htonl(ul);
 
   } else {
@@ -292,17 +296,17 @@ static int ulong_t_sfa(Tcl_Interp *ip, Tcl_Obj *o) {
     } else {
       ul= strtoul(str,&ep,16);
     }
-    if (*ep || errno) return staticerr(ip, "bad unsigned long value", 0);
+    if (*ep || errno) return cht_staticerr(ip, "bad unsigned long value", 0);
 
   }
 
-  objfreeir(o);
+  cht_objfreeir(o);
   *(uint32_t*)&o->internalRep.longValue= ul;
-  o->typePtr= &ulong_type;
+  o->typePtr= &cht_ulong_type;
   return TCL_OK;
 }
 
-Tcl_ObjType ulong_type = {
+Tcl_ObjType cht_ulong_type = {
   "ulong-nearly",
   ulong_t_free, ulong_t_dup, ulong_t_ustr, ulong_t_sfa
 };
index 2eb4898..33eeda4 100644 (file)
@@ -1,24 +1,7 @@
 /*
  */
 
-#include <string.h>
-
-#include "tables.h"
-#include "hbytes.h"
-
-typedef struct {
-  Byte *start; /* byl bytes */
-  Tcl_Obj *data; /* may be 0 to mean empty */
-} AddrMap_Entry;
-
-struct AddrMap_Value {
-  int byl, used, space;
-  AddrMap_Entry *entries;
-  /* Entries are sorted by start.  Each entry gives value (or lack of
-   * it) for all A st START <= A < NEXT-START.  Last entry has value
-   * (or lack of it) for all A >= START.  First entry is always
-   * present and always has start all-bits-0. */
-}; /* internalRep.otherValuePtr */
+#include "chiark_tcl_hbytes.h"
 
 /*---------- operations on AddrMap_Entry ----------*/
 
@@ -29,16 +12,16 @@ static void ame_free(AddrMap_Entry *ame) {
 
 static const Byte *ame_parsecheck_addr(Tcl_Interp *ip, const AddrMap_Value *am,
                                       const HBytes_Value *hb) {
-  int hbl= hbytes_len(hb);
+  int hbl= cht_hb_len(hb);
   if (hbl < am->byl) {
-    staticerr(ip,"addr-map address too short","HBYTES ADDRMAP UNDERRUN");
+    cht_staticerr(ip,"addr-map address too short","HBYTES ADDRMAP UNDERRUN");
     return 0;
   }
   if (hbl > am->byl) {
-    staticerr(ip,"addr-map address too long","HBYTES ADDRMAP OVERRUN");
+    cht_staticerr(ip,"addr-map address too long","HBYTES ADDRMAP OVERRUN");
     return 0;
   }
-  return hbytes_data(hb);
+  return cht_hb_data(hb);
 }
   
 static int ame_parsecheck_range(Tcl_Interp *ip, const AddrMap_Value *am,
@@ -48,7 +31,7 @@ static int ame_parsecheck_range(Tcl_Interp *ip, const AddrMap_Value *am,
   p_r[0]= ame_parsecheck_addr(ip,am,starthb);  if (!p_r[0]) return TCL_ERROR;
   p_r[1]= ame_parsecheck_addr(ip,am,endhb);    if (!p_r[0]) return TCL_ERROR;
   if (memcmp(p_r[0],p_r[1],am->byl) > 0)
-    return staticerr(ip, "addr-map range start is after end",
+    return cht_staticerr(ip, "addr-map range start is after end",
                     "HBYTES ADDRMAP BADRANGE");
   return TCL_OK;
 }
@@ -114,9 +97,10 @@ static void am_free(AddrMap_Value *am) {
 
 /*---------- Tcl type and arg parsing functions ----------*/
 
-int pat_addrmapv(Tcl_Interp *ip, Tcl_Obj *var, AddrMap_Var *agg) {
+int cht_pat_addrmapv(Tcl_Interp *ip, Tcl_Obj *var, AddrMap_Var *agg) {
   int rc;
-  rc= pat_somethingv(ip,var,&agg->sth,&addrmap_type);  if (rc) return rc;
+  rc= cht_pat_somethingv(ip,var,&agg->sth,&cht_addrmap_type);
+  if (rc) return rc;
   agg->am= agg->sth.obj->internalRep.otherValuePtr;
   return TCL_OK;
 }
@@ -132,8 +116,8 @@ static void addrmap_t_dup(Tcl_Obj *sob, Tcl_Obj *dob) {
   AddrMap_Entry *sme, *dme;
   int i;
 
-  assert(sob->typePtr == &addrmap_type);
-  objfreeir(dob);
+  assert(sob->typePtr == &cht_addrmap_type);
+  cht_objfreeir(dob);
   dm= TALLOC(sizeof(*dm));
 
   am_init0(dm,sm->byl);
@@ -148,7 +132,7 @@ static void addrmap_t_dup(Tcl_Obj *sob, Tcl_Obj *dob) {
     Tcl_IncrRefCount(dme->data);
   }
   dob->internalRep.otherValuePtr= dm;
-  dob->typePtr= &addrmap_type;
+  dob->typePtr= &cht_addrmap_type;
 }
 
 static void addrmap_t_ustr(Tcl_Obj *so) {
@@ -157,7 +141,7 @@ static void addrmap_t_ustr(Tcl_Obj *so) {
   AddrMap_Entry *sme;
   int entnum, listlength;
 
-  assert(so->typePtr == &addrmap_type);
+  assert(so->typePtr == &cht_addrmap_type);
   mainlobjsl= TALLOC(sizeof(*mainlobjsl) * (sm->used+1));  assert(mainlobjsl);
   mainlobjsl[0]= Tcl_NewIntObj(sm->byl * 8);
   listlength= 1;
@@ -168,19 +152,19 @@ static void addrmap_t_ustr(Tcl_Obj *so) {
 
     if (!sme->data) continue;
 
-    hbytes_array(&hb, sme->start, sm->byl);
-    subl[0]= ret_hb(0, hb);  assert(subl[0]);
+    cht_hb_array(&hb, sme->start, sm->byl);
+    subl[0]= cht_ret_hb(0, hb);  assert(subl[0]);
 
     if (entnum+1 < sm->used) {
-      ame_ba_addsubtractone(hbytes_arrayspace(&hb, sm->byl),
+      ame_ba_addsubtractone(cht_hb_arrayspace(&hb, sm->byl),
                            (sme+1)->start, sm->byl,
                            /*subtract:*/ 0x0ffu, 0x0ffu);
     } else {
-      memset(hbytes_arrayspace(&hb, sm->byl),
+      memset(cht_hb_arrayspace(&hb, sm->byl),
             0x0ffu, sm->byl);
     }
 
-    subl[1]= ret_hb(0, hb);  assert(subl[1]);
+    subl[1]= cht_ret_hb(0, hb);  assert(subl[1]);
     subl[2]= sme->data;
     
     sublo= Tcl_NewListObj(3,subl);  assert(sublo);
@@ -221,7 +205,7 @@ static int addrmap_t_sfa(Tcl_Interp *ip, Tcl_Obj *o) {
   rc= Tcl_ListObjLength(ip,o,&inlen);  if (rc) goto x_badvalue_rc;
 
   if (inlen<0) {
-    rc= staticerr(ip, "addr-map overall length < 1", 0);
+    rc= cht_staticerr(ip, "addr-map overall length < 1", 0);
     goto x_badvalue_rc;
   }
 
@@ -229,7 +213,7 @@ static int addrmap_t_sfa(Tcl_Interp *ip, Tcl_Obj *o) {
   rc= Tcl_GetIntFromObj(ip,eo,&bitlen);  if (rc) goto x_badvalue_rc;
 
   if (bitlen<0 || bitlen % 8) {
-    rc= staticerr(ip, "addr-map overall length < 1", 0);
+    rc= cht_staticerr(ip, "addr-map overall length < 1", 0);
     goto x_badvalue_rc;
   }
 
@@ -244,21 +228,21 @@ static int addrmap_t_sfa(Tcl_Interp *ip, Tcl_Obj *o) {
     rc= Tcl_ListObjLength(ip,eo,&eol);  if (rc) goto x_badvalue_rc;
 
     if (eol != 3) {
-      rc= staticerr(ip, "addr-map entry length != 3", 0);
+      rc= cht_staticerr(ip, "addr-map entry length != 3", 0);
       goto x_badvalue_rc;
     }
     rc= Tcl_ListObjIndex(ip,eo,0,&starto);  if (rc) goto x_badvalue_rc;
     rc= Tcl_ListObjIndex(ip,eo,1,&endo);    if (rc) goto x_badvalue_rc;
 
-    rc= pat_hb(ip,starto,&starthb);  if (rc) goto x_badvalue_rc;
-    rc= pat_hb(ip,endo,&endhb);  if (rc) goto x_badvalue_rc;
+    rc= cht_pat_hb(ip,starto,&starthb);  if (rc) goto x_badvalue_rc;
+    rc= cht_pat_hb(ip,endo,&endhb);  if (rc) goto x_badvalue_rc;
 
     rc= ame_parsecheck_range(ip,am,&starthb,&endhb,rangeptrs);
     if (rc) goto x_badvalue_rc;
 
     cmp= memcmp(ame->start, rangeptrs[0], am->byl);
     if (cmp < 0) {
-      rc= staticerr(ip, "addr-map entries out of order", 0);
+      rc= cht_staticerr(ip, "addr-map entries out of order", 0);
       goto x_badvalue_rc;
     }
     if (cmp > 0) {
@@ -276,7 +260,7 @@ static int addrmap_t_sfa(Tcl_Interp *ip, Tcl_Obj *o) {
     if (rc) {
       /* we've overflowed.  it must have been ffffffff.... */
       if (innum != inlen-1) {
-       rc= staticerr(ip, "addr-map non-last entry end is all-bits-1", 0);
+       rc= cht_staticerr(ip, "addr-map non-last entry end is all-bits-1", 0);
        goto x_badvalue_rc;
       }
       TFREE(ame->start);
@@ -286,9 +270,9 @@ static int addrmap_t_sfa(Tcl_Interp *ip, Tcl_Obj *o) {
   }
     
   /* we commit now */
-  objfreeir(o);
+  cht_objfreeir(o);
   o->internalRep.otherValuePtr= am;
-  o->typePtr= &addrmap_type;
+  o->typePtr= &cht_addrmap_type;
   return TCL_OK;
 
  x_badvalue_rc:
@@ -299,7 +283,7 @@ static int addrmap_t_sfa(Tcl_Interp *ip, Tcl_Obj *o) {
   return rc;
 }
 
-Tcl_ObjType addrmap_type = {
+Tcl_ObjType cht_addrmap_type = {
   "addr-map",
   addrmap_t_free, addrmap_t_dup, addrmap_t_ustr, addrmap_t_sfa
 };
index ee9ce4c..ea2a690 100644 (file)
@@ -1,4 +1,7 @@
+/*
+ */
 
+#include "chiark_tcl_hbytes.h"
 
 /*---------- operations on AddrMap_Entry ----------*/