chiark / gitweb /
Can parse a key file. Cleared up raw confusion.
authorian <ian>
Sun, 8 Sep 2002 22:46:55 +0000 (22:46 +0000)
committerian <ian>
Sun, 8 Sep 2002 22:46:55 +0000 (22:46 +0000)
base/chiark-tcl.h
base/hook.c
base/tables-examples.tct
base/tcmdifgen
dgram/dgram.c
dgram/sockaddr.c
hbytes/hbytes.h
hbytes/hook.c
hbytes/ulongs.c

index f542fe0..864019e 100644 (file)
  *
  *  hbytes range VALUE START SIZE                => substring (or error)
  *
+ *  hbytes h2ulong HEX                           => ulong  (HEX len must be 4)
+ *  hbytes ulong2h UL                            => hex
+ *
+ *  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)
+ *
+ *  ulong ul2int ULONG    => INT            can fail if >INT_MAX
+ *  ulong int2ul INT      => ULONG          can fail if <0
+ *
+ *  hbytes shift l|r ULONG BITS             fails if BITS >32
+ *  hbytes mask A B                         => A & B
+ *
  *  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)
@@ -122,7 +142,7 @@ void sockaddr_free(const SockAddr_Value*);
 
 /* from dgram.c */
 
-extern Tcl_ObjType sockid_type;
+extern Tcl_ObjType dgramsockid_type;
 typedef struct DgramSocket *DgramSockID;
 
 /* from hook.c */
