Better integration with tclreadline. Less recompilation of serpent.[ch].

[chiark-tcl.git] / base / tcmdifgen

diff --git a/base/tcmdifgen b/base/tcmdifgen
index 514dc019a113f50bc27db466e4b76bcc2b51830f..90f0818588b8cda4ab3b7e8ed0b861d88b3fd7f1 100755 (executable)
--- a/base/tcmdifgen
+++ b/base/tcmdifgen
@@ -162,6 +162,10 @@ foreach $c_table (sort keys %tables) {
        $any_mand= 0;
        $any_optl= 0;
        $any_eerr= 0;
+       $any_eargc= 0;
+       $pa_hint= '';
+       $pa_hint .= "$c_table " if length $c_table;
+       $pa_hint.= $c_entry;
        foreach $arg (@{ $r_entry->{A} }) {
            $n= $arg->{N};
            $t= $arg->{T};
@@ -169,18 +173,19 @@ foreach $c_table (sort keys %tables) {
            push @do_al, make_decl($n, $t, $arg->{A});
            $pa_vars .= make_decl_init("a_$n", $t, $a, \$pa_init);
            if ($arg->{O}) {
+               $pa_hint .= " ?$n?";
                if ($any_mand) {
-                   $pa_argc .= "  if (objc < $any_mand) {".
-                       " e=\"too few args\"; goto e_err; }\n";
-                   $pa_body .= "  objc -= $any_mand;\n";
                    $any_mand= 0;
                    $any_eerr= 1;
                }
                $pa_body .= "  if (!objc--) goto end_optional;\n";
                $any_optl= 1;
            } else {
-               die if $any_optl;
+               $pa_hint .= " $n";
+               $pa_body .= "  if (!objc--) goto wrong_count_args;\n";
                $any_mand++;
+               $any_eargc= 1;
+               die if $any_optl;
            }
            $paarg= "&a_$n";
            $pafin= '';
@@ -202,18 +207,15 @@ 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";
-           }
+           $pa_hint .= " ...";
            $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";
        } else {
            if (!$any_optl) {
-               $pa_argc .= "  if (objc != $any_mand) {".
-                   " e=\"wrong number of args\"; goto e_err; }\n";
-               $any_eerr= 1;
+               $pa_body .= "  if (objc) goto wrong_count_args;\n";
+               $any_eargc= 1;
            }
        }
        if ($any_optl) {
@@ -236,6 +238,12 @@ foreach $c_table (sort keys %tables) {
        $pa_rslt .= "rc_err:\n";
        
        $pa_fini .= "  return rc;\n";
+       if ($any_eargc) {
+           $pa_fini .= "\nwrong_count_args:\n";
+           $pa_fini .= "  e=\"wrong # args: should be \\\"$pa_hint\\\"\";\n";
+           $pa_fini .= "  goto e_err;";
+           $any_eerr= 1;
+       }
        if ($any_eerr) {
            $pa_vars .= "  const char *e;\n";
            $pa_fini .= "\n";