1 /* $Id: ftnchek.c,v 1.47 2004/12/29 19:27:25 moniot Exp $
2
3 Main program for Fortran Syntax Checker.
4 */
5
6 /*
7
8
9 Copyright (c) 2001 by Robert K. Moniot.
10
11 Permission is hereby granted, free of charge, to any person
12 obtaining a copy of this software and associated documentation
13 files (the "Software"), to deal in the Software without
14 restriction, including without limitation the rights to use,
15 copy, modify, merge, publish, distribute, sublicense, and/or
16 sell copies of the Software, and to permit persons to whom the
17 Software is furnished to do so, subject to the following
18 conditions:
19
20 The above copyright notice and this permission notice shall be
21 included in all copies or substantial portions of the
22 Software.
23
24 THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY
25 KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE
26 WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
27 PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR
28 COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
29 LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR
30 OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
31 SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
32
33 Acknowledgement: the above permission notice is what is known
34 as the "MIT License."
35 */
36
37
38
39 /*
40 Top-level input/output is done here: opening and closing files,
41 and printing error, warning, and informational messages.
42
43 Shared functions defined:
44 print_a_line() Prints source code line.
45 yyerror() Error messages from yyparse and elsewhere.
46 syntax_error() Error messages with line and column num.
47 warning() Warning messages.
48 nonportable() Portability warnings.
49 wrapup() Look at cross references, etc.
50 */
51
52 #include <stdio.h>
53 #include <string.h>
54 #if HAVE_STRINGS_H
55 #include <strings.h> /* we use strncasecmp */
56 #endif
57 #include <ctype.h>
58 #ifdef DEVELOPMENT /* For maintaining the program */
59 #define DEBUG_SIZES
60 #endif
61 #define MAIN
62 #include "ftnchek.h"
63 #include "intrins.h"
64 #include "options.h"
65 #include "utils.h" /* we use strncasecmp */
66
67 #ifdef VMS
68 #define unlink(s) remove(s)
69 #else
70 #if HAVE_UNISTD_H
71 #include <unistd.h>
72 #else
73 #ifndef __LCC__ /* The LCC compiler doesn't like the following defn. */
74 PROTO( int unlink,( const char *pathname ) );
75 #endif
76 #endif
77 #endif
78
79 #ifdef USE_SHELL_MUNG
80 PROTO( int shell_mung, (int * argc_p, char *** argv_p,
81 int parameter_number, char * option_string));
82 #endif
83
84 PROTO(PRIVATE char * append_extension,( char *s, const char *ext, int mode ));
85
86 PROTO(PRIVATE void error_summary,( char *fname ));
87
88 PROTO(int main,( int argc, char *argv[] ));
89
90 PROTO(PRIVATE char * new_ext,( char *s, const char *ext ));
91
92 PROTO(PRIVATE void open_outfile,( char *s ));
93
94 PROTO(PRIVATE void do_preps,( void ));
95
96 #ifdef DEBUG_SIZES
97 PROTO(extern void print_sizeofs,( void )); /* in symtab.c */
98 #endif
99
100 PROTO(PRIVATE void print_version_number,( void ));
101
102 PROTO(PRIVATE void resource_summary,( void ));
103
104 PROTO(PRIVATE void src_file_in,( char *infile ));
105
106 PROTO(PRIVATE void wrapup,( void ));
107
108 PRIVATE int project_file_input; /* true if input is from .prj file */
109
110 #ifdef DEBUG_SIZES
111 PRIVATE unsigned long intrins_clashes;
112 #endif
113 /* count of intrinsic hashtable clashes */
114 #ifdef COUNT_REHASHES
115 extern unsigned long rehash_count; /* count of calls to rehash() */
116 #endif
117
118
119 PRIVATE int checks_on=TRUE; /* Keep track whether -nocheck was given */
120
121 PRIVATE char *dclfile;
122 int
123 #if HAVE_STDC
main(int argc,char ** argv)124 main(int argc, char **argv)
125 #else /* K&R style */
126 main(argc,argv)
127 int argc;
128 char *argv[];
129 #endif /* HAVE_STDC */
130 {
131 int iarg;
132 int filecount=0;
133 char *infile,*srcfile,*projfile;
134
135 /* The shell_mung routine from GNU can be
136 used to expand wildcards etc. for VMS.
137 */
138 #ifdef USE_SHELL_MUNG
139 shell_mung(&argc,&argv,1,NULL);
140 #endif
141
142 #ifdef __EMX__ /* MSDOS and OS/2 emx version: expand wildcards */
143 /* by Michael.Taeschner@dlr.de */
144 _wildcard(&argc,&argv);
145 #endif
146
147 list_fd = stdout;
148 project_fd = (FILE *) NULL;
149 error_count = 0;
150 warning_count = 0;
151 include_path_list = (IncludePathNode*) NULL;
152 doing_wrapup = doing_end_proc = FALSE;
153
154 get_env_options(); /* Pick up options from environment */
155 get_rc_options(); /* Pick up options from "rc" file */
156
157 init_tables(); /* Initialize tables */
158 init_keyhashtab();
159 #ifdef DEBUG_SIZES
160 intrins_clashes =
161 #else
162 (void)
163 #endif
164 init_intrins_hashtab();
165 init_globals();
166 init_symtab();
167
168 for(iarg=1; iarg < argc; iarg++) {
169
170 int argchar=0;/* location of start of option */
171 /* Note to maintainer: since the /option version
172 has a loop here instead of an if, do not
173 use continue but goto next_arg for skipping
174 to the next argument. This is a mess, isn't it?
175 */
176 #ifdef OPTION_PREFIX_SLASH
177 do { /* loop on flags within argv[iarg] */
178 #endif
179 if( argv[iarg][argchar] == '-'
180 #ifdef OPTION_PREFIX_SLASH
181 || argv[iarg][argchar] == '/' /* Allow VMS /option form */
182 #endif
183 ) {
184 /* Process flags here */
185
186 set_option(&argv[iarg][argchar],"commandline");
187
188 /* Handle -version, -help, or -f77=help */
189 if(print_version) goto do_action;
190
191 if(help_screen) goto do_action;
192
193 /* Allow checking to be turned off */
194 if( !do_check && checks_on ) {
195 turn_off_checks();
196 checks_on = FALSE; /* remember it was done */
197 }
198
199 }
200 else if(strcmp(&argv[iarg][argchar],"?") == 0) {
201 help_screen = TRUE;
202 goto do_action;
203 }/*end of processing options*/
204
205 else { /* Process file arguments */
206 do_action:
207
208 if( must_open_outfile )
209 open_outfile(out_fname);
210
211 if(actioncount == 0) {
212 print_version_number();
213 }
214 ++actioncount; /* Cause exit w/o reading stdin below */
215
216 /* Honor -version, -help and -f77=help options */
217 if(print_version) {
218 print_version = FALSE;
219 goto next_arg;
220 }
221
222 if(help_screen) {
223 help_screen = FALSE;
224 list_options(list_fd);
225 }
226 else { /* Process files here */
227
228 if(filecount == 0)
229 do_preps(); /* Any preparations needed before processing */
230
231 ++filecount;
232
233 srcfile = add_ext(&argv[iarg][argchar],DEF_SRC_EXTENSION);
234 projfile = new_ext(&argv[iarg][argchar],DEF_PROJ_EXTENSION);
235 dclfile = new_ext(&argv[iarg][argchar],DEF_DCL_EXTENSION);
236 html_filename = new_ext(&argv[iarg][argchar],DEF_HTML_EXTENSION);
237 #ifdef VCG_SUPPORT
238 /* Initialize main_filename to 1st file arg */
239 if(main_filename == (char *)NULL)
240 main_filename = argv[iarg];
241 #endif
242 /* Project file mode: open source for reading
243 and .prj file for writing. */
244 if(make_project_file) {
245
246 infile = srcfile;
247
248 if( has_extension(infile,DEF_PROJ_EXTENSION) ) {
249 (void)fprintf(stderr,
250 "Input from %s disallowed in project mode\n",infile);
251 goto next_arg;
252 }
253
254 if( (input_fd = fopen(infile,"r")) == (FILE *)NULL ) {
255 (void)fprintf(stderr,"Cannot open file %s\n",infile);
256 goto next_arg;
257 }
258
259 project_fd = fopen(projfile,"w");
260 project_file_input = FALSE;
261 }
262 else {
263 /* Non project file mode: if input file extension
264 given, use it. Otherwise read project file
265 if it exists else read source file. */
266 if( &argv[iarg][argchar]==srcfile
267 || (input_fd = fopen(projfile,"r")) == (FILE *)NULL) {
268 infile = srcfile;
269 if( (input_fd = fopen(infile,"r")) == (FILE *)NULL ) {
270 (void)fflush(list_fd);
271 (void)fprintf(stderr,"Cannot open file %s\n",infile);
272 goto next_arg;
273 }
274 project_file_input =
275 has_extension(infile,DEF_PROJ_EXTENSION);
276 }
277 else {
278 infile = projfile;
279 project_file_input = TRUE;
280 }
281 }
282
283 /* now that we have a source file, try to open the
284 declaration file */
285 dcl_fd = (ANY_DCL_DECLARATIONS() && ! project_file_input) ?
286 fopen(dclfile,"w") : (FILE*)NULL;
287
288
289 /* Create html tree file if requested */
290 if ( ANY_HTML_DECLARATIONS() && htmlcalltree_filename == NULL &&
291 print_call_tree && ! project_file_input )
292 {
293 /*
294 * for lack of a better place, create CallTree.html in the
295 * local directory
296 */
297 htmlcalltree_filename = "CallTree.html";
298 htmlcalltree_fd = fopen( htmlcalltree_filename, "w" );
299 (void)fprintf( htmlcalltree_fd,
300 "<HTML>\n<HEAD><TITLE>Program Call Tree</TITLE></HEAD>\n<BODY>\n<pre>" );
301 }
302
303 /* Create an html output file if requested */
304 html_fd = ( ANY_HTML_DECLARATIONS() && ! project_file_input ) ?
305 fopen( html_filename, "w" ) : (FILE *)NULL;
306 if ( html_fd )
307 fprintf( html_fd,
308 "<HTML>\n<HEAD><TITLE>Source %s</TITLE></HEAD>\n<BODY>\n",
309 srcfile );
310
311 /* Always print input .f file name. If
312 verbose mode, print .prj file names too.
313 */
314 if(!quiet || !project_file_input)
315 (void)fprintf(list_fd,"\nFile %s:%s",
316 infile,
317 full_output?"\n":""
318 );
319
320 /* In verbose mode, print .prj output
321 file name to stderr. Always print
322 error message if couldn't open it. */
323 if( make_project_file ) {
324 if(project_fd != (FILE *)NULL) {
325 if(!quiet) {
326 (void)fflush(list_fd);
327 (void)fprintf(stderr,
328 "\nProject file is %s\n",projfile);
329 }
330 }
331 else {
332 (void)fflush(list_fd);
333 (void)fprintf(stderr,
334 "\nCannot open %s for output\n",projfile);
335 }
336 }
337
338
339 if(project_file_input) {
340
341 current_filename = projfile;
342 proj_file_in(input_fd);
343
344 }
345 else {
346
347 src_file_in(infile);
348
349 }
350
351 }/*end processing file args*/
352 }
353 next_arg:
354 #ifdef OPTION_PREFIX_SLASH
355 /* Here we allow /opts to be stuck together */
356 while(argv[iarg][++argchar] != '\0'
357 && argv[iarg][argchar] != '/') /* look for next opt */
358 continue;
359
360 } while(argv[iarg][argchar] != '\0'); /*end do-while*/
361 #else
362 continue;
363 #endif
364 } /* end for-loop on argument list */
365
366
367 /* No files given: read stdin */
368 if(actioncount == 0) {
369
370 print_version_number();
371
372 if( must_open_outfile )
373 open_outfile(out_fname);
374
375 do_preps(); /* Any preparations needed before processing */
376
377 if(make_project_file) {
378 projfile = STDIN_PROJ_FILENAME;
379 if( (project_fd = fopen(projfile,"w")) == (FILE *)NULL) {
380 (void)fflush(list_fd);
381 (void)fprintf(stderr,
382 "\nCannot open %s for output\n",projfile);
383 }
384 else {
385 if(!quiet) {
386 (void)fflush(list_fd);
387 (void)fprintf(stderr,
388 "\nProject file is %s\n",projfile);
389 }
390 }
391 }
392
393 ++filecount;
394 input_fd = stdin;
395
396 src_file_in("std_input");
397 }
398 if(filecount > 0) {
399 wrapup();
400 (void)fprintf(list_fd,"\n");
401 }
402
403 if(show_resources)
404 resource_summary();
405
406 exit(0);
407 return 0;/*NOTREACHED*/
408 }
409
410 /* do_preps does anything necessary prior
411 to processing 1st file, such as setting
412 the intrinsic function options. It is
413 only called once.
414 */
415 PRIVATE void
do_preps(VOID)416 do_preps(VOID)
417 {
418
419 init_typesizes(); /* Put -wordsize and -pointersize into effect */
420
421 #ifndef STANDARD_INTRINSICS
422 set_intrinsic_options(); /* Make intrinsic table match -intrinsic setting */
423 #endif
424 }
425
426 PRIVATE void
427 #if HAVE_STDC
src_file_in(char * infile)428 src_file_in(char *infile)
429 /* input filename */
430 #else /* K&R style */
431 src_file_in(infile)
432 char *infile; /* input filename */
433 #endif /* HAVE_STDC */
434 {
435 note_filename(infile);
436
437 make_legal_char_list();
438 init_scan();
439 init_parser();
440
441 (void) yyparse();
442
443 finish_scan();
444
445 if(make_project_file) {
446 proj_file_out(project_fd);
447 (void) fclose(project_fd);
448 }
449
450 if ( html_fd != (FILE *) NULL )
451 {
452 fputs( "</BODY>\n</HTML>\n", html_fd );
453 (void) fclose( html_fd );
454 html_fd = NULL;
455 }
456
457 if ((dcl_declarations) && (dcl_fd != stdout))
458 {
459
460 if (ftell(dcl_fd) == 0L) /* delete an empty .dcl file */
461 {
462 /* some systems like OS/2 lock open files and can't */
463 /* remove an open file unless closed. SAD-10/96 */
464 (void) fclose(dcl_fd); /* close file */
465 (void) unlink(dclfile);
466 }
467 else {
468 (void) fclose(dcl_fd);
469 }
470 }
471
472 if(port_tabs && (tab_filename != (char *)NULL)) {
473 if(! quiet)
474 (void)fprintf(list_fd,"\n");
475 if(tab_filename != top_filename) {
476 nonportable(NO_LINE_NUM,NO_COL_NUM,
477 "Included file");
478 msg_tail(tab_filename);
479 }
480 else {
481 nonportable(NO_LINE_NUM,NO_COL_NUM,
482 "File");
483 }
484 msg_tail("contains tabs");
485 }
486
487 error_summary(infile);
488 }
489
490 PRIVATE void
print_version_number(VOID)491 print_version_number(VOID)
492 {
493 if((full_output || !quiet) && !print_version)
494 (void)fprintf(list_fd,"\n");
495 (void)fprintf(list_fd,"%s",VERSION_NUMBER);
496 if(help_screen || print_version)
497 (void)fprintf(list_fd," %s",PATCHLEVEL);
498 if(full_output || !quiet || print_version)
499 (void)fprintf(list_fd,"\n");
500 }
501
502 PRIVATE void
503 #if HAVE_STDC
error_summary(char * fname)504 error_summary(char *fname) /* Print out count of errors in file */
505 #else /* K&R style */
506 error_summary(fname) /* Print out count of errors in file */
507 char *fname;
508 #endif /* HAVE_STDC */
509 {
510 FILE *fd = list_fd;
511
512 if(full_output ||
513 (!quiet && error_count+warning_count != 0))
514 (void)fprintf(fd,"\n");
515
516 if(full_output || !quiet || error_count != 0)
517 (void)fprintf(fd,"\n %u syntax error%s detected in file %s",
518 error_count, error_count==1? "":"s",
519 fname);
520
521 if(warning_count != 0)
522 (void)fprintf(fd,"\n %u warning%s issued in file %s",
523 warning_count, warning_count==1? "":"s",
524 fname);
525
526 if(full_output ||
527 (!quiet && error_count+warning_count != 0))
528 (void)fprintf(fd,"\n");
529
530 error_count = 0;
531 warning_count = 0;
532 }
533
534 void
535 #if HAVE_STDC
print_a_line(FILE * fd,const char * line,LINENO_t num)536 print_a_line(FILE *fd, const char *line, LINENO_t num) /* Print source line with line number */
537 #else /* K&R style */
538 print_a_line(fd,line,num) /* Print source line with line number */
539 FILE *fd;
540 char *line;
541 LINENO_t num;
542 #endif /* HAVE_STDC */
543 {
544 (void)fprintf(fd,"\n %6u ",num); /* Print line number */
545
546 /* Tab-formatted source lines: tab in
547 col 1-6 moves to col 7. */
548 if(source_dec_tab) {
549 int i,col;
550 for(i=0,col=1; col < 7 && line[i] != '\0'; i++) {
551 if(line[i] == '\t') {
552 do{
553 (void)fprintf(fd," ");
554 } while(++col < 7);
555 }
556 else {
557 (void)fprintf(fd,"%c",line[i]);
558 ++col;
559 }
560 }
561 (void)fprintf(fd,"%s",line+i);
562 }
563 else
564 (void)fprintf(fd,"%s",line);
565 }
566
567
568
569
570 PRIVATE void
571 #if HAVE_STDC
open_outfile(char * s)572 open_outfile(char *s) /* open the output file for listing */
573 #else /* K&R style */
574 open_outfile(s) /* open the output file for listing */
575 char *s;
576 #endif /* HAVE_STDC */
577 {
578 char *fullname; /* given name plus extension */
579 FILE *fd;
580
581 must_open_outfile = FALSE; /* Turn off the flag */
582
583 if(s == (char *) NULL || *s == '\0') {
584 return; /* No filename: no action */
585 }
586
587 fullname = add_ext(s,DEF_LIST_EXTENSION);
588 (void)fflush(list_fd);
589 if( (fd = fopen(fullname,"w")) == (FILE *)NULL) {
590 (void)fprintf(stderr,"\nCannot open %s for output\n",fullname);
591 }
592 else {
593 (void)fprintf(stderr,"\nOutput sent to file %s\n",fullname);
594 list_fd = fd;
595 }
596 }
597
598
599 PRIVATE void
wrapup(VOID)600 wrapup(VOID) /* look at cross references, etc. */
601 {
602
603 doing_wrapup = TRUE; /* for correct behavior in oldstyle_error_message */
604
605 if(debug_hashtab || debug_glob_symtab)
606 debug_symtabs();
607
608 /* VCG output file uses stem of file
609 containing main prog or 1st file on
610 command line. If none, output is to stdout.
611 */
612 #ifdef VCG_SUPPORT
613 if(print_vcg_list) {
614 vcg_fd = (input_fd == stdin || main_filename == (char *)NULL)?
615 stdout :
616 fopen(new_ext(main_filename,DEF_VCG_EXTENSION) ,"w");
617 }
618 #endif
619
620 visit_children(); /* Make call tree & check visited status */
621 check_com_usage(); /* Look for unused common stuff */
622 check_comlists(); /* Look for common block mismatches */
623 check_arglists(); /* Look for subprog defn/call mismatches */
624
625 if ( htmlcalltree_fd )
626 {
627 (void)fprintf( htmlcalltree_fd, "</pre>\n</body>\n</html>\n" );
628 fclose( htmlcalltree_fd );
629 htmlcalltree_fd = NULL;
630 }
631 #ifdef DEBUG_GLOBAL_STRINGS
632 if(debug_latest)
633 print_global_strings();
634 #endif
635 }
636
637
638 #define MODE_DEFAULT_EXT 1
639 #define MODE_REPLACE_EXT 2
640 PRIVATE char *
641 #if HAVE_STDC
append_extension(char * s,const char * ext,int mode)642 append_extension(char *s, const char *ext, int mode)
643 #else /* K&R style */
644 append_extension(s,ext,mode)
645 char *s,*ext;
646 int mode;
647 #endif /* HAVE_STDC */
648 {
649 /* MODE_DEFAULT_EXT: Adds extension to file name s if
650 none is present, and returns a pointer to the
651 new name. If extension was added, space is allocated
652 for the new name. If not, simply returns pointer
653 to original name. MODE_REPLACE_EXT: same, except given
654 extension replaces given one if any.
655 */
656 int i,len;
657 char *newname;
658 #ifdef OPTION_PREFIX_SLASH /* set len=chars to NUL or start of /opt */
659 for(len=0; s[len] != '\0' && s[len] != '/'; len++)
660 continue;
661 #else
662 len=(unsigned)strlen(s);
663 #endif
664 /* Search backwards till find the dot, but do not
665 search past directory delimiter
666 */
667 for(i=len-1; i>0; i--) {
668 if(s[i] == '.'
669 #ifdef UNIX
670 || s[i] == '/'
671 #endif
672 #ifdef VMS
673 || s[i] == ']' || s[i] == ':'
674 #endif
675 #ifdef MSDOS
676 || s[i] == '\\' || s[i] == ':'
677 #endif
678 )
679 break;
680 }
681
682 if(mode == MODE_REPLACE_EXT) {
683 if(s[i] == '.') /* declare length = up to the dot */
684 len = i;
685 newname = (char *) malloc( (unsigned)(len+(unsigned)strlen(ext)+1) );
686 (void)strncpy(newname,s,len);
687 (void)strcpy(newname+len,ext);
688 }
689 else { /* MODE_DEFAULT_EXT */
690 #ifdef OPTION_PREFIX_SLASH
691 /* create new string if new ext or trailing /option */
692 if(s[i] != '.' || s[len] != '\0') {
693 if(s[i] != '.') { /* no extension given */
694 newname = (char *) malloc( (unsigned)(len+
695 (unsigned)strlen(ext)+1) );
696 (void)strncpy(newname,s,len);
697 (void)strcpy(newname+len,ext);
698 }
699 else { /* extension given but /option follows */
700 newname = (char *) malloc( (unsigned)(len+1) );
701 (void)strncpy(newname,s,len);
702 }
703 }
704 #else
705 if(s[i] != '.') {
706 newname = (char *) malloc( (unsigned)(len+
707 (unsigned)strlen(ext)+1) );
708 (void)strcpy(newname,s);
709 (void)strcat(newname,ext);
710 }
711 #endif
712 else {
713 newname = s; /* use as is */
714 }
715 }
716
717 return newname;
718 }
719
720 /* Adds default extension to source file name, replacing
721 any that is present, and returns a pointer to the
722 new name. Space is allocated for the new name.
723 */
724 char *
725 #if HAVE_STDC
add_ext(char * s,const char * ext)726 add_ext(char *s, const char *ext) /* adds default filename extension to s */
727 #else /* K&R style */
728 add_ext(s,ext) /* adds default filename extension to s */
729 char *s,*ext;
730 #endif /* HAVE_STDC */
731 {
732 return append_extension(s,ext,MODE_DEFAULT_EXT);
733 }
734
735 PRIVATE char *
736 #if HAVE_STDC
new_ext(char * s,const char * ext)737 new_ext(char *s, const char *ext)
738 #else /* K&R style */
739 new_ext(s,ext)
740 char *s,*ext;
741 #endif /* HAVE_STDC */
742 {
743 return append_extension(s,ext,MODE_REPLACE_EXT);
744 }
745
746
747 int
748 #if HAVE_STDC
has_extension(const char * name,const char * ext)749 has_extension(const char *name, const char *ext) /* true if name ends in ext */
750 #else /* K&R style */
751 has_extension(name,ext) /* true if name ends in ext */
752 char *name,*ext;
753 #endif /* HAVE_STDC */
754 {
755 unsigned name_len, ext_len;
756 int stem_len;
757 ext_len = strlen(ext);
758
759 #ifdef VMS /* shell_glob adds version number: filename.ext;1 */
760 if(strrchr(name,';') != (char *)NULL) {
761 name_len = strrchr(name,';') - name; /* distance to the semicolon */
762 }
763 else
764 #endif
765 name_len=strlen(name); /* distance to the null */
766
767 stem_len = (unsigned)(name_len - ext_len); /* distance to the dot */
768
769 if( stem_len >= 0 &&
770 (name_len-stem_len) == ext_len &&
771 strncasecmp(name+stem_len,ext,ext_len) == 0 )
772 return TRUE;
773 else
774 return FALSE;
775 }
776
777
778 PRIVATE void
resource_summary(VOID)779 resource_summary(VOID)
780 {
781 #ifdef DEBUG_SIZES
782 if(debug_latest)
783 print_sizeofs(); /* give sizeof various things */
784 #endif
785
786 (void)fprintf(list_fd,
787 "\n Here are the amounts of ftnchek's resources that were used:\n");
788
789 (void)fprintf(list_fd,
790 "\nSource lines processed = %lu statement + %lu comment = %lu total",
791 tot_stmt_line_count,
792 tot_line_count-tot_stmt_line_count, /*tot_comment_line_count*/
793 tot_line_count);
794
795 (void)fprintf(list_fd,
796 "\nTotal executable statements = %lu, max in any module = %lu",
797 tot_exec_stmt_count,
798 max_exec_stmt_count);
799
800 (void)fprintf(list_fd,
801 "\nTotal number of modules in program = %lu",
802 tot_module_count);
803
804 (void)fprintf(list_fd,
805 "\nTotal statement labels defined = %lu, max in any module = %lu",
806 tot_label_count, max_labels);
807
808 (void)fprintf(list_fd,
809 "\nMax identifier name chars used = %lu local, %lu global, chunk size %lu",
810 max_loc_strings,
811 glob_strings_used,
812 (unsigned long)STRSPACESZ);
813 (void)fprintf(list_fd,
814 "\nMax token text chars used = %lu, chunk size %lu ",
815 max_srctextspace,
816 (unsigned long)STRSPACESZ);
817 (void)fprintf(list_fd,
818 "\nMax local symbols used = %lu out of %lu available",
819 max_loc_symtab,
820 (unsigned long)LOCSYMTABSZ);
821 (void)fprintf(list_fd,
822 "\nMax global symbols used = %lu out of %lu available",
823 max_glob_symtab,
824 (unsigned long)GLOBSYMTABSZ);
825 (void)fprintf(list_fd,
826 "\nMax number of parameter info fields used = %lu, chunk size = %lu",
827 max_paraminfo,
828 (unsigned long)PARAMINFOSPACESZ);
829 (void)fprintf(list_fd,
830 "\nMax number of tokenlists used = %lu, chunk size = %lu",
831 max_tokenlists,
832 (unsigned long)TOKHEADSPACESZ);
833 (void)fprintf(list_fd,
834 "\nMax token list/tree space used = %lu, chunk size = %lu",
835 max_token_space,
836 (unsigned long)TOKENSPACESZ);
837 (void)fprintf(list_fd,
838 "\nNumber of subprogram invocations = %lu totaling %lu args",
839 arglist_head_used,
840 arglist_element_used);
841 (void)fprintf(list_fd,
842 "\nArgument list header and element chunk sizes = %lu and %lu",
843 (unsigned long)ARGLISTHEADSZ,
844 (unsigned long)ARGLISTELTSZ);
845 (void)fprintf(list_fd,
846 "\nNumber of common block decls = %lu totaling %lu variables",
847 comlist_head_used,
848 comlist_element_used);
849 (void)fprintf(list_fd,
850 "\nCommon list header and element chunk sizes = %lu and %lu",
851 (unsigned long)COMLISTHEADSZ,
852 (unsigned long)COMLISTELTSZ);
853 (void)fprintf(list_fd,
854 "\nNumber of array dim ptrs used = %lu, chunk size = %lu",
855 max_ptrspace,
856 (unsigned long)PTRSPACESZ);
857
858 #ifdef DEBUG_SIZES
859 (void)fprintf(list_fd,
860 "\nIdentifier hashtable size = %6lu",
861 (unsigned long)HASHSZ);
862 #ifdef KEY_HASH/* not used any more*/
863 (void)fprintf(list_fd,
864 "\nKeyword hashtable size = %6lu",
865 (unsigned long)KEYHASHSZ);
866 #endif
867 #ifdef COUNT_REHASHES
868 (void)fprintf(list_fd,
869 "\nIdentifier rehash count = %6lu",
870 rehash_count);
871 #endif
872 (void)fprintf(list_fd,
873 "\nIntrinsic function hashtable size=%6lu, clash count=%lu",
874 (unsigned long)INTRINS_HASHSZ,
875 intrins_clashes);
876 #endif /*DEBUG_SIZES*/
877
878 (void)fprintf(list_fd,"\n\n");
879 }
880