| 1 | # Written by Greg J. Badros, <gjb@cs.washington.edu> |
| 2 | # 12-Dec-1999 |
| 3 | |
| 4 | BEGIN { FS="|"; |
| 5 | dot_doc_file = ARGV[1]; ARGV[1] = "-"; |
| 6 | std_err = "/dev/stderr"; |
| 7 | # be sure to put something in the files to help make out |
| 8 | print ""; |
| 9 | printf "" > dot_doc_file; |
| 10 | } |
| 11 | |
| 12 | /^[ \t]*SCM_SNARF_INIT_START/ { copy = $0; |
| 13 | gsub(/[ \t]*SCM_SNARF_INIT_START/, "", copy); |
| 14 | gsub(/SCM_SNARF_DOC_START.*$/, "", copy); |
| 15 | print copy; } |
| 16 | |
| 17 | /SCM_SNARF_DOC_START/,/SCM_SNARF_DOCSTRING_START/ { copy = $0; |
| 18 | if (match(copy,/SCM_SNARF_DOC_STARTR/)) { registering = 1; } |
| 19 | else {registering = 0; } |
| 20 | gsub(/.*SCM_SNARF_DOC_START./,"", copy); |
| 21 | gsub(/SCM_SNARF_DOCSTRING_START.*/,"",copy); |
| 22 | gsub(/[ \t]+/," ", copy); |
| 23 | sub(/^[ \t]*/,"(", copy); |
| 24 | gsub(/\"/,"",copy); |
| 25 | sub(/\([ \t]*void[ \t]*\)/,"()", copy); |
| 26 | sub(/ \(/," ",copy); |
| 27 | numargs = gsub(/SCM /,"", copy); |
| 28 | numcommas = gsub(/,/,"", copy); |
| 29 | numactuals = $2 + $3 + $4; |
| 30 | location = $5; |
| 31 | gsub(/\"/,"",location); |
| 32 | sub(/^[ \t]*/,"",location); |
| 33 | sub(/[ \t]*$/,"",location); |
| 34 | sub(/: /,":",location); |
| 35 | # Now whittle copy down to just the $1 field |
| 36 | # (but do not use $1, since it hasn't been |
| 37 | # altered by the above regexps) |
| 38 | gsub(/[ \t]*\|.*$/,"",copy); |
| 39 | sub(/ \)/,")",copy); |
| 40 | # Now `copy' contains the nice scheme proc "prototype", e.g. |
| 41 | # (set-car! pair value) |
| 42 | # print copy > "/dev/stderr"; # for debugging |
| 43 | proc_and_args = copy; |
| 44 | curr_function_proto = copy; |
| 45 | sub(/[^ \n]* /,"",proc_and_args); |
| 46 | sub(/\)[ \t]*/,"",proc_and_args); |
| 47 | split(proc_and_args,args," "); |
| 48 | # now args is an array of the arguments |
| 49 | # args[1] is the formal name of the first argument, etc. |
| 50 | if (numargs != numactuals && !registering) |
| 51 | { print location ":*** `" copy "' is improperly registered as having " numactuals " arguments" > std_err; } |
| 52 | print "\f\n" copy (registering?")":"") > dot_doc_file ; } |
| 53 | |
| 54 | /SCM_SNARF_DOCSTRING_START/,/SCM_SNARF_DOCSTRING_END.*$/ { copy = $0; |
| 55 | gsub(/.*SCM_SNARF_DOCSTRING_START/,"",copy); |
| 56 | sub(/^[ \t]*"?/,"", copy); |
| 57 | sub(/\"?[ \t]*SCM_SNARF_DOCSTRING_END.*$/,"", copy); |
| 58 | gsub(/\\n\\n"?/,"\n",copy); |
| 59 | gsub(/\\n"?[ \t]*$/,"",copy); |
| 60 | gsub(/\\\"[ \t]*$/,"\"",copy); |
| 61 | gsub(/[ \t]*$/,"", copy); |
| 62 | if (copy != "") { print copy > dot_doc_file } |
| 63 | } |
| 64 | |
| 65 | /SCM_SNARF_DOCSTRING_END[ \t]/ { print "\ 1[" location "]" >> dot_doc_file; } |
| 66 | |
| 67 | /\*&\*&\*&\*SCM_ARG_BETTER_BE_IN_POSITION/ { copy = $0; |
| 68 | sub(/.*\*&\*&\*&\*SCM_ARG_BETTER_BE_IN_POSITION\([ \t]*/,"",copy); |
| 69 | if (copy ~ /\"/) { next } |
| 70 | gsub(/[ \t]*,[ \t]*/,":",copy); |
| 71 | sub(/[ \t]*\).*/,"",copy); |
| 72 | split(copy,argpos,":"); |
| 73 | argname = argpos[1]; |
| 74 | pos = argpos[2]; |
| 75 | if (pos ~ /[A-Za-z]/) { next } |
| 76 | if (pos ~ /^[ \t]*$/) { next } |
| 77 | if (argname ~ / /) { next } |
| 78 | line = argpos[3]; |
| 79 | # print pos " " args[pos] " vs. " argname > "/dev/stderr"; |
| 80 | if (args[pos] != argname) { print filename ":" line ":*** Argument name/number mismatch in `" curr_function_proto "' -- " argname " is not formal #" pos > "/dev/stderr"; } |
| 81 | } |