Table-generated stuff. Now need parsing funcs.

diff --git a/base/chiark-tcl.h b/base/chiark-tcl.h
index f136758fdfe8be32f4d29235cbf45297588887c1..d4a5719eee94763cd73c77f3b8e6e021affa1168 100644 (file)
--- a/base/chiark-tcl.h
+++ b/base/chiark-tcl.h
@@ -43,7 +43,8 @@ extern Tcl_ObjType hbytes_type;
 int staticerr(Tcl_Interp *ip, const char *m);
 void objfreeir(Tcl_Obj *o);
 
 int staticerr(Tcl_Interp *ip, const char *m);
 void objfreeir(Tcl_Obj *o);
 

-Tcl_Obj *hbytes_set(Tcl_Obj *overwrite, const Byte *array, int l);
+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 enum.c */
 
 
 /* from enum.c */
 


@@ -63,10 +64,24 @@ const void *enum_lookup_cached_func(Tcl_Interp *ip, Tcl_Obj *o,
    * set to the error message.
    */
 
    * set to the error message.
    */
 

+/* from crypto.c */
+
+typedef struct {
+  int blocksize, hashsize;
+} HashAlgInfo;
+
+typedef struct {
+  int blocksize;
+} BlockCipherAlgInfo;
+
+typedef struct {
+  int dummy;
+} BlockCipherModeInfo;
+

 /* useful macros */
 
 /* useful macros */
 

-#define HBYTES(o) ((HBytes_Value*)&(o)->internalRep.twoPtrValue)
-#define HBYTES_LEN(o) (HBYTES((o))->end - HBYTES((o))->start)
+#define HBYTES(o) (*(HBytes_Value*)&(o)->internalRep.twoPtrValue)
+#define HBYTES_LEN(hb) ((hb).end - (hb).start)

 
 #define TALLOC(s) ((void*)Tcl_Alloc((s)))
 #define TFREE(f) (Tcl_Free((void*)(f)))
 
 #define TALLOC(s) ((void*)Tcl_Alloc((s)))
 #define TFREE(f) (Tcl_Free((void*)(f)))

diff --git a/base/parse.c b/base/parse.c
new file mode 100644 (file)
index 0000000..125dd61
--- /dev/null
+++ b/base/parse.c
@@ -0,0 +1,16 @@
+  sc= enum_lookup_cached(ip,objv[1],subcommands,"hbytes subcommand");
+
+
+static Tcl_Obj *hb_getvar(Tcl_Interp *ip, Tcl_Obj *varname) {
+  int ec;
+  Tcl_Obj *value;
+  
+  value= Tcl_ObjGetVar2(ip,varname,0,TCL_LEAVE_ERR_MSG);
+  if (!value) return 0;
+
+  ec= Tcl_ConvertToType(ip,value,&hbytes_type);
+  if (ec) return 0;
+
+  return value;
+}
+

diff --git a/base/tables-examples.tct b/base/tables-examples.tct
index 553f7689aaf2d64f5b5061838f87bcdcdcc1f6f1..46fb7fbea61f23fe4435cc18b512443b7c69996e 100644 (file)
--- a/base/tables-examples.tct
+++ b/base/tables-examples.tct
@@ -4,6 +4,11 @@ Type hbv:                      HBytes_Value *@
 
 H-Include      "hbytes.h"
 
 
 H-Include      "hbytes.h"
 

+Untabled
+       hbytes
+               subcmd  enum(ParserCommandTableEntry,pcmdtab_hbytes)
+               obj     ...
+

 Table hbytes
        raw2h
                binary  obj
 Table hbytes
        raw2h
                binary  obj


@@ -53,7 +58,9 @@ Table hbytes
                maclen  int
                =>      hb
 
                maclen  int
                =>      hb
 

-#Table padmethodinfos
-#      Info
-#              int algname;
-#Entries
+Table padmethod
+       Of PadMethodInfo
+       pa      1, 0
+
+EntryExtra PadMethodInfo
+       int pad, algname;

diff --git a/base/tcmdifgen b/base/tcmdifgen
index 4f4d154d9a57c187539a11ffa993a2b4cf305dd7..3a317549d62e7c003caa17ee5afa225847b0a01f 100755 (executable)
--- a/base/tcmdifgen
+++ b/base/tcmdifgen
@@ -24,6 +24,12 @@ while (@ARGV) {
 
 die "must say -w<something>\n" if !defined $write;
 
 
 die "must say -w<something>\n" if !defined $write;
 

+sub zilch () {
+    undef $c_table;
+    undef $c_entryextra;
+    undef $c_of;
+}
+

 sub parse ($$) {
     my ($wh,$f) = @_;
     while (defined($_= $f->getline)) {
 sub parse ($$) {
     my ($wh,$f) = @_;
     while (defined($_= $f->getline)) {


@@ -42,12 +48,33 @@ sub parse ($$) {
        }
 
        if (@i==0 && m/^Table\s+(\w+)$/) {
        }
 
        if (@i==0 && m/^Table\s+(\w+)$/) {

+           zilch();

            $c_table= $1;
            $c_table= $1;

-           undef $c_entry;
+           $table_x{$c_table}{C}= 'ParserCommandTableEntry';
+           $entrytype_x{ParserCommandTableEntry}= '';
+       } 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==0 && m/^(C|H)\-Include\s+(\S.*)$/) {
            o(lc $1, 30, "#include $2\n");

-       } elsif (@i==1 && m/^([a-z]\w*)$/ && defined $c_table) {
-           $c_entry= $1;
+       } 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;
+       } elsif (@i>=1 && defined $c_entryextra) {
+           $entrytype_x{$c_entryextra} .= "  $_\n";
+       } elsif (@i==1 && m/^[a-z].*$/ && defined $c_table) {
+           if (m/^\w+$/) {
+               $c_entry= $_;
+           } elsif (m/^(\w+)\s+(\S.*)$/) {
+               $c_entry= $1;
+               $tables{$c_table}{$c_entry}{I} .= ", $2";
+           } else {
+               badsyntax($wh,$.,"bad entry");
+           }

            $tables{$c_table}{$c_entry}{A} = [ ];
        } elsif (@i==2 && m/^(\w+)\s+\.\.\.$/ && defined $c_entry) {
            $tables{$c_table}{$c_entry}{V}= $1;
            $tables{$c_table}{$c_entry}{A} = [ ];
        } elsif (@i==2 && m/^(\w+)\s+\.\.\.$/ && defined $c_entry) {
            $tables{$c_table}{$c_entry}{V}= $1;


@@ -94,24 +121,37 @@ foreach $t (sort keys %types) {
     $type= $types{$t};
     $c= $type->{C};
     $xta= $type->{X};
     $type= $types{$t};
     $c= $type->{C};
     $xta= $type->{X};

-    $decl= "int pat_$t(Tcl_Interp, Tcl_Obj*, ";
-    $decl .= subst_in('*', $c, "type $t");
+    $decl= "int pat_$t(Tcl_Interp*, Tcl_Obj*, ";
+    $decl .= subst_in_decl('*', $c, "type $t");

     $decl .= ", $xta",  if length $xta;
     $decl .= ", $xta",  if length $xta;

-    $decl .= ")\n";
+    $decl .= ");\n";

     o('h',160, $decl);
 
     o('h',160, $decl);
 

-    $decl= "Tcl_Obj *ret_$t(Tcl_Interp, ".subst_in('',$c).");\n";
+    $decl= "Tcl_Obj *ret_$t(Tcl_Interp*, ".subst_in_decl('',$c).");\n";

     o('h',170, $decl);
 }
 
     o('h',170, $decl);
 }
 

+foreach $c_entrytype (sort keys %entrytype_x) {
+    o('h', 20, "typedef struct $c_entrytype $c_entrytype;\n");
+    o('h', 100,
+      "struct $c_entrytype {\n".
+      "  const char *name;\n".
+      "  Tcl_ObjCmdProc *func;\n".
+      $entrytype_x{$c_entrytype}.
+      "};\n\n");
+}
+

 foreach $c_table (sort keys %tables) {
     $r_table= $tables{$c_table};
 foreach $c_table (sort keys %tables) {
     $r_table= $tables{$c_table};

+    $x_table= $table_x{$c_table};
+    $op_tab= '';
+

     foreach $c_entry (keys %$r_table) {
        $r_entry= $r_table->{$c_entry};
        $pa_decl= "int pa_${c_table}_${c_entry}(ClientData cd,".
     foreach $c_entry (keys %$r_table) {
        $r_entry= $r_table->{$c_entry};
        $pa_decl= "int pa_${c_table}_${c_entry}(ClientData cd,".

-           " Tcl_Interp ip, int objc, Tcl_Obj *const *objv)";
+           " Tcl_Interp *ip, int objc, Tcl_Obj *const *objv)";

        $do_decl= "int do_${c_table}_${c_entry}(";
        $do_decl= "int do_${c_table}_${c_entry}(";

-       @do_al= ();
+       @do_al= ('ClientData cd', 'Tcl_Interp *ip');

        @do_aa= qw(cd ip);
        $pa_init= '';
        $pa_argc= "  objc--; objv++;\n";
        @do_aa= qw(cd ip);
        $pa_init= '';
        $pa_argc= "  objc--; objv++;\n";


@@ -135,29 +175,35 @@ foreach $c_table (sort keys %tables) {
                        " e=\"too few args\"; goto e_err; }\n";
                    $pa_body .= "  objc -= $any_mand;\n";
                    $any_mand= 0;
                        " e=\"too few args\"; goto e_err; }\n";
                    $pa_body .= "  objc -= $any_mand;\n";
                    $any_mand= 0;

-                   $any_eerr= 0;
+                   $any_eerr= 1;

                }
                $pa_body .= "  if (!objc--) goto end_optional;\n";
                $any_optl= 1;
            } else {
                $any_mand++;
            }
                }
                $pa_body .= "  if (!objc--) goto end_optional;\n";
                $any_optl= 1;
            } else {
                $any_mand++;
            }

-           $pa_body .= "  rc= pat_$t(ip, *objv++, &a_$n";
+           $paarg= "&a_$n";
+           $pafin= '';

            if ($t eq 'enum') {
            if ($t eq 'enum') {

+               $pa_vars .= "  const void *v_$n= 0;\n";
+               $paarg= "&v_$n";
+               $pafin= "\n  a_$n= v_$n; ";

                $a =~ m/\,/ or die; $a = "$', sizeof($`)";
                $a =~ m/\,/ or die; $a = "$', sizeof($`)";

+               o('h', 210, "extern const $` $'".'[]'.";\n");

            }
            }

+           $pa_body .= "  rc= pat_$t(ip, *objv++, $paarg";

            $pa_body .= ", ".$a if length $a;
            $pa_body .= ", ".$a if length $a;

-           $pa_body .= "); if (rc) goto rc_err;\n";
+           $pa_body .= ");$pafin if (rc) goto rc_err;\n";

            push @do_aa, "a_$n";
        }
        if (exists $r_entry->{V}) {
            $va= $r_entry->{V};
            push @do_aa, "a_$n";
        }
        if (exists $r_entry->{V}) {
            $va= $r_entry->{V};

-           push @do_al, subst_in("${va}c", 'int @');
-           push @do_al, subst_in("${va}v", 'Tcl_Obj *const *@');
+           push @do_al, subst_in_decl("${va}c", 'int @');
+           push @do_al, subst_in_decl("${va}v", 'Tcl_Obj *const *@');

            push @do_aa, "objc-1", "objv+1";
        } else {
            $pa_body .= "  if (--objc) { e=\"too many args\"; goto e_err; }\n";
            push @do_aa, "objc-1", "objv+1";
        } else {
            $pa_body .= "  if (--objc) { e=\"too many args\"; goto e_err; }\n";

-           $any_eerr= 0;
+           $any_eerr= 1;

        }
        if ($any_optl) {
            $pa_body .= "end_optional:\n";
        }
        if ($any_optl) {
            $pa_body .= "end_optional:\n";


@@ -182,15 +228,22 @@ foreach $c_table (sort keys %tables) {
        if ($any_eerr) {
            $pa_vars .= "  const char *e;\n";
            $pa_fini .= "\n";
        if ($any_eerr) {
            $pa_vars .= "  const char *e;\n";
            $pa_fini .= "\n";

-           $pa_fini .= "e_err:";
+           $pa_fini .= "e_err:\n";

            $pa_fini .= "  setstringresult(ip,e);";
            $pa_fini .= "  rc= TCL_ERROR; goto rc_err;\n";
        }
        $pa_vars .= "\n";
        $pa_init .= "\n" if length $pa_init;
        $pa_fini .= "}\n\n";
            $pa_fini .= "  setstringresult(ip,e);";
            $pa_fini .= "  rc= TCL_ERROR; goto rc_err;\n";
        }
        $pa_vars .= "\n";
        $pa_init .= "\n" if length $pa_init;
        $pa_fini .= "}\n\n";

+
+       if (length $c_table) {
+           $static= 'static ';
+       } else {
+           $static= '';
+           o('h',90, "$pa_decl;\n");
+       }

        o('c',100,
        o('c',100,

-         "static ".$pa_decl." {\n".
+         $static.$pa_decl." {\n".

          $pa_vars.
          $pa_init.
          $pa_argc.
          $pa_vars.
          $pa_init.
          $pa_argc.


@@ -201,6 +254,21 @@ foreach $c_table (sort keys %tables) {
        $do_decl .= join ', ', @do_al;
        $do_decl .= ")";
        o('h',100, $do_decl.";\n") or die $!;
        $do_decl .= join ', ', @do_al;
        $do_decl .= ")";
        o('h',100, $do_decl.";\n") or die $!;

+       
+
+       $op_tab .= sprintf("  { %-20s, %-50s%s },\n",
+                          "\"$c_entry\"",
+                          "pa_${c_table}_${c_entry}",
+                          $r_entry->{I});
+    }
+    if (length $c_table) {
+       $decl= "const $x_table->{C} pcmdtab_$c_table".'[]';
+       o('h', 500, "extern $decl;\n");
+       o('c', 100,
+         "$decl = {\n".
+         $op_tab.
+         "  { 0 }\n".
+         "};\n\n");

     }
 }
 
     }
 }
 


@@ -211,6 +279,10 @@ o(h, 0,
   "#define INCLUDED_\U${prefix}_H\n\n".
   "#include <tcl.h>\n");
 
   "#define INCLUDED_\U${prefix}_H\n\n".
   "#include <tcl.h>\n");
 

+o(h, 400,
+  "void setstringresult(Tcl_Interp*, const char*);\n".
+  "int pat_enum(Tcl_Interp*, Tcl_Obj*, const void**, const void*, size_t);\n");
+

 o(h, 999,
   "#endif /*INCLUDED_\U${prefix}_H*/\n");
 
 o(h, 999,
   "#endif /*INCLUDED_\U${prefix}_H*/\n");
 


@@ -262,9 +334,16 @@ sub make_decl ($$$) {
        defined $types{$t} or die "unknown type $t\n";
        $c= $types{$t}{C};
     }
        defined $types{$t} or die "unknown type $t\n";
        $c= $types{$t}{C};
     }

-    return subst_in($n,$c);
+    return subst_in_decl($n,$c);

 }
 
 }
 

+sub subst_in_decl ($$$) {
+    my ($val, $pat, $why) = @_;
+    local ($_) = subst_in($val, $pat, $why);
+    s/ *(\**) *$/$1/;
+    return $_;
+}
+    

 sub subst_in ($$$) {
     my ($val, $pat, $why) = @_;
     $pat =~ m/\@/ or die "$pat for $val in $why ?";
 sub subst_in ($$$) {
     my ($val, $pat, $why) = @_;
     $pat =~ m/\@/ or die "$pat for $val in $why ?";

diff --git a/base/troglodyte-Makefile b/base/troglodyte-Makefile
index 9c67ece43c6b616b46230e4bec8536b3598b66a0..985975c014629f5c2651eea95708e14c13cdda56 100644 (file)
--- a/base/troglodyte-Makefile
+++ b/base/troglodyte-Makefile
@@ -18,10 +18,10 @@ all:                $(TARGETS) $(AUTOS)
 hbytes.so:     $(OBJS)
                $(CC) $(CFLAGS) $(LDFLAGS) -o $@ -shared $(OBJS) $(LDLIBS)
 
 hbytes.so:     $(OBJS)
                $(CC) $(CFLAGS) $(LDFLAGS) -o $@ -shared $(OBJS) $(LDLIBS)
 

-%.c:           %.tct
+%.c:           %.tct tcmdifgen

                ./tcmdifgen -wc -o$@ $<
 
                ./tcmdifgen -wc -o$@ $<
 

-%.h:           %.tct
+%.h:           %.tct tcmdifgen

                ./tcmdifgen -wh -o$@ $<
 
 %.o:           %.c $(HDRS)
                ./tcmdifgen -wh -o$@ $<
 
 %.o:           %.c $(HDRS)

diff --git a/hbytes/hbytes.c b/hbytes/hbytes.c
index d4a33f5082c056a1df90a0464e7323c5138cb1cf..d095531a03c47325d26be59467cde9a99cdea93b 100644 (file)
--- a/hbytes/hbytes.c
+++ b/hbytes/hbytes.c
@@ -3,26 +3,31 @@
  */
 
 #include "hbytes.h"
  */
 
 #include "hbytes.h"

+#include "tables.h"

 
 int staticerr(Tcl_Interp *ip, const char *m) {
   Tcl_SetResult(ip, (char*)m, TCL_STATIC);
   return TCL_ERROR;
 }
 
 
 int staticerr(Tcl_Interp *ip, const char *m) {
   Tcl_SetResult(ip, (char*)m, TCL_STATIC);
   return TCL_ERROR;
 }
 

-static void hbytes_setintern(Tcl_Obj *o, const Byte *array, int l) {
+void hbytes_set(HBytes_Value *upd, const Byte *array, int l) {

   Byte *np;
   Byte *np;

-    
-  HBYTES(o)->start= np= l ? TALLOC(l) : 0;
+
+  upd->start= np= l ? TALLOC(l) : 0;

   memcpy(np, array, l);
   memcpy(np, array, l);

-  HBYTES(o)->end= np + l;
+  upd->end= np + l;
+}
+
+static void hbytes_setintern(Tcl_Obj *o, const Byte *array, int l) {
+  hbytes_set(&HBYTES(o), array, l);

   o->typePtr = &hbytes_type;
 }
 
 static void hbytes_t_dup(Tcl_Obj *src, Tcl_Obj *dup) {
   o->typePtr = &hbytes_type;
 }
 
 static void hbytes_t_dup(Tcl_Obj *src, Tcl_Obj *dup) {

-  hbytes_setintern(src, HBYTES(src)->start, HBYTES_LEN(src));
+  hbytes_setintern(src, HBYTES(src).start, HBYTES_LEN(HBYTES(src)));

 }
 
 }
 

-Tcl_Obj *hbytes_set(Tcl_Obj *overwrite, const Byte *array, int l) {
+Tcl_Obj *hbytes_set_obj(Tcl_Obj *overwrite, const Byte *array, int l) {

   if (!overwrite) overwrite= Tcl_NewObj();
   objfreeir(overwrite);
   Tcl_InvalidateStringRep(overwrite);
   if (!overwrite) overwrite= Tcl_NewObj();
   objfreeir(overwrite);
   Tcl_InvalidateStringRep(overwrite);


@@ -31,7 +36,7 @@ Tcl_Obj *hbytes_set(Tcl_Obj *overwrite, const Byte *array, int l) {
 }
 
 static void hbytes_t_free(Tcl_Obj *o) {
 }
 
 static void hbytes_t_free(Tcl_Obj *o) {

-  TFREE(HBYTES(o)->start);
+  TFREE(HBYTES(o).start);

 }
 
 static void hbytes_t_ustr(Tcl_Obj *o) {
 }
 
 static void hbytes_t_ustr(Tcl_Obj *o) {


@@ -39,8 +44,8 @@ static void hbytes_t_ustr(Tcl_Obj *o) {
   char *str;
   const Byte *byte;
 
   char *str;
   const Byte *byte;
 

-  l= HBYTES_LEN(o);
-  byte= HBYTES(o)->start;
+  l= HBYTES_LEN(HBYTES(o));
+  byte= HBYTES(o).start;

   str= o->bytes= TALLOC(l*2+1);
   o->length= l*2;
   while (l>0) {
   str= o->bytes= TALLOC(l*2+1);
   o->length= l*2;
   while (l>0) {


@@ -80,8 +85,8 @@ fprintf(stderr,">%d|%s|%s<\n",l,os,cbuf);
   }
   objfreeir(o);
 
   }
   objfreeir(o);
 

-  HBYTES(o)->start= startbytes;
-  HBYTES(o)->end= bytes;
+  HBYTES(o).start= startbytes;
+  HBYTES(o).end= bytes;

   o->typePtr = &hbytes_type;
   return TCL_OK;
 }
   o->typePtr = &hbytes_type;
   return TCL_OK;
 }


@@ -91,48 +96,24 @@ Tcl_ObjType hbytes_type = {
   hbytes_t_free, hbytes_t_dup, hbytes_t_ustr, hbytes_t_sfa
 };
 
   hbytes_t_free, hbytes_t_dup, hbytes_t_ustr, hbytes_t_sfa
 };
 

-static Tcl_Obj *hb_getvar(Tcl_Interp *ip, Tcl_Obj *varname) {
-  int ec;
-  Tcl_Obj *value;
-  
-  value= Tcl_ObjGetVar2(ip,varname,0,TCL_LEAVE_ERR_MSG);
-  if (!value) return 0;
-
-  ec= Tcl_ConvertToType(ip,value,&hbytes_type);
-  if (ec) return 0;
-
-  return value;
-}
-
-HC_DEFINE(raw2h) {
-  HC_DECLS;
-  Tcl_Obj *raw, *value;
+int do_hbytes_raw2h(ClientData cd, Tcl_Interp *ip,
+                   Tcl_Obj *binary, HBytes_Value *result) {

   const char *str;
   int l;
 
   const char *str;
   int l;
 

-  HC_ARG_O(raw);
-  HC_ARGS_E;
-  str= Tcl_GetStringFromObj(raw,&l);
-  value= hbytes_set(0,str,l);
-  Tcl_SetObjResult(ip,value);
-  HC_FINI;
+  str= Tcl_GetStringFromObj(binary,&l);
+  hbytes_set(result, str, l);
+  return TCL_OK;

 }
 
 }
 

-HC_DEFINE(h2raw) {
-  Tcl_Obj *value, *result;
-  
-  HC_ARG_H(value);
-  HC_ARGS_E;
-  result= Tcl_NewStringObj(HBYTES(value)->start, HBYTES_LEN(value));
-  Tcl_SetObjResult(ip,result);
-  HC_FINI;
+int do_hbytes_h2raw(ClientData cd, Tcl_Interp *ip,
+                   HBytes_Value hex, Tcl_Obj **result) {
+  *result= Tcl_NewStringObj(hex.start, HBYTES_LEN(hex));
+  return TCL_OK;

 }
 
 }
 

+#if 0

 HC_DEFINE(pkcs5) {
 HC_DEFINE(pkcs5) {

-  typedef struct {
-    const char *spec;
-    int pad, algname;
-  } PadKindInfo;

   static const PadKindInfo padkindinfos[0]= {
     { "pa", 1, 1 },
     { "pn", 1, 0 },
   static const PadKindInfo padkindinfos[0]= {
     { "pa", 1, 1 },
     { "pn", 1, 0 },


@@ -157,67 +138,17 @@ HC_DEFINE(pkcs5) {
 
   HC_FINI_HBV;
 }
 
   HC_FINI_HBV;
 }

-  
-static int hc_raw2h(ClientData cd, Tcl_Interp *ip, int objc,
-                   Tcl_Obj *const *objv) {
-  
-  Tcl_Obj *varname, *value, *result;
-
-  varname= objv[0];
-  switch (objc) {
-  case 1:
-    value= hb_getvar(ip,varname);  if (!value) return TCL_ERROR;
-    assert(result);
-    Tcl_SetObjResult(ip,result);
-    return TCL_OK;
-  case 2:
-    value= objv[1];
-      HC_MINARGS(1);
-
-    value= Tcl_ObjSetVar2(ip,varname,0, value, TCL_LEAVE_ERR_MSG);
-    if (!value) return TCL_ERROR;
-    Tcl_ResetResult(ip);
-    return TCL_OK;
-  }
-  abort();
-}
-
-typedef struct {
-  const char *name;
-  int minargs, maxargs;
-  Tcl_ObjCmdProc *func;
-} SubCommand;
-
-#define SUBCOMMANDS                            \
-    DO(raw2h)                                  \
-    DO(h2raw)                                  \
-    DO(pkcs5)
-
-static const SubCommand subcommands[] = {
-#define DO(c) { #c, hc_##c },
-  SUBCOMMANDS
-  { 0 }
-};
+#endif

 
 

-static int hb_proc(ClientData cd, Tcl_Interp *ip, int objc,
-                  Tcl_Obj *const *objv) {
-  const SubCommand *sc;
-
-  if (objc<2) return staticerr(ip, "hbytes: need subcommand");
-  sc= enum_lookup_cached(ip,objv[1],subcommands,"hbytes subcommand");
-  if (!sc) return TCL_ERROR;
-  objc -= 2;
-  objv += 2;
-  if (objc < sc->minargs)
-    return staticerr(ip, "too few args");
-  if (sc->maxargs >=0 && objc > sc->maxargs)
-    return staticerr(ip,"too many args");
-  return sc->func((void*)sc,ip,objc,objv);
+int do__hbytes(ClientData cd, Tcl_Interp *ip,
+              const ParserCommandTableEntry *subcmd,
+              int objc, Tcl_Obj *const *objv) {
+  return subcmd->func(0,ip,objc,objv);

 }
 
 int Hbytes_Init(Tcl_Interp *ip) {
   Tcl_RegisterObjType(&hbytes_type);
   Tcl_RegisterObjType(&enum_nearlytype);
 }
 
 int Hbytes_Init(Tcl_Interp *ip) {
   Tcl_RegisterObjType(&hbytes_type);
   Tcl_RegisterObjType(&enum_nearlytype);

-  Tcl_CreateObjCommand(ip,"hbytes", hb_proc,0,0);
+  Tcl_CreateObjCommand(ip,"hbytes", pa__hbytes,0,0);

   return TCL_OK;
 }
   return TCL_OK;
 }

diff --git a/hbytes/hbytes.h b/hbytes/hbytes.h
index f136758fdfe8be32f4d29235cbf45297588887c1..d4a5719eee94763cd73c77f3b8e6e021affa1168 100644 (file)
--- a/hbytes/hbytes.h
+++ b/hbytes/hbytes.h
@@ -43,7 +43,8 @@ extern Tcl_ObjType hbytes_type;
 int staticerr(Tcl_Interp *ip, const char *m);
 void objfreeir(Tcl_Obj *o);
 
 int staticerr(Tcl_Interp *ip, const char *m);
 void objfreeir(Tcl_Obj *o);
 

-Tcl_Obj *hbytes_set(Tcl_Obj *overwrite, const Byte *array, int l);
+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 enum.c */
 
 
 /* from enum.c */
 


@@ -63,10 +64,24 @@ const void *enum_lookup_cached_func(Tcl_Interp *ip, Tcl_Obj *o,
    * set to the error message.
    */
 
    * set to the error message.
    */
 

+/* from crypto.c */
+
+typedef struct {
+  int blocksize, hashsize;
+} HashAlgInfo;
+
+typedef struct {
+  int blocksize;
+} BlockCipherAlgInfo;
+
+typedef struct {
+  int dummy;
+} BlockCipherModeInfo;
+

 /* useful macros */
 
 /* useful macros */
 

-#define HBYTES(o) ((HBytes_Value*)&(o)->internalRep.twoPtrValue)
-#define HBYTES_LEN(o) (HBYTES((o))->end - HBYTES((o))->start)
+#define HBYTES(o) (*(HBytes_Value*)&(o)->internalRep.twoPtrValue)
+#define HBYTES_LEN(hb) ((hb).end - (hb).start)

 
 #define TALLOC(s) ((void*)Tcl_Alloc((s)))
 #define TFREE(f) (Tcl_Free((void*)(f)))
 
 #define TALLOC(s) ((void*)Tcl_Alloc((s)))
 #define TFREE(f) (Tcl_Free((void*)(f)))

diff --git a/hbytes/parse.c b/hbytes/parse.c
new file mode 100644 (file)
index 0000000..125dd61
--- /dev/null
+++ b/hbytes/parse.c
@@ -0,0 +1,16 @@
+  sc= enum_lookup_cached(ip,objv[1],subcommands,"hbytes subcommand");
+
+
+static Tcl_Obj *hb_getvar(Tcl_Interp *ip, Tcl_Obj *varname) {
+  int ec;
+  Tcl_Obj *value;
+  
+  value= Tcl_ObjGetVar2(ip,varname,0,TCL_LEAVE_ERR_MSG);
+  if (!value) return 0;
+
+  ec= Tcl_ConvertToType(ip,value,&hbytes_type);
+  if (ec) return 0;
+
+  return value;
+}
+