Progressing.

diff --git a/base/chiark-tcl.h b/base/chiark-tcl.h
index a545edeae9f4cd949516d78dc09ef55034417724..83469d561452a45fea7d9621da212e38605cb3d5 100644 (file)
--- a/base/chiark-tcl.h
+++ b/base/chiark-tcl.h
@@ -4,9 +4,9 @@
  *  hbytes raw2h BINARY                          => hex
  *  hbytes h2raw HEX                             => binary
  *
- *  hbytes prefix VAR [VALUE ...]         = set VAR [concat VALUE ... $VAR]
- *  hbytes append VAR [VALUE ...]         = set VAR [concat $VAR VALUE ...]
- *  hbytes concat VAR [VALUE ...]         = set VAR [concat VALUE ...]
+ *  hbytes prepend VAR [VALUE ...]         = set VAR [concat VALUE ... $VAR]
+ *  hbytes append VAR [VALUE ...]          = set VAR [concat $VAR VALUE ...]
+ *  hbytes concat VAR [VALUE ...]          = set VAR [concat VALUE ...]
  *  hbytes unprepend VAR PREFIXLENGTH            => prefix (removed from VAR)
  *  hbytes unappend VAR SUFFIXLENGTH             => suffix (removed from VAR)
  *  hbytes chopto VAR NEWVARLENGTH               => suffix (removed from VAR)

diff --git a/base/parse.c b/base/parse.c
index 14d8f9906b59334ab8343e59c54d98e3d1e153cf..a7ac819c637813e78caef4991c3c46f32e2ebdf0 100644 (file)
--- a/base/parse.c
+++ b/base/parse.c
@@ -22,6 +22,10 @@ int pat_obj(Tcl_Interp *ip, Tcl_Obj *obj, Tcl_Obj **val) {
   return TCL_OK;
 }
 
