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 */
* 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)))
--- /dev/null
+ 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;
+}
+
H-Include "hbytes.h"
+Untabled
+ hbytes
+ subcmd enum(ParserCommandTableEntry,pcmdtab_hbytes)
+ obj ...
+
Table hbytes
raw2h
binary obj
maclen int
=> hb
-#Table padmethodinfos
-# Info
-# int algname;
-#Entries
+Table padmethod
+ Of PadMethodInfo
+ pa 1, 0
+
+EntryExtra PadMethodInfo
+ int pad, algname;
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)) {
}
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;
$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";
" 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";
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.
$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");
}
}
"#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");
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 ?";
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)
*/
#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);
}
static void hbytes_t_free(Tcl_Obj *o) {
- TFREE(HBYTES(o)->start);
+ TFREE(HBYTES(o).start);
}
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) {
}
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;
}
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 },
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;
}
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 */
* 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)))
--- /dev/null
+ 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;
+}
+