@@ -136,6 +156,11 @@ 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 {
@@ -146,6 +171,11 @@ typedef struct {
 void fini_hbv(Tcl_Interp *ip, int rc, HBytes_Var *agg);
 
 /* from chop.c */
+  /* only do_... functions declared in tables.h */
+
+/* from ulong.c */
+
+Tcl_ObjType ulong_type;
 
 /* from enum.c */
 
index 0efc5f1..7f889fb 100644 (file)
@@ -94,6 +94,34 @@ 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)),
@@ -138,17 +166,17 @@ Tcl_ObjType hbytes_type = {
 
 int do_hbytes_raw2h(ClientData cd, Tcl_Interp *ip,
                    Tcl_Obj *binary, HBytes_Value *result) {
-  const char *str;
+  const unsigned char *str;
   int l;
 
-  str= Tcl_GetStringFromObj(binary,&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_NewStringObj(hbytes_data(&hex), hbytes_len(&hex));
+  *result= Tcl_NewByteArrayObj(hbytes_data(&hex), hbytes_len(&hex));
   return TCL_OK;
 }
 
@@ -212,15 +240,21 @@ int do_hbytes_range(ClientData cd, Tcl_Interp *ip,
   return TCL_OK;
 }
   
-int do__hbytes(ClientData cd, Tcl_Interp *ip,
-              const HBytes_SubCommand *subcmd,
-              int objc, Tcl_Obj *const *objv) {
+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__dgram_socket(ClientData cd, Tcl_Interp *ip,
-                    const DgramSocket_SubCommand *subcmd,
-                    int objc, Tcl_Obj *const *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);
 }
 
@@ -250,13 +284,20 @@ int get_urandom(Tcl_Interp *ip, Byte *buffer, int l) {
 }
 
 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(&sockid_type);
-  Tcl_CreateObjCommand(ip, "hbytes",       pa__hbytes,       0,0);
-  Tcl_CreateObjCommand(ip, "dgram-socket", pa__dgram_socket, 0,0);
+  Tcl_RegisterObjType(&dgramsockid_type);
+  Tcl_RegisterObjType(&ulong_type);
+
+  for (cmd=toplevel_commands;
+       cmd->name;
+       cmd++)
+    Tcl_CreateObjCommand(ip, cmd->name, cmd->func, 0,0);
+
   return TCL_OK;
 }
index b5a104b..f0f2235 100644 (file)
@@ -13,13 +13,45 @@ Type ulong:                 unsigned long @
 
 H-Include      "hbytes.h"
 
-Untabled
+Table toplevel TopLevel_Command
        hbytes
                subcmd  enum(HBytes_SubCommand, "hbytes subcommand")
-               obj     ...
+               ...     obj
        dgram-socket
-               subcmd enum(DgramSocket_SubCommand,"dgram-socket subcommand")
-               obj     ...
+               subcmd  enum(DgramSocket_SubCommand,"dgram-socket subcommand")
+               ...     obj
+       ulong
+               subcmd  enum(ULong_SubCommand,"ulong subcommand")
+               ...     obj
+
+Table ulong ULong_SubCommand
+       shift
+               right   charfrom("lr", "shift direction")
+               v       ulong
+               bits    int
+               =>      ulong
+       mask
+               a       ulong
+               b       ulong
+               =>      ulong
+       compare
+               a       ulong
+               b       ulong
+               =>      int
+       ul2int
+               v       ulong
+               =>      int
+       int2ul
+               v       int
+               =>      ulong
+       ul2bitfields
+               value   ulong
+               ...     obj
+               =>      int
+       bitfields2ul
+               base    ulong
+               ...     obj
+               =>      ulong
 
 Table hbytes HBytes_SubCommand
        raw2h
@@ -54,15 +86,15 @@ Table hbytes HBytes_SubCommand
                =>      hb
        prepend
                v       hbv
-               str     ...
+               ...     str
        append
                v       hbv
-               str     ...
+               ...     str
        rep-info
                v       obj
                =>      obj
        concat
-               str     ...
+               ...     str
                =>      hb
        unprepend
                v       hbv
index 90f0818..dce3153 100755 (executable)
@@ -72,7 +72,7 @@ sub parse ($$) {
                badsyntax($wh,$.,"bad entry");
            }
            $tables{$c_table}{$c_entry}{A} = [ ];
-       } elsif (@i==2 && m/^(\w+)\s+\.\.\.$/ && defined $c_entry) {
+       } elsif (@i==2 && m/^\.\.\.\s+(\w+)$/ && defined $c_entry) {
            $tables{$c_table}{$c_entry}{V}= $1;
        } elsif (@i==2 && m/^(\??)([a-z]\w*)\s*(\S.*)/
                 && defined $c_entry) {
index a2a2f97..bb538bf 100644 (file)
@@ -198,7 +198,7 @@ int pat_sockid(Tcl_Interp *ip, Tcl_Obj *o, DgramSocket **val) {
   int rc, sockix;
   DgramSocket *sock;
   
-  rc= Tcl_ConvertToType(ip,o,&sockid_type);
+  rc= Tcl_ConvertToType(ip,o,&dgramsockid_type);
   if (rc) return rc;
 
   sockix= o->internalRep.longValue;
@@ -217,7 +217,7 @@ Tcl_Obj *ret_sockid(Tcl_Interp *ip, DgramSocket *val) {
   o= Tcl_NewObj();
   Tcl_InvalidateStringRep(o);
   o->internalRep.longValue= val->ix;
-  o->typePtr= &sockid_type;
+  o->typePtr= &dgramsockid_type;
   return o;
 }
 
@@ -228,13 +228,13 @@ static void sockid_t_dup(Tcl_Obj *src, Tcl_Obj *dup) {
 }
 
 static void sockid_t_ustr(Tcl_Obj *o) {
-  char buf[100];
-  int l;
+  char buf[75];
 
-  snprintf(buf,sizeof(buf),"dgramsock%d", (int)o->internalRep.longValue);
-  l= o->length= strlen(buf);
-  o->bytes= TALLOC(l+1);
-  strcpy(o->bytes, buf);
+  snprintf(buf,sizeof(buf), "%d", (int)o->internalRep.longValue);
+  obj_updatestr_vstringls(o,
+                         "dgramsock",9,
+                         buf, strlen(buf),
+                         (char*)0);
 }
 
 static int sockid_t_sfa(Tcl_Interp *ip, Tcl_Obj *o) {
@@ -246,11 +246,14 @@ static int sockid_t_sfa(Tcl_Interp *ip, Tcl_Obj *o) {
   errno=0; ul=strtoul(str+9,&ep,10);
   if (errno || *ep) return staticerr(ip,"bad dgram socket id number");
   if (ul > INT_MAX) return staticerr(ip,"out of range dgram socket id");
+
+  objfreeir(o);
   o->internalRep.longValue= ul;
+  o->typePtr= &dgramsockid_type;
   return TCL_OK;
 }
 
-Tcl_ObjType sockid_type = {
-  "sockid-nearly",
+Tcl_ObjType dgramsockid_type = {
+  "dgramsockid",
   sockid_t_free, sockid_t_dup, sockid_t_ustr, sockid_t_sfa
 };
index 4df9aa0..2a388d0 100644 (file)
@@ -76,7 +76,7 @@ static void sockaddr_t_ustr(Tcl_Obj *o) {
   const struct sockaddr *sa;
   char i46buf[INET6_ADDRSTRLEN], portbuf[50];
   const struct sockaddr_in *sin;
-  int al, sl, pl;
+  int al;
   const char *string, *prepend;
   
   sa= sockaddr_addr(OBJ_SOCKADDR(o));
@@ -106,12 +106,10 @@ static void sockaddr_t_ustr(Tcl_Obj *o) {
     return;
   }
 
-  pl= strlen(prepend);
-  sl= strlen(string);
-  o->length= pl+sl;
-  o->bytes= TALLOC(pl+sl+1);
-  memcpy(o->bytes, prepend, pl);
-  memcpy(o->bytes+pl, string, sl+1);
+  obj_updatestr_vstringls(o,
+                         prepend, strlen(prepend),
+                         string, strlen(string),
+                         (char*)0);
 }
 
 static int sockaddr_t_sfa(Tcl_Interp *ip, Tcl_Obj *o) {
index f542fe0..864019e 100644 (file)
  *
  *  hbytes range VALUE START SIZE                => substring (or error)
  *
+ *  hbytes h2ulong HEX                           => ulong  (HEX len must be 4)
+ *  hbytes ulong2h UL                            => hex
+ *
+ *  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)
+ *
+ *  ulong ul2int ULONG    => INT            can fail if >INT_MAX
+ *  ulong int2ul INT      => ULONG          can fail if <0
+ *
+ *  hbytes shift l|r ULONG BITS             fails if BITS >32
+ *  hbytes mask A B                         => A & B
+ *
  *  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)
@@ -122,7 +142,7 @@ void sockaddr_free(const SockAddr_Value*);
 
 /* from dgram.c */
 
-extern Tcl_ObjType sockid_type;
+extern Tcl_ObjType dgramsockid_type;
 typedef struct DgramSocket *DgramSockID;
 
 /* from hook.c */
@@ -136,6 +156,11 @@ 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 {
@@ -146,6 +171,11 @@ typedef struct {
 void fini_hbv(Tcl_Interp *ip, int rc, HBytes_Var *agg);
 
 /* from chop.c */
+  /* only do_... functions declared in tables.h */
+
+/* from ulong.c */
+
+Tcl_ObjType ulong_type;
 
 /* from enum.c */
 
index 0efc5f1..7f889fb 100644 (file)
@@ -94,6 +94,34 @@ 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)),
@@ -138,17 +166,17 @@ Tcl_ObjType hbytes_type = {
 
 int do_hbytes_raw2h(ClientData cd, Tcl_Interp *ip,
                    Tcl_Obj *binary, HBytes_Value *result) {
-  const char *str;
+  const unsigned char *str;
   int l;
 
-  str= Tcl_GetStringFromObj(binary,&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_NewStringObj(hbytes_data(&hex), hbytes_len(&hex));
+  *result= Tcl_NewByteArrayObj(hbytes_data(&hex), hbytes_len(&hex));
   return TCL_OK;
 }
 
@@ -212,15 +240,21 @@ int do_hbytes_range(ClientData cd, Tcl_Interp *ip,
   return TCL_OK;
 }
   
-int do__hbytes(ClientData cd, Tcl_Interp *ip,
-              const HBytes_SubCommand *subcmd,
-              int objc, Tcl_Obj *const *objv) {
+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__dgram_socket(ClientData cd, Tcl_Interp *ip,
-                    const DgramSocket_SubCommand *subcmd,
-                    int objc, Tcl_Obj *const *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);
 }
 
@@ -250,13 +284,20 @@ int get_urandom(Tcl_Interp *ip, Byte *buffer, int l) {
 }
 
 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(&sockid_type);
-  Tcl_CreateObjCommand(ip, "hbytes",       pa__hbytes,       0,0);
-  Tcl_CreateObjCommand(ip, "dgram-socket", pa__dgram_socket, 0,0);
+  Tcl_RegisterObjType(&dgramsockid_type);
+  Tcl_RegisterObjType(&ulong_type);
+
+  for (cmd=toplevel_commands;
+       cmd->name;
+       cmd++)
+    Tcl_CreateObjCommand(ip, cmd->name, cmd->func, 0,0);
+
   return TCL_OK;
 }
index 8260a44..4962731 100644 (file)
@@ -4,6 +4,202 @@
 #include "hbytes.h"
 #include "tables.h"
 
+/* nice simple functions */
+
+int do_ulong_int2ul(ClientData cd, Tcl_Interp *ip, int v,
+                   unsigned long *result) {
+  if (v<0) return staticerr(ip,"cannot convert -ve integer to ulong");
+  *result= v;
+  return TCL_OK;
+}
+  
+int do_ulong_ul2int(ClientData cd, Tcl_Interp *ip,
+                   unsigned long v, int *result) {
+  if (v>INT_MAX) return staticerr(ip,"ulong too large to fit in an int");
+  *result= v;
+  return TCL_OK;
+}
+
+int do_ulong_mask(ClientData cd, Tcl_Interp *ip,
+                 unsigned long a, unsigned long b, unsigned long *result) {
+  *result= a & b;
+  return TCL_OK;
+}
+  
+int do_ulong_shift(ClientData cd, Tcl_Interp *ip, int right,
+                  unsigned long v, int bits, unsigned long *result) {
+  if (bits > 32) return staticerr(ip,"shift out of range (32) bits");
+  *result= (bits==32 ? 0 :
+           right ? v >> bits : v << bits);
+  return TCL_OK;
+}
+
+int do_ulong_compare(ClientData cd, Tcl_Interp *ip,
+                    unsigned long a, unsigned long b,
+                    int *result) {
+  *result= (a==b) ? -1 : (a < b) ? -1 : 1;
+  return TCL_OK;
+}
+
+/* bitfields */
+
+typedef struct {
+  const char *name;
+  int want_arg;
+  int (*reader_writer[2])(Tcl_Interp *ip, unsigned long *value_io,
+                         int *ok_io, Tcl_Obj *arg);
+} BitFieldType;
+
+static int bf_zero_read(Tcl_Interp *ip, unsigned long *value_io,
+                       int *ok_io, Tcl_Obj *arg) {
+  if (*value_io) *ok_io= 0;
+  return TCL_OK;
+}
+
+static int bf_zero_write(Tcl_Interp *ip, unsigned long *value_io,
+                        int *ok_io, Tcl_Obj *arg) {
+  *value_io= 0;
+  return TCL_OK;
+}
+
+static int bf_ignore(Tcl_Interp *ip, unsigned long *value_io,
+                    int *ok_io, Tcl_Obj *arg) {
+  return TCL_OK;
+}
+
+static int bf_fixed_read(Tcl_Interp *ip, unsigned long *value_io,
+                        int *ok_io, Tcl_Obj *arg) {
+  unsigned long ul;
+  int rc;
+  
+  rc= pat_ulong(ip, arg, &ul);  if (rc) return rc;
+  if (*value_io != ul) *ok_io= 0;
+  return TCL_OK;
+}
+
+static int bf_ulong_write(Tcl_Interp *ip, unsigned long *value_io,
+                         int *ok_io, Tcl_Obj *arg) {
+  unsigned long ul;
+  int rc;
+  
+  rc= pat_ulong(ip, arg, &ul);  if (rc) return rc;
+  *value_io= ul;
+  return TCL_OK;
+}
+
+static int bf_var_read(Tcl_Interp *ip, Tcl_Obj *varname, Tcl_Obj *val) {
+  Tcl_Obj *rp;
+  rp= Tcl_ObjSetVar2(ip,varname,0,val,TCL_LEAVE_ERR_MSG);
+  if (!rp) return TCL_ERROR;
+  return TCL_OK;
+}
+
+static int bf_ulong_read(Tcl_Interp *ip, unsigned long *value_io,
+                        int *ok_io, Tcl_Obj *arg) {
+  return bf_var_read(ip,arg, ret_ulong(ip,*value_io));
+}
+
+static int bf_uint_write(Tcl_Interp *ip, unsigned long *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");
+  *value_io= v;
+  return TCL_OK;
+}
+
+static int bf_uint_read(Tcl_Interp *ip, unsigned long *value_io,
+                       int *ok_io, Tcl_Obj *arg) {
+  if (*value_io > INT_MAX)
+    return staticerr(ip,"value from bitfield exceeds INT_MAX");
+  return bf_var_read(ip,arg, ret_int(ip,*value_io));
+}
+
+#define BFT(t,a) { #t, a, { bf_read_##t, bf_write_##t } }
+static const BitFieldType bitfieldtypes[]= {
+  { "zero",   0, { bf_zero_read,  bf_zero_write  } },
+  { "ignore", 0, { bf_ignore,     bf_ignore      } },
+  { "fixed",  1, { bf_fixed_read, bf_ulong_write } },
+  { "ulong",  1, { bf_ulong_read, bf_ulong_write } },
+  { "uint",   1, { bf_uint_read,  bf_uint_write  } },
+  { 0 }
+};
+
+static int do_bitfields(Tcl_Interp *ip, int writing, int *ok_r,
+                       unsigned long *value_io,
+                       int objc, Tcl_Obj *const *objv) {
+  const BitFieldType *ftype;
+  Tcl_Obj *arg;
+  int sz, pos, rc;
+  unsigned long value, sz_mask, this_mask, this_field;
+  
+  pos= 32;
+  value= *value_io;
+  *ok_r= 1;
+
+  while (--objc) {
+    rc= Tcl_GetIntFromObj(ip,*++objv,&sz);  if (rc) return rc;
+    if (!--objc) return staticerr(ip,"wrong # args: missing bitfield type");
+
+    if (sz<0) return staticerr(ip,"bitfield size is -ve");
+    if (sz>pos) return staticerr(ip,"total size of bitfields >32");
+
+    pos -= sz;
+
+    sz_mask= ~(~0UL << sz);
+    this_mask= (sz_mask << pos);
+    this_field= (value & this_mask) >> pos;
+    
+    ftype= enum_lookup_cached(ip,*++objv,bitfieldtypes,"bitfield type");
+    if (!ftype) return TCL_ERROR;
+
+    if (ftype->want_arg) {
+      if (!--objc)
+       return staticerr(ip,"wrong # args: missing arg for bitfield");
+      arg= *++objv;
+    } else {
+      arg= 0;
+    }
+    rc= ftype->reader_writer[writing](ip, &this_field, ok_r, arg);
+    if (rc) return rc;
+
+    if (!*ok_r) return TCL_OK;
+
+    if (this_field & ~sz_mask)
+      return staticerr(ip,"bitfield value has more bits than bitfield");
+    
+    value &= ~this_mask;
+    value |= (this_field << pos);
+  }
+
+  if (pos != 0)
+    return staticerr(ip,"bitfield sizes add up to <32");
+
+  *value_io= value;
+  return TCL_OK;
+}
+
+int do_ulong_bitfields2ul(ClientData cd, Tcl_Interp *ip,
+                         unsigned long base,
+                         int objc, Tcl_Obj *const *objv,
+                         unsigned long *result) {
+  int ok, rc;
+  
+  *result= base;
+  rc= do_bitfields(ip,1,&ok,result,objc,objv);
+  assert(ok);
+  return rc;
+}
+
+int do_ulong_ul2bitfields(ClientData cd, Tcl_Interp *ip,
+                         unsigned long value,
+                         int objc, Tcl_Obj *const *objv,
+                         int *result) {
+  return do_bitfields(ip,0,result,&value,objc,objv);
+}
+
+/* conversion to/from hbytes */
+
 #define SIZES                                  \
   DO_SIZE(ulong, 4, 0xffffffffUL,              \
          DO_BYTE(0,24)                         \
@@ -43,19 +239,67 @@ SIZES
 #undef DO_BYTE
 #undef DO_SIZE
 
-int pat_ulong(Tcl_Interp *ip, Tcl_Obj *obj, unsigned long *val) {
-  char *str, *ep;
+/* Arg parsing */
 
-  str= Tcl_GetString(obj);
-  errno= 0;
-  *val= strtoul(str,&ep,0);
-  if (*ep || errno) return staticerr(ip, "bad unsigned value");
+int pat_ulong(Tcl_Interp *ip, Tcl_Obj *o, unsigned long *val) {
+  int rc;
+  
+  rc= Tcl_ConvertToType(ip,o,&ulong_type);
+  if (rc) return rc;
+  *val= *(const unsigned long*)&o->internalRep.longValue;
   return TCL_OK;
 }
 
 Tcl_Obj *ret_ulong(Tcl_Interp *ip, unsigned long val) {
+  Tcl_Obj *o;
+
+  o= Tcl_NewObj();
+  Tcl_InvalidateStringRep(o);
+  *(unsigned long*)&o->internalRep.longValue= val;
+  o->typePtr= &ulong_type;
+  return o;
+}
+
+/* Tcl ulong type */
+
+static void ulong_t_free(Tcl_Obj *o) { }
+
+static void ulong_t_dup(Tcl_Obj *src, Tcl_Obj *dup) {
+  dup->internalRep= src->internalRep;
+}
+
+static void ulong_t_ustr(Tcl_Obj *o) {
+  unsigned long val;
   char buf[11];
+
+  val= *(const unsigned long*)&o->internalRep.longValue;
+
   assert(val <= 0xffffffffUL);
   snprintf(buf,sizeof(buf), "0x%08lx", val);
-  return Tcl_NewStringObj(buf,sizeof(buf)-1);
+
+  obj_updatestr_vstringls(o, buf, sizeof(buf)-1, (char*)0);
+}
+
+static int ulong_t_sfa(Tcl_Interp *ip, Tcl_Obj *o) {
+  char *str, *ep;
+  unsigned long ul;
+
+
+  str= Tcl_GetString(o);
+  errno=0;
+  if (str[0]=='0' && str[1]=='b' && str[2]) {
+    ul= strtoul(str+2,&ep,2);
+  } else {
+    ul= strtoul(str,&ep,0);
+  }
+  if (*ep || errno) return staticerr(ip, "bad unsigned long value");
+
+  objfreeir(o);
+  *(unsigned long*)&o->internalRep.longValue= ul;
+  return TCL_OK;
 }
+
+Tcl_ObjType ulong_type = {
+  "ulong-nearly",
+  ulong_t_free, ulong_t_dup, ulong_t_ustr, ulong_t_sfa
+};