+int pat_int(Tcl_Interp *ip, Tcl_Obj *obj, int *val) {
+  return Tcl_GetIntFromObj(ip, obj, val);
+}
+  
 int pat_hbv(Tcl_Interp *ip, Tcl_Obj *var, HBytes_Var *agg) {
   int rc;
   Tcl_Obj *val;
@@ -64,3 +68,12 @@ int pat_hb(Tcl_Interp *ip, Tcl_Obj *obj, HBytes_Value *val) {
 Tcl_Obj *ret_hb(Tcl_Interp *ip, HBytes_Value val) {
   return hbytes_set_obj(0, val.start, HBYTES_LEN(val));
 }
+
+Tcl_Obj *ret_obj(Tcl_Interp *ip, Tcl_Obj *val) {
+  return val;
+}
+
+void setstringresult(Tcl_Interp *ip, const char *m) {
+  Tcl_ResetResult(ip);
+  Tcl_AppendResult(ip, m, (char*)0);
+}

diff --git a/base/tables-examples.tct b/base/tables-examples.tct
index 69a4fb63b523f0fbc9a9d41a8e7a4989d5c11a8c..2c6711a07210b265442d3048fc26a5b3adc7d502 100644 (file)
--- a/base/tables-examples.tct
+++ b/base/tables-examples.tct
@@ -18,50 +18,50 @@ Table hbytes HBytes_SubCommand
        h2raw
                hex     hb
                =>      obj
-       prefix
-               v       hbv
-               str     ...
-       append
-               v       hbv
-               str     ...
-       concat
-               v       hbv
-               str     ...
-       unprepend
-               v       hbv
-               length  int
-               =>      hb
-       unappend
-               v       hbv
-               length  int
-               =>      hb
-       chopto
-               v       hbv
-               length  int
-               =>      hb
-       pkcs5
-               meth    enum(PadMethod, "hbytes pad subcommand")
-               obj     ...
-       blockcipher
-               encrypt charfrom("de","encrypt/decrypt")
-               v       hbv
-               alg     enum(BlockCipherAlgInfo, "alg")
-               mode    enum(BlockCipherModeInfo, "mode")
-               ?iv     hb
-               =>      hb
-       hash
-               alg     enum(HashAlgInfo, "hash alg")
-               message hb
-               =>      hb
-       hmac
-               alg     enum(HashAlgInfo, "hash alg for hmac")
-               message hb
-               key     hb
-               maclen  int
+       prepend
+               v       hbv
+               str     ...
+       append
+               v       hbv
+               str     ...
+       concat
+               str     ...
                =>      hb
+#      unprepend
+#              v       hbv
+#              length  int
+#              =>      hb
+#      unappend
+#              v       hbv
+#              length  int
+#              =>      hb
+#      chopto
+#              v       hbv
+#              length  int
+#              =>      hb
+#      pkcs5
+#              meth    enum(PadMethod, "hbytes pad subcommand")
+#              obj     ...
+#      blockcipher
+#              encrypt charfrom("de","encrypt/decrypt")
+#              v       hbv
+#              alg     enum(BlockCipherAlgInfo, "alg")
+#              mode    enum(BlockCipherModeInfo, "mode")
+#              ?iv     hb
+#              =>      hb
+#      hash
+#              alg     enum(HashAlgInfo, "hash alg")
+#              message hb
+#              =>      hb
+#      hmac
+#              alg     enum(HashAlgInfo, "hash alg for hmac")
+#              message hb
+#              key     hb
+#              maclen  int
+#              =>      hb
 
-Table padmethod PadMethod
-       pa      1, 0
+#Table padmethod PadMethod
+#      pa      1, 0
 
-EntryExtra PadMethod
-       int pad, algname;
+#EntryExtra PadMethod
+#      int pad, algname;

diff --git a/base/tcmdifgen b/base/tcmdifgen
index aa717d4d74b1225ba3f6c889a1e67e078c990a00..21833c1d1cdc415718eb508d313fcd813208f1e4 100755 (executable)
--- a/base/tcmdifgen
+++ b/base/tcmdifgen
@@ -36,7 +36,7 @@ sub parse ($$) {
        chomp; s/\s+$//;
        next if m/^\s*\#/;
        next if !m/\S/;
-       s/\t/ ' 'x(8-(length $`) % 8) /eg;
+       while (s/\t/ ' 'x(8 - (length $`) % 8) /e) { }
 
        s/^\s*//;
        $this_indent= length $&;
@@ -178,6 +178,7 @@ foreach $c_table (sort keys %tables) {
                $pa_body .= "  if (!objc--) goto end_optional;\n";
                $any_optl= 1;
            } else {
+               die if $any_optl;
                $any_mand++;
            }
            $paarg= "&a_$n";
@@ -200,13 +201,19 @@ foreach $c_table (sort keys %tables) {
            push @do_aa, "a_$n";
        }
        if (exists $r_entry->{V}) {
+           if ($any_mand) {
+               $pa_body .= "  objc -= $any_mand;\n";
+           }
            $va= $r_entry->{V};
            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";
+           push @do_aa, "objc+1", "objv-1";
        } else {
-           $pa_body .= "  if (--objc) { e=\"too many args\"; goto e_err; }\n";
-           $any_eerr= 1;
+           if (!$any_optl) {
+               $pa_argc .= "  if (objc != $any_mand) {".
+                   " e=\"wrong number of args\"; goto e_err; }\n";
+               $any_eerr= 1;
+           }
        }
        if ($any_optl) {
            $pa_body .= "end_optional:\n";

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

diff --git a/hbytes/chop.c b/hbytes/chop.c
new file mode 100644 (file)
index 0000000..5d89cd2
--- /dev/null
+++ b/hbytes/chop.c
@@ -0,0 +1,59 @@
+/*
+ */
+
+#include <string.h>
+
+#include "hbytes.h"
+
+static int strs(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);
+    if (rc) return rc;
+    l += HBYTES_LEN(HBYTES(strv[i]));
+  }
+  *l_r= l;
+  return TCL_OK;
+}
+
+int app_pre(ClientData cd, Tcl_Interp *ip, int begin,
+           HBytes_Var v, int strc, Tcl_Obj *const *strv) {
+  int ol, rc, al, i, tl;
+
+  rc= strs(ip,strc,strv,&al);  if (rc) return rc;
+
+  ol= HBYTES_LEN(*v.hb);
+  v.hb->start= v.hb->end= Tcl_Realloc(v.hb->start, ol + al);
+
+  if (begin) v.hb->end += ol;
+  else memmove(v.hb->start + al, v.hb->start, ol);
+  
+  for (i=1; i<strc; i++) {
+    tl= HBYTES_LEN(HBYTES(strv[i]));
+    memcpy(v.hb->end, HBYTES(strv[i]).start, tl);
+    v.hb->end += tl;
+  }
+  return TCL_OK;
+}  
+
+int do_hbytes_append(ClientData cd, Tcl_Interp *ip,
+                    HBytes_Var v, int strc, Tcl_Obj *const *strv) {
+  return app_pre(cd,ip,1,v,strc,strv);
+}
+  
+int do_hbytes_prepend(ClientData cd, Tcl_Interp *ip,
+                     HBytes_Var v, int strc, Tcl_Obj *const *strv) {
+  return app_pre(cd,ip,0,v,strc,strv);
+}
+
+int do_hbytes_concat(ClientData cd, Tcl_Interp *ip,
+                    int strc, Tcl_Obj *const *strv, HBytes_Value *result) {
+  HBytes_Var fake;
+  
+  result->start= result->end= 0;
+  fake.hb= result;
+  return app_pre(cd,ip,1,fake,strc,strv);
+}
+

diff --git a/hbytes/hbytes.h b/hbytes/hbytes.h
index a545edeae9f4cd949516d78dc09ef55034417724..83469d561452a45fea7d9621da212e38605cb3d5 100644 (file)
--- a/hbytes/hbytes.h
+++ b/hbytes/hbytes.h
@@ -4,9 +4,9 @@
  *  hbytes raw2h BINARY                          => hex
  *  hbytes h2raw HEX                             => binary
  *
- *  hbytes prefix VAR [VALUE ...]         = set VAR [concat VALUE ... $VAR]
- *  hbytes append VAR [VALUE ...]         = set VAR [concat $VAR VALUE ...]
- *  hbytes concat VAR [VALUE ...]         = set VAR [concat VALUE ...]
+ *  hbytes prepend VAR [VALUE ...]         = set VAR [concat VALUE ... $VAR]
+ *  hbytes append VAR [VALUE ...]          = set VAR [concat $VAR VALUE ...]
+ *  hbytes concat VAR [VALUE ...]          = set VAR [concat VALUE ...]
  *  hbytes unprepend VAR PREFIXLENGTH            => prefix (removed from VAR)
  *  hbytes unappend VAR SUFFIXLENGTH             => suffix (removed from VAR)
  *  hbytes chopto VAR NEWVARLENGTH               => suffix (removed from VAR)

diff --git a/hbytes/parse.c b/hbytes/parse.c
index 14d8f9906b59334ab8343e59c54d98e3d1e153cf..a7ac819c637813e78caef4991c3c46f32e2ebdf0 100644 (file)
--- a/hbytes/parse.c
+++ b/hbytes/parse.c
@@ -22,6 +22,10 @@ int pat_obj(Tcl_Interp *ip, Tcl_Obj *obj, Tcl_Obj **val) {
   return TCL_OK;
 }
 
+int pat_int(Tcl_Interp *ip, Tcl_Obj *obj, int *val) {
+  return Tcl_GetIntFromObj(ip, obj, val);
+}
+  
 int pat_hbv(Tcl_Interp *ip, Tcl_Obj *var, HBytes_Var *agg) {
   int rc;
   Tcl_Obj *val;
@@ -64,3 +68,12 @@ int pat_hb(Tcl_Interp *ip, Tcl_Obj *obj, HBytes_Value *val) {
 Tcl_Obj *ret_hb(Tcl_Interp *ip, HBytes_Value val) {
   return hbytes_set_obj(0, val.start, HBYTES_LEN(val));
 }
+
+Tcl_Obj *ret_obj(Tcl_Interp *ip, Tcl_Obj *val) {
+  return val;
+}
+
+void setstringresult(Tcl_Interp *ip, const char *m) {
+  Tcl_ResetResult(ip);
+  Tcl_AppendResult(ip, m, (char*)0);
+}