From 310a482133795d0bee9621003c0a0b3813a47037 Mon Sep 17 00:00:00 2001 From: ian Date: Sat, 31 Aug 2002 14:07:04 +0000 Subject: [PATCH 1/1] Table-generated stuff. Now need parsing funcs. --- base/chiark-tcl.h | 21 ++++++- base/parse.c | 16 +++++ base/tables-examples.tct | 15 +++-- base/tcmdifgen | 115 +++++++++++++++++++++++++++------ base/troglodyte-Makefile | 4 +- hbytes/hbytes.c | 133 ++++++++++----------------------------- hbytes/hbytes.h | 21 ++++++- hbytes/parse.c | 16 +++++ 8 files changed, 210 insertions(+), 131 deletions(-) create mode 100644 base/parse.c create mode 100644 hbytes/parse.c diff --git a/base/chiark-tcl.h b/base/chiark-tcl.h index f136758..d4a5719 100644 --- 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); -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 */ @@ -63,10 +64,24 @@ const void *enum_lookup_cached_func(Tcl_Interp *ip, Tcl_Obj *o, * 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 */ -#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))) diff --git a/base/parse.c b/base/parse.c new file mode 100644 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 553f768..46fb7fb 100644 --- a/base/tables-examples.tct +++ b/base/tables-examples.tct @@ -4,6 +4,11 @@ Type hbv: HBytes_Value *@ H-Include "hbytes.h" +Untabled + hbytes + subcmd enum(ParserCommandTableEntry,pcmdtab_hbytes) + obj ... + Table hbytes raw2h binary obj @@ -53,7 +58,9 @@ Table hbytes 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 4f4d154..3a31754 100755 --- a/base/tcmdifgen +++ b/base/tcmdifgen @@ -24,6 +24,12 @@ while (@ARGV) { die "must say -w\n" if !defined $write; +sub zilch () { + undef $c_table; + undef $c_entryextra; + undef $c_of; +} + sub parse ($$) { my ($wh,$f) = @_; while (defined($_= $f->getline)) { @@ -42,12 +48,33 @@ sub parse ($$) { } if (@i==0 && m/^Table\s+(\w+)$/) { + zilch(); $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==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; @@ -94,24 +121,37 @@ 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('*', $c, "type $t"); + $decl= "int pat_$t(Tcl_Interp*, Tcl_Obj*, "; + $decl .= subst_in_decl('*', $c, "type $t"); $decl .= ", $xta", if length $xta; - $decl .= ")\n"; + $decl .= ");\n"; 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); } +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}; + $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,". - " 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_al= (); + @do_al= ('ClientData cd', 'Tcl_Interp *ip'); @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; - $any_eerr= 0; + $any_eerr= 1; } $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') { + $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"); } + $pa_body .= " rc= pat_$t(ip, *objv++, $paarg"; $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_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"; - $any_eerr= 0; + $any_eerr= 1; } 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"; - $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"; + + if (length $c_table) { + $static= 'static '; + } else { + $static= ''; + o('h',90, "$pa_decl;\n"); + } o('c',100, - "static ".$pa_decl." {\n". + $static.$pa_decl." {\n". $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 $!; + + + $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 \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"); @@ -262,9 +334,16 @@ sub make_decl ($$$) { 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 ?"; diff --git a/base/troglodyte-Makefile b/base/troglodyte-Makefile index 9c67ece..985975c 100644 --- 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) -%.c: %.tct +%.c: %.tct tcmdifgen ./tcmdifgen -wc -o$@ $< -%.h: %.tct +%.h: %.tct tcmdifgen ./tcmdifgen -wh -o$@ $< %.o: %.c $(HDRS) diff --git a/hbytes/hbytes.c b/hbytes/hbytes.c index d4a33f5..d095531 100644 --- a/hbytes/hbytes.c +++ b/hbytes/hbytes.c @@ -3,26 +3,31 @@ */ #include "hbytes.h" +#include "tables.h" 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; - - HBYTES(o)->start= np= l ? TALLOC(l) : 0; + + upd->start= np= l ? TALLOC(l) : 0; 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) { - 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); @@ -31,7 +36,7 @@ Tcl_Obj *hbytes_set(Tcl_Obj *overwrite, const Byte *array, int l) { } static void hbytes_t_free(Tcl_Obj *o) { - TFREE(HBYTES(o)->start); + TFREE(HBYTES(o).start); } 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; - 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) { @@ -80,8 +85,8 @@ fprintf(stderr,">%d|%s|%s<\n",l,os,cbuf); } 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; } @@ -91,48 +96,24 @@ Tcl_ObjType hbytes_type = { 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; - 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) { - typedef struct { - const char *spec; - int pad, algname; - } PadKindInfo; static const PadKindInfo padkindinfos[0]= { { "pa", 1, 1 }, { "pn", 1, 0 }, @@ -157,67 +138,17 @@ HC_DEFINE(pkcs5) { 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); - Tcl_CreateObjCommand(ip,"hbytes", hb_proc,0,0); + Tcl_CreateObjCommand(ip,"hbytes", pa__hbytes,0,0); return TCL_OK; } diff --git a/hbytes/hbytes.h b/hbytes/hbytes.h index f136758..d4a5719 100644 --- 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); -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 */ @@ -63,10 +64,24 @@ const void *enum_lookup_cached_func(Tcl_Interp *ip, Tcl_Obj *o, * 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 */ -#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))) diff --git a/hbytes/parse.c b/hbytes/parse.c new file mode 100644 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; +} + -- 2.30.2