+ if ($any_eerr) {
+ $pa_vars .= " const char *e;\n";
+ $pa_fini .= "\n";
+ $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".
+ $pa_vars.
+ $pa_init.
+ $pa_argc.
+ $pa_body.
+ $pa_rslt.
+ $pa_free.
+ $pa_fini);
+ $do_decl .= join ', ', @do_al;
+ $do_decl .= ")";
+ o('h',100, $do_decl.";\n") or die $!;
+
+
+ $op_tab .= sprintf(" { %-20s %-40s%s },\n",
+ "\"$c_entry\",",
+ "pa_${c_table}_${c_entry_c}",
+ $r_entry->{I});
+ }
+ if (length $c_table) {
+ $decl= "const $x_table->{C} ".lc($x_table->{C}).'s[]';
+ o('h', 500, "extern $decl;\n");
+ o('c', 100,
+ "$decl = {\n".
+ $op_tab.
+ " { 0 }\n".
+ "};\n\n");
+ }
+}
+
+o(c, 0, "#include \"$prefix.h\"\n");
+
+o(h, 0,
+ "#ifndef INCLUDED_\U${prefix}_H\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, const char *what);\n");
+
+o(h, 999,
+ "#endif /*INCLUDED_\U${prefix}_H*/\n");
+
+if (defined $output) {
+ $oh= new IO::File "$output.tmp", 'w' or die "$output.tmp: $!\n";
+} else {
+ $oh= 'STDOUT';
+}
+
+print $oh "/* AUTOGENERATED - DO NOT EDIT */\n" or die $!;
+foreach $pr (sort keys %{ $o{$write} }) {
+ print $oh "\n" or die $!;
+ print $oh $o{$write}{$pr} or die $!;
+}
+
+die if $oh->error;
+die $! unless $oh->close;
+
+if (defined $output) {
+ rename "$output.tmp", $output or die $!;
+}
+
+sub o ($$) {
+ my ($wh,$pr,$s) = @_;
+ $o{$wh}{sprintf "%010d", $pr} .= $s;
+}
+
+sub make_decl_init ($$$$) {
+ my ($n, $t, $a, $initcode) = @_;
+ my ($o,$init);
+ $o= make_decl($n,$t,$a);
+ if (exists $type_init{$t}) {
+ $init= $type_init{$t};
+ $$initcode .= " ".subst_in("$n", $init)."\n"
+ if length $init;
+ } else {
+ $o .= ' =0';