From 503f816f2157f764c7c93c873047aad4ca63e10d Mon Sep 17 00:00:00 2001 From: ian Date: Sun, 1 Sep 2002 17:52:14 +0000 Subject: [PATCH] Progressing. --- base/chiark-tcl.h | 6 +-- base/parse.c | 13 ++++++ base/tables-examples.tct | 88 ++++++++++++++++++++-------------------- base/tcmdifgen | 15 +++++-- base/troglodyte-Makefile | 1 + hbytes/chop.c | 59 +++++++++++++++++++++++++++ hbytes/hbytes.h | 6 +-- hbytes/parse.c | 13 ++++++ 8 files changed, 147 insertions(+), 54 deletions(-) create mode 100644 hbytes/chop.c diff --git a/base/chiark-tcl.h b/base/chiark-tcl.h index a545ede..83469d5 100644 --- 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 14d8f99..a7ac819 100644 --- 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 69a4fb6..2c6711a 100644 --- 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 aa717d4..21833c1 100755 --- 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 2972afa..0f82126 100644 --- 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 index 0000000..5d89cd2 --- /dev/null +++ b/hbytes/chop.c @@ -0,0 +1,59 @@ +/* + */ + +#include + +#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; istart= 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; iend, 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 a545ede..83469d5 100644 --- 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 14d8f99..a7ac819 100644 --- 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); +} -- 2.30.2