diff options
-rw-r--r-- | libguile/__scm.h | 10 | ||||
-rw-r--r-- | libguile/guile-snarf.awk.in | 34 | ||||
-rw-r--r-- | libguile/ramap.c | 1 | ||||
-rw-r--r-- | libguile/random.c | 4 | ||||
-rw-r--r-- | libguile/struct.c | 4 |
5 files changed, 46 insertions, 7 deletions
diff --git a/libguile/__scm.h b/libguile/__scm.h index 0494c5286..db0d2a1af 100644 --- a/libguile/__scm.h +++ b/libguile/__scm.h @@ -449,6 +449,15 @@ extern SCM scm_apply_generic (SCM gf, SCM args); #define SCM_GASSERTn(cond, gf, args, pos, subr) \ if (!(cond)) SCM_WTA_DISPATCH_n((gf), (args), (pos), (subr)) +#ifndef SCM_MAGIC_SNARFER +/* Let these macros pass through if + we are snarfing; thus we can tell the + difference between the use of an actual + number vs. the use of one of these macros -- + actual numbers in SCM_VALIDATE_*/SCM_ASSERT + constructs must match the formal argument name, + but using SCM_ARG* avoids the test */ + #define SCM_ARGn 0 #define SCM_ARG1 1 #define SCM_ARG2 2 @@ -472,6 +481,7 @@ extern SCM scm_apply_generic (SCM gf, SCM args); /* #define SCM_STACK_OVFLOW 12 */ /* #define SCM_EXIT 13 */ +#endif /* SCM_MAGIC_SNARFER */ /* (...still matching scm_errmsgs) These * are signals. Signals may become errors diff --git a/libguile/guile-snarf.awk.in b/libguile/guile-snarf.awk.in index cb3ed40b2..da20af493 100644 --- a/libguile/guile-snarf.awk.in +++ b/libguile/guile-snarf.awk.in @@ -25,7 +25,7 @@ BEGIN { FS="|"; gsub(/[ \t]+/," ", copy); sub(/^[ \t]*/,"(", copy); gsub(/\"/,"",copy); - numargs = gsub(/\([ \t]*void[ \t]*\)/,"()", copy); + sub(/\([ \t]*void[ \t]*\)/,"()", copy); sub(/ \(/," ",copy); numargs = gsub(/SCM /,"", copy); numcommas = gsub(/,/,"", copy); @@ -35,8 +35,21 @@ BEGIN { FS="|"; sub(/^[ \t]*/,"",location); sub(/[ \t]*$/,"",location); sub(/: /,":",location); + # Now whittle copy down to just the $1 field + # (but do not use $1, since it hasn't been + # altered by the above regexps) gsub(/[ \t]*\|.*$/,"",copy); sub(/ \)/,")",copy); + # Now `copy' contains the nice scheme proc "prototype", e.g. + # (set-car! pair value) + # print copy > "/dev/stderr"; # for debugging + proc_and_args = copy; + curr_function_proto = copy; + sub(/[^ \n]* /,"",proc_and_args); + sub(/\)[ \t]*/,"",proc_and_args); + split(proc_and_args,args," "); + # now args is an array of the arguments + # args[1] is the formal name of the first argument, etc. if (numargs != numactuals && !registering) { print location ":*** `" copy "' is improperly registered as having " numactuals " arguments" > /dev/stderr; } print "\n" copy (registering?")":"") > dot_doc_file ; } @@ -47,6 +60,23 @@ BEGIN { FS="|"; sub(/\"?[ \t]*@!!!.*$/,"", copy); gsub(/\\\"/,"\"",copy); gsub(/[ \t]*$/,"", copy); - if (copy != "") { print copy > dot_doc_file } } + if (copy != "") { print copy > dot_doc_file } + } + /@!!![ \t]/ { print "[" location "]" >> dot_doc_file; } +/\*&\*&\*&\*SCM_ARG_BETTER_BE_IN_POSITION/ { copy = $0; + sub(/.*\*&\*&\*&\*SCM_ARG_BETTER_BE_IN_POSITION\([ \t]*/,"",copy); + if (copy ~ /\"/) { next } + gsub(/[ \t]*,[ \t]*/,":",copy); + sub(/[ \t]*\).*/,"",copy); + split(copy,argpos,":"); + argname = argpos[1]; + pos = argpos[2]; + if (pos ~ /[A-Za-z]/) { next } + if (pos ~ /^[ \t]*$/) { next } + if (argname ~ / /) { next } + line = argpos[3]; +# print pos " " args[pos] " vs. " argname > "/dev/stderr"; + if (args[pos] != argname) { print filename ":" line ":*** Argument name/number mismatch in `" curr_function_proto "' -- " argname " is not formal #" pos > "/dev/stderr"; } + } diff --git a/libguile/ramap.c b/libguile/ramap.c index 14c68d480..195d8c684 100644 --- a/libguile/ramap.c +++ b/libguile/ramap.c @@ -768,7 +768,6 @@ racp (SCM src, SCM dst) #endif /* SCM_FLOATS */ return 1; } -#undef FUNC_NAME /* This name is obsolete. Will go away in release 1.5. */ diff --git a/libguile/random.c b/libguile/random.c index 372ff61e0..ddcdccd37 100644 --- a/libguile/random.c +++ b/libguile/random.c @@ -380,7 +380,7 @@ GUILE_PROC (scm_copy_random_state, "copy-random-state", 0, 1, 0, { if (SCM_UNBNDP (state)) state = SCM_CDR (scm_var_random_state); - SCM_VALIDATE_RSTATE(2,state); + SCM_VALIDATE_RSTATE(1,state); return make_rstate (scm_the_rng.copy_rstate (SCM_RSTATE (state))); } #undef FUNC_NAME @@ -525,7 +525,7 @@ GUILE_PROC (scm_random_exp, "random:exp", 0, 1, 0, { if (SCM_UNBNDP (state)) state = SCM_CDR (scm_var_random_state); - SCM_VALIDATE_RSTATE(2,state); + SCM_VALIDATE_RSTATE(1,state); return scm_makdbl (scm_c_exp1 (SCM_RSTATE (state)), 0.0); } #undef FUNC_NAME diff --git a/libguile/struct.c b/libguile/struct.c index 1c039f1d5..e0aeff348 100644 --- a/libguile/struct.c +++ b/libguile/struct.c @@ -552,7 +552,7 @@ integer value small enough to fit in one machine word.") fields_desc = (unsigned char *) SCM_CHARS (layout); n_fields = data[scm_struct_i_n_words]; - SCM_ASSERT (p < n_fields, pos, SCM_OUTOFRANGE, FUNC_NAME); + SCM_ASSERT_RANGE(1,pos, p < n_fields); if (p * 2 < SCM_LENGTH (layout)) { @@ -629,7 +629,7 @@ GUILE_PROC (scm_struct_set_x, "struct-set!", 3, 0, 0, fields_desc = (unsigned char *)SCM_CHARS (layout); n_fields = data[scm_struct_i_n_words]; - SCM_ASSERT (p < n_fields, pos, SCM_OUTOFRANGE, FUNC_NAME); + SCM_ASSERT_RANGE (1,pos, p < n_fields); if (p * 2 < SCM_LENGTH (layout)) { |