all compiles again. more pat to do.

diff --git a/base/chiark-tcl.h b/base/chiark-tcl.h
index d4a5719eee94763cd73c77f3b8e6e021affa1168..a545edeae9f4cd949516d78dc09ef55034417724 100644 (file)
--- a/base/chiark-tcl.h
+++ b/base/chiark-tcl.h
@@ -46,12 +46,22 @@ void objfreeir(Tcl_Obj *o);
 void hbytes_set(HBytes_Value *upd, const Byte *array, int l);
 Tcl_Obj *hbytes_set_obj(Tcl_Obj *overwrite, const Byte *array, int l);
 
+/* from parse.c */
+
+typedef struct {
+  HBytes_Value *hb;
+  Tcl_Obj *obj, *var;
+} HBytes_Var;
+
+void fini_hbv(Tcl_Interp *ip, int rc, HBytes_Var *agg);
+
 /* 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,
-                                   size_t entrysize, const void *firstentry,
+                                   const void *firstentry, size_t entrysize,
                                    const char *what);
 #define enum_lookup_cached(ip,o,table,what)                    \
     (enum_lookup_cached_func((ip),(o),                         \
@@ -64,6 +74,10 @@ const void *enum_lookup_cached_func(Tcl_Interp *ip, Tcl_Obj *o,
    * set to the error message.
    */
 
+int enum1_lookup_cached_func(Tcl_Interp *ip, Tcl_Obj *o,
+                            const char *opts, const char *what);
+  /* -1 => error */
+
 /* from crypto.c */
 
 typedef struct {

diff --git a/base/enum.c b/base/enum.c
index 1a66aa34629961b696d084d2bef9784de694be78..a4e9de7ff9ad0f0d6d686f97f1c049023db2ccec 100644 (file)
--- a/base/enum.c
+++ b/base/enum.c
@@ -2,6 +2,8 @@
  *
  */
 
+#include <string.h>
+
 #include "hbytes.h"
 
 static void enum_nt_dup(Tcl_Obj *src, Tcl_Obj *dup) {
@@ -21,8 +23,13 @@ Tcl_ObjType enum_nearlytype = {
   0, enum_nt_dup, enum_nt_ustr, enum_nt_sfa
 };
 
+Tcl_ObjType enum1_nearlytype = {
+  "enum1-nearly",
+  0, enum_nt_dup, enum_nt_ustr, enum_nt_sfa
+};
+
 const void *enum_lookup_cached_func(Tcl_Interp *ip, Tcl_Obj *o,
-                                   size_t entrysize, const void *firstentry,
+                                   const void *firstentry, size_t entrysize,
                                    const char *what) {
   const char *supplied, *found;
   const char *ep;
@@ -52,3 +59,28 @@ const void *enum_lookup_cached_func(Tcl_Interp *ip, Tcl_Obj *o,
     Tcl_AppendResult(ip, " ",found,(char*)0);
   return 0;
 }
+
+int enum1_lookup_cached_func(Tcl_Interp *ip, Tcl_Obj *o,
+                            const char *opts, const char *what) {
+  const char *supplied, *fp;
+  
+  if (o->typePtr != &enum1_nearlytype ||
+      o->internalRep.twoPtrValue.ptr1 != opts) {
+
+    supplied= Tcl_GetStringFromObj(o,0);  assert(supplied);
+    
+    if (!(strlen(supplied) == 1 &&
+         (fp= strchr(opts, supplied[0])))) {
+      Tcl_ResetResult(ip);
+      Tcl_AppendResult(ip, "invalid ",what,
+                      " - must be one character from: ", opts);
+      return -1;
+    }
+    
+    objfreeir(o);
+    o->typePtr= &enum1_nearlytype;
+    o->internalRep.twoPtrValue.ptr1= (void*)opts;
+    o->internalRep.twoPtrValue.ptr2= (void*)fp;
+  }
+  return (const char*)o->internalRep.twoPtrValue.ptr2 - opts;
+}

diff --git a/base/parse.c b/base/parse.c
index 125dd61eb9e182a2fbfd36f46ac824f38a9f006e..14d8f9906b59334ab8343e59c54d98e3d1e153cf 100644 (file)
--- a/base/parse.c
+++ b/base/parse.c
@@ -1,16 +1,66 @@
-  sc= enum_lookup_cached(ip,objv[1],subcommands,"hbytes subcommand");
+/*
+ */
 
+#include "tables.h"
 
-static Tcl_Obj *hb_getvar(Tcl_Interp *ip, Tcl_Obj *varname) {
-  int ec;
-  Tcl_Obj *value;
+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_enum(Tcl_Interp *ip, Tcl_Obj *obj, const void **val,
+            const void *opts, size_t sz, const char *what) {
+  *val= enum_lookup_cached_func(ip,obj,opts,sz,what);
+  if (!*val) return TCL_ERROR;
+  return TCL_OK;
+}
   
-  value= Tcl_ObjGetVar2(ip,varname,0,TCL_LEAVE_ERR_MSG);
-  if (!value) return 0;
+int pat_obj(Tcl_Interp *ip, Tcl_Obj *obj, Tcl_Obj **val) {
+  *val= obj;
+  return TCL_OK;
+}
 
-  ec= Tcl_ConvertToType(ip,value,&hbytes_type);
-  if (ec) return 0;
+int pat_hbv(Tcl_Interp *ip, Tcl_Obj *var, HBytes_Var *agg) {
+  int rc;
+  Tcl_Obj *val;
+
+  Tcl_IncrRefCount(var);
+  agg->var= var;
+
+  val= Tcl_ObjGetVar2(ip,var,0,TCL_LEAVE_ERR_MSG);
+  if (!val) return TCL_ERROR;
+  if (Tcl_IsShared(val)) val= Tcl_DuplicateObj(val);
+  Tcl_IncrRefCount(val);
+  agg->obj= val;
+  
+  rc= Tcl_ConvertToType(ip,val,&hbytes_type);
+  if (rc) return rc;
 
-  return value;
+  agg->hb= &HBYTES(val);
+  return TCL_OK;
 }
 
+void fini_hbv(Tcl_Interp *ip, int rc, HBytes_Var *agg) {
+  Tcl_Obj *ro;
+  
+  if (!rc) {
+    assert(agg->obj);
+    ro= Tcl_ObjSetVar2(ip,agg->var,0,agg->obj,TCL_LEAVE_ERR_MSG);
+    if (!ro) rc= TCL_ERROR;
+  }
+  if (agg->obj) Tcl_DecrRefCount(agg->obj);
+  if (agg->var) Tcl_DecrRefCount(agg->var);
+}
+
+int pat_hb(Tcl_Interp *ip, Tcl_Obj *obj, HBytes_Value *val) {
+  int rc;
+  rc= Tcl_ConvertToType(ip,obj,&hbytes_type);  if (rc) return rc;
+  *val= HBYTES(obj);
+  return TCL_OK;
+}
+
+Tcl_Obj *ret_hb(Tcl_Interp *ip, HBytes_Value val) {
+  return hbytes_set_obj(0, val.start, HBYTES_LEN(val));
+}

diff --git a/base/tables-examples.tct b/base/tables-examples.tct
index 46fb7fbea61f23fe4435cc18b512443b7c69996e..69a4fb63b523f0fbc9a9d41a8e7a4989d5c11a8c 100644 (file)
--- a/base/tables-examples.tct
+++ b/base/tables-examples.tct
@@ -1,15 +1,17 @@
 Type hb:                       HBytes_Value @
 Init hb                                @.start=0; @.end=0;
-Type hbv:                      HBytes_Value *@
+Type hbv:                      HBytes_Var @
+Init hbv                       @.hb=0; @.obj=0; @.var=0;
+Fini hbv                       fini_hbv(ip, rc, &@);
 
 H-Include      "hbytes.h"
 
 Untabled
        hbytes
-               subcmd  enum(ParserCommandTableEntry,pcmdtab_hbytes)
+               subcmd  enum(HBytes_SubCommand, "hbytes subcommand")
                obj     ...
 
-Table hbytes
+Table hbytes HBytes_SubCommand
        raw2h
                binary  obj
                =>      hb
@@ -38,29 +40,28 @@ Table hbytes
                length  int
                =>      hb
        pkcs5
-               meth    enum(PadMethodInfo,padmethodinfos)
+               meth    enum(PadMethod, "hbytes pad subcommand")
                obj     ...
        blockcipher
-               encrypt charfrom("de")
+               encrypt charfrom("de","encrypt/decrypt")
                v       hbv
-               alg     enum(BlockCipherAlgInfo,blockcipheralginfos)
-               mode    enum(BlockCipherModeInfo,blockciphermodeinfos)
+               alg     enum(BlockCipherAlgInfo, "alg")
+               mode    enum(BlockCipherModeInfo, "mode")
                ?iv     hb
                =>      hb
        hash
-               alg     enum(HashAlgInfo,hashalginfos)
+               alg     enum(HashAlgInfo, "hash alg")
                message hb
                =>      hb
        hmac
-               alg     enum(HashAlgInfo,hashalginfos)
+               alg     enum(HashAlgInfo, "hash alg for hmac")
                message hb
                key     hb
                maclen  int
                =>      hb
 
-Table padmethod
-       Of PadMethodInfo
+Table padmethod PadMethod
        pa      1, 0
 
-EntryExtra PadMethodInfo
+EntryExtra PadMethod
        int pad, algname;

diff --git a/base/tcmdifgen b/base/tcmdifgen
index 3a317549d62e7c003caa17ee5afa225847b0a01f..aa717d4d74b1225ba3f6c889a1e67e078c990a00 100755 (executable)
--- a/base/tcmdifgen
+++ b/base/tcmdifgen
@@ -47,20 +47,16 @@ sub parse ($$) {
            unshift @i, $this_indent;
        }
 
-       if (@i==0 && m/^Table\s+(\w+)$/) {
+       if (@i==0 && m/^Table\s+(\w+)\s+(\w+)$/) {
            zilch();
            $c_table= $1;
-           $table_x{$c_table}{C}= 'ParserCommandTableEntry';
-           $entrytype_x{ParserCommandTableEntry}= '';
+           $table_x{$c_table}{C}= $2;
+           $entrytype_x{$2}= '';
        } elsif (@i==0 && m/^Untabled$/) {
            zilch();
            $c_table= '';
        } elsif (@i==0 && m/^(C|H)\-Include\s+(\S.*)$/) {
            o(lc $1, 30, "#include $2\n");
-       } elsif (@i==1 && m/^Of\s+(\w+)$/ && defined $c_table) {
-           die unless length $c_table;
-           $table_x{$c_table}{C}= $1;
-           $entrytype_x{$1}= '';
        } elsif (@i==0 && m/^EntryExtra\s+(\w+)$/) {
            zilch();
            $c_entryextra= $1;
@@ -105,6 +101,8 @@ sub parse ($$) {
            $types{$typename}= { C => $ctype, X => $xtypeargs };
        } elsif (@i==0 && s/^Init\s+(\w+)\s+(\S.*)//) {
            $type_init{$1}= $2;
+       } elsif (@i==0 && s/^Fini\s+(\w+)\s+(\S.*)//) {
+           $type_fini{$1}= $2;
        } else {
            badsyntax($wh,$., sprintf
                      "bad directive (indent level %d)", scalar @i);
@@ -121,13 +119,13 @@ foreach $t (sort keys %types) {
     $type= $types{$t};
     $c= $type->{C};
     $xta= $type->{X};
-    $decl= "int pat_$t(Tcl_Interp*, Tcl_Obj*, ";
-    $decl .= subst_in_decl('*', $c, "type $t");
+    $decl= "int pat_$t(Tcl_Interp *ip, Tcl_Obj *obj, ";
+    $decl .= subst_in_decl('*val', $c, "type $t");
     $decl .= ", $xta",  if length $xta;
     $decl .= ");\n";
     o('h',160, $decl);
 
-    $decl= "Tcl_Obj *ret_$t(Tcl_Interp*, ".subst_in_decl('',$c).");\n";
+    $decl= "Tcl_Obj *ret_$t(Tcl_Interp *ip, ".subst_in_decl('val',$c).");\n";
     o('h',170, $decl);
 }
 
@@ -188,8 +186,13 @@ foreach $c_table (sort keys %tables) {
                $pa_vars .= "  const void *v_$n= 0;\n";
                $paarg= "&v_$n";
                $pafin= "\n  a_$n= v_$n; ";
-               $a =~ m/\,/ or die; $a = "$', sizeof($`)";
-               o('h', 210, "extern const $` $'".'[]'.";\n");
+               $a =~ m/\,/ or die "invalid enum type \`$a'\n";
+               $a_tab = lc($`).'s';
+               $a = "$a_tab, sizeof($`), $'";
+               o('h', 210, "extern const $` $a_tab".'[]'.";\n");
+           }
+           if (exists $type_fini{$t}) {
+               $pa_fini .= '  '.subst_in("a_$n", $type_fini{$t})."\n";
            }
            $pa_body .= "  rc= pat_$t(ip, *objv++, $paarg";
            $pa_body .= ", ".$a if length $a;
@@ -256,13 +259,13 @@ foreach $c_table (sort keys %tables) {
        o('h',100, $do_decl.";\n") or die $!;
        
 
-       $op_tab .= sprintf("  { %-20s, %-50s%s },\n",
-                          "\"$c_entry\"",
+       $op_tab .= sprintf("  { %-20s %-40s%s },\n",
+                          "\"$c_entry\",",
                           "pa_${c_table}_${c_entry}",
                           $r_entry->{I});
     }
     if (length $c_table) {
-       $decl= "const $x_table->{C} pcmdtab_$c_table".'[]';
+       $decl= "const $x_table->{C} ".lc($x_table->{C}).'s[]';
        o('h', 500, "extern $decl;\n");
        o('c', 100,
          "$decl = {\n".
@@ -281,7 +284,8 @@ o(h, 0,
 
 o(h, 400,
   "void setstringresult(Tcl_Interp*, const char*);\n".
-  "int pat_enum(Tcl_Interp*, Tcl_Obj*, const void**, const void*, size_t);\n");
+  "int pat_enum(Tcl_Interp*, Tcl_Obj*, const void**,".
+  "             const void*, size_t, const char *what);\n");
 
 o(h, 999,
   "#endif /*INCLUDED_\U${prefix}_H*/\n");
@@ -328,7 +332,7 @@ sub make_decl ($$$) {
     my ($n, $t, $ta) = @_;
     my ($type);
     if ($t eq 'enum') {
-       $ta =~ m/\,/ or die "enum with bad args \`$ta'\n";
+       $ta =~ m/\,/ or die "invalid enum type \`$t'\n";
        $c= "const $` *@";
     } else { 
        defined $types{$t} or die "unknown type $t\n";
@@ -356,6 +360,7 @@ sub badsyntax ($$$) {
 }
 
 __DATA__
-Type int:                      int
-Type obj:                      Tcl_Obj *@
-Type charfrom(const char*):    int
+Type int:      int
+Type obj:      Tcl_Obj *@
+
+Type charfrom(const char *opts, const char *what):     int

diff --git a/base/troglodyte-Makefile b/base/troglodyte-Makefile
index 985975c014629f5c2651eea95708e14c13cdda56..2972afa9b331019c0e2a64c3bc65830c27a578dc 100644 (file)
--- a/base/troglodyte-Makefile
+++ b/base/troglodyte-Makefile
@@ -1,6 +1,7 @@
 OBJS=          tables.o \
                hbytes.o \
-               enum.o
+               enum.o \
+               parse.o
 
 HDRS=          hbytes.h \
                $(AUTO_HDRS)

diff --git a/hbytes/hbytes.c b/hbytes/hbytes.c
index d095531a03c47325d26be59467cde9a99cdea93b..626b2da6cdd497dfbece6a6ef8cc8d51f183ed5a 100644 (file)
--- a/hbytes/hbytes.c
+++ b/hbytes/hbytes.c
@@ -141,7 +141,7 @@ HC_DEFINE(pkcs5) {
 #endif
 
 int do__hbytes(ClientData cd, Tcl_Interp *ip,
-              const ParserCommandTableEntry *subcmd,
+              const HBytes_SubCommand *subcmd,
               int objc, Tcl_Obj *const *objv) {
   return subcmd->func(0,ip,objc,objv);
 }
@@ -149,6 +149,7 @@ int do__hbytes(ClientData cd, Tcl_Interp *ip,
 int Hbytes_Init(Tcl_Interp *ip) {
   Tcl_RegisterObjType(&hbytes_type);
   Tcl_RegisterObjType(&enum_nearlytype);
+  Tcl_RegisterObjType(&enum1_nearlytype);
   Tcl_CreateObjCommand(ip,"hbytes", pa__hbytes,0,0);
   return TCL_OK;
 }

diff --git a/hbytes/hbytes.h b/hbytes/hbytes.h
index d4a5719eee94763cd73c77f3b8e6e021affa1168..a545edeae9f4cd949516d78dc09ef55034417724 100644 (file)
--- a/hbytes/hbytes.h
+++ b/hbytes/hbytes.h
@@ -46,12 +46,22 @@ void objfreeir(Tcl_Obj *o);
 void hbytes_set(HBytes_Value *upd, const Byte *array, int l);
 Tcl_Obj *hbytes_set_obj(Tcl_Obj *overwrite, const Byte *array, int l);
 
+/* from parse.c */
+
+typedef struct {
+  HBytes_Value *hb;
+  Tcl_Obj *obj, *var;
+} HBytes_Var;
+
+void fini_hbv(Tcl_Interp *ip, int rc, HBytes_Var *agg);
+
 /* 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,
-                                   size_t entrysize, const void *firstentry,
+                                   const void *firstentry, size_t entrysize,
                                    const char *what);
 #define enum_lookup_cached(ip,o,table,what)                    \
     (enum_lookup_cached_func((ip),(o),                         \
@@ -64,6 +74,10 @@ const void *enum_lookup_cached_func(Tcl_Interp *ip, Tcl_Obj *o,
    * set to the error message.
    */
 
+int enum1_lookup_cached_func(Tcl_Interp *ip, Tcl_Obj *o,
+                            const char *opts, const char *what);
+  /* -1 => error */
+
 /* from crypto.c */
 
 typedef struct {

diff --git a/hbytes/parse.c b/hbytes/parse.c
index 125dd61eb9e182a2fbfd36f46ac824f38a9f006e..14d8f9906b59334ab8343e59c54d98e3d1e153cf 100644 (file)
--- a/hbytes/parse.c
+++ b/hbytes/parse.c
@@ -1,16 +1,66 @@
-  sc= enum_lookup_cached(ip,objv[1],subcommands,"hbytes subcommand");
+/*
+ */
 
+#include "tables.h"
 
-static Tcl_Obj *hb_getvar(Tcl_Interp *ip, Tcl_Obj *varname) {
-  int ec;
-  Tcl_Obj *value;
+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_enum(Tcl_Interp *ip, Tcl_Obj *obj, const void **val,
+            const void *opts, size_t sz, const char *what) {
+  *val= enum_lookup_cached_func(ip,obj,opts,sz,what);
+  if (!*val) return TCL_ERROR;
+  return TCL_OK;
+}
   
-  value= Tcl_ObjGetVar2(ip,varname,0,TCL_LEAVE_ERR_MSG);
-  if (!value) return 0;
+int pat_obj(Tcl_Interp *ip, Tcl_Obj *obj, Tcl_Obj **val) {
+  *val= obj;
+  return TCL_OK;
+}
 
-  ec= Tcl_ConvertToType(ip,value,&hbytes_type);
-  if (ec) return 0;
+int pat_hbv(Tcl_Interp *ip, Tcl_Obj *var, HBytes_Var *agg) {
+  int rc;
+  Tcl_Obj *val;
+
+  Tcl_IncrRefCount(var);
+  agg->var= var;
+
+  val= Tcl_ObjGetVar2(ip,var,0,TCL_LEAVE_ERR_MSG);
+  if (!val) return TCL_ERROR;
+  if (Tcl_IsShared(val)) val= Tcl_DuplicateObj(val);
+  Tcl_IncrRefCount(val);
+  agg->obj= val;
+  
+  rc= Tcl_ConvertToType(ip,val,&hbytes_type);
+  if (rc) return rc;
 
-  return value;
+  agg->hb= &HBYTES(val);
+  return TCL_OK;
 }
 
+void fini_hbv(Tcl_Interp *ip, int rc, HBytes_Var *agg) {
+  Tcl_Obj *ro;
+  
+  if (!rc) {
+    assert(agg->obj);
+    ro= Tcl_ObjSetVar2(ip,agg->var,0,agg->obj,TCL_LEAVE_ERR_MSG);
+    if (!ro) rc= TCL_ERROR;
+  }
+  if (agg->obj) Tcl_DecrRefCount(agg->obj);
+  if (agg->var) Tcl_DecrRefCount(agg->var);
+}
+
+int pat_hb(Tcl_Interp *ip, Tcl_Obj *obj, HBytes_Value *val) {
+  int rc;
+  rc= Tcl_ConvertToType(ip,obj,&hbytes_type);  if (rc) return rc;
+  *val= HBYTES(obj);
+  return TCL_OK;
+}
+
+Tcl_Obj *ret_hb(Tcl_Interp *ip, HBytes_Value val) {
+  return hbytes_set_obj(0, val.start, HBYTES_LEN(val));
+}