From b740135c3efcb63e0c7741384e5fa8ff229d2919 Mon Sep 17 00:00:00 2001 From: ian Date: Sat, 31 Aug 2002 15:05:15 +0000 Subject: [PATCH] all compiles again. more pat to do. --- base/chiark-tcl.h | 16 +++++++++- base/enum.c | 34 +++++++++++++++++++- base/parse.c | 68 ++++++++++++++++++++++++++++++++++------ base/tables-examples.tct | 25 ++++++++------- base/tcmdifgen | 45 ++++++++++++++------------ base/troglodyte-Makefile | 3 +- hbytes/hbytes.c | 3 +- hbytes/hbytes.h | 16 +++++++++- hbytes/parse.c | 68 ++++++++++++++++++++++++++++++++++------ 9 files changed, 223 insertions(+), 55 deletions(-) diff --git a/base/chiark-tcl.h b/base/chiark-tcl.h index d4a5719..a545ede 100644 --- 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 1a66aa3..a4e9de7 100644 --- a/base/enum.c +++ b/base/enum.c @@ -2,6 +2,8 @@ * */ +#include + #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 125dd61..14d8f99 100644 --- 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 46fb7fb..69a4fb6 100644 --- 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 3a31754..aa717d4 100755 --- 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 985975c..2972afa 100644 --- 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 d095531..626b2da 100644 --- 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 d4a5719..a545ede 100644 --- 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 125dd61..14d8f99 100644 --- 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)); +} -- 2.30.2