home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / fchek284.zip / ftnchek.c < prev    next >
C/C++ Source or Header  |  1995-05-15  |  39KB  |  1,449 lines
  1. /*  ftnchek.c:
  2.  
  3.     Main program for Fortran Syntax Checker.
  4.  
  5.     Copyright (C) 1993 by Robert K. Moniot.
  6.     This program is free software.  Permission is granted to
  7.     modify it and/or redistribute it, retaining this notice.
  8.     No guarantees accompany this software.
  9.  
  10.  
  11.     Top-level input/output is done here: opening and closing files,
  12.     and printing error, warning, and informational messages.
  13.  
  14.     Shared functions defined:
  15.         print_a_line()    Prints source code line.
  16.         yyerror()    Error messages from yyparse and elsewhere.
  17.         syntax_error()    Error messages with line and column num.
  18.         warning()    Warning messages.
  19.         nonportable()    Portability warnings.
  20.         wrapup()    Look at cross references, etc.
  21. */
  22.  
  23. #include <stdio.h>
  24. #include <string.h>
  25. #include <ctype.h>
  26. #ifdef DEVELOPMENT             /* For maintaining the program */
  27. #define DEBUG_SIZES
  28. #endif
  29. #define MAIN
  30. #include "ftnchek.h"
  31.  
  32. #ifdef VMS
  33. #define unlink(s) remove(s)
  34. #endif
  35.  
  36.  
  37. void
  38. debug_symtabs();
  39.  
  40. PRIVATE void
  41. error_message(), lintstyle_error_message(), oldstyle_error_message(),
  42. error_summary(), get_env_options(),
  43. make_env_name(), print_version_number(), set_option(),
  44. list_options(), open_outfile(),
  45. resource_summary(), src_file_in(), wrapup();
  46. #ifdef ALLOW_INCLUDE
  47. PRIVATE void append_include_path();
  48. #endif
  49.  
  50. #ifdef DEBUG_SIZES
  51. extern void print_sizeofs();    /* in symtab.c */
  52. #endif
  53.  
  54.  
  55. #ifndef VMS_INCLUDE /* add_ext and has_extension shared with forlex.c
  56.                include handler for vms specifics only */
  57. PRIVATE
  58. #endif
  59. char *add_ext();
  60.  
  61. #ifndef VMS_INCLUDE
  62. PRIVATE
  63. #endif
  64. int has_extension();
  65.  
  66. PRIVATE char *new_ext();
  67.  
  68. PRIVATE int read_setting();
  69.  
  70. PRIVATE int project_file_input;    /* true if input is from .prj file */
  71.  
  72. #define full_output    (do_list || do_symtab)
  73.  
  74. PRIVATE unsigned long intrins_clashes;    
  75.                 /* count of intrinsic hashtable clashes */
  76. #ifdef COUNT_REHASHES
  77. extern unsigned long rehash_count; /* count of calls to rehash() */
  78. #endif
  79.  
  80.     /* Here we define the commandline options.  Most options are boolean
  81.        switchopts, with "no" prefix to unset them.  Others (called
  82.        settings) are numeric quantities, defined using "=num".
  83.        A third category (strsettings) are string quantities, eg filenames.
  84.        The argument "?" will cause list of options to be printed out.
  85.        For VMS, options can be prefixed with either "-" or "/",
  86.        but messages will use the canonical form. */
  87.  
  88. #ifdef OPTION_PREFIX_SLASH
  89. #define OPT_PREFIX '/'    /* Canonical VMS prefix for commandline options */
  90. #else
  91. #define OPT_PREFIX '-'    /* Canonical Unix prefix for commandline options */
  92. #endif
  93.  
  94. #define OPT_MATCH_LEN 3    /* Options are matched only in 1st 3 chars */
  95. #define NUM_SWITCHES (sizeof(switchopt)/sizeof(switchopt[0]))
  96. #define NUM_SETTINGS (sizeof(setting)/sizeof(setting[0]))
  97. #define NUM_STRSETTINGS (sizeof(strsetting)/sizeof(strsetting[0]))
  98.  
  99. /*    Option definitions:
  100.        New options can be added to lists by inserting definition
  101.        here using same syntax as others, and declaring the variable
  102.        with OPT(type,name,default); in ftnchek.h.  No other changes
  103.        needed.
  104. */
  105.  
  106.  
  107.         /* List of switches is defined first.  Each entry gives the
  108.            name and the corresponding flag variable to be set
  109.            or cleared.  See set_option() for processing of switches.
  110.  
  111.            N.B. list_options() will suppress printing of any options
  112.            whose explanation starts with "debug" unless the -debug
  113.            switch was previously given.
  114.          */
  115. PRIVATE struct {
  116.     char *name;
  117.     int *switchflag;
  118.     char *explanation;
  119. } switchopt[]={
  120.     {"backslash",    &unix_backslash,"unix-style backslash escape char"},
  121.     {"calltree",    &print_call_tree,"print subprogram call tree"},
  122.     {"crossref",    &print_xref_list,"print call cross-reference list"},
  123.     {"declare",    &decls_required,"list undeclared variables"},
  124.     {"division",    &div_check,    "catch possible div by 0"},
  125.     {"extern",    &ext_def_check,    "check if externals defined"},
  126.     {"f77",        &f77_standard,    "warn of nonstandard constructs"},
  127.     {"help",    &help_screen,    "print help screen"},
  128.     {"hollerith",    &hollerith_check,"warn about holleriths under -port"},
  129.     {"library",    &library_mode,    "treat next files as library"},
  130. #ifdef EOLSKIP
  131.     {"linebreak",    &eol_is_space,    "treat linebreaks as space"},
  132. #endif
  133.     {"list",    &do_list,    "print program listing"},
  134.     {"novice",    &novice_help,    "extra help for novices"},
  135.     {"portability",    &port_check,    "check for portability problems"},
  136.     {"pretty",    &pretty_flag,    "warn of deceiving appearances"},
  137.     {"project",    &make_project_file,    "create project file"},
  138.     {"pure",    &pure_functions,"functions have no side effects"},
  139.     {"reference",    &print_ref_list,"print who-calls-who reference list"},
  140.     {"resources",    &show_resources,"show info on resource usage"},
  141.     {"sixchar",    &sixclash,    "catch nonunique names"},
  142.     {"sort",    &print_topo_sort,"prerequisite-order sort of modules"},
  143.     {"symtab",    &do_symtab,    "print symbol table info"},
  144.     {"tab",        &dec_tabs,    "tab-formatted source file"},
  145.     {"truncation",    &trunc_check,    "check for truncation pitfalls"},
  146. #ifdef VCG_SUPPORT
  147.     {"vcg",        &print_vcg_list,"print call graph in vcg format"},
  148. #endif
  149.     {"verbose",    &verbose,    "verbose output"},
  150.     {"volatile",    &volatile_flag,    "assume volatile common blocks"},
  151.  
  152.     {"debug",    &debug_latest,    "debug latest code"},
  153.     {"global",    &debug_glob_symtab,    "debug global symtab info"},
  154.     {"grammar",    &debug_parser,    "debug printout in parser"},
  155.     {"hashtable",    &debug_hashtab,    "debug printout of hashtable"},
  156.     {"local",    &debug_loc_symtab,    "debug local symtab info"},
  157.     {"tokens",    &debug_lexer,    "debug printout in lexer"},
  158.     {"yydebug",    &yydebug,    "debug via yydebug"},
  159. };
  160.  
  161.  
  162.         /* List of settings is defined here. Each entry gives
  163.            the name, the corresponding variable, the range
  164.            of permitted values, the value for turning it off,
  165.            followed by brief explanation.
  166.            See set_option() for processing. */
  167. PRIVATE struct {
  168.     char *name;
  169.     int *setvalue;
  170.     int minlimit,maxlimit,turnoff,min_default_value,max_default_value;
  171.     char *explanation;
  172. } setting[]={
  173.   {"arguments",    &argcheck_strictness, 0, 3, 0, 0, 3,
  174.             "check args: 0=none 1=number 2=type 3=all"},
  175.   {"array",    &array_arg_check, 0, 3, 0, 0, 3,
  176.             "check array args: 0=none 1=dims 2=size 3=all"},
  177.   {"columns",    &max_stmt_col,  72, MAXLINE, 72, 72, MAXLINE,
  178.             "max line length processed"},
  179.   {"common",    &comcheck_strictness,  0, 3, 0, 0, 3,
  180.             "common check: 0=none 3=most strict"},
  181.   {"makedcls",  &make_dcls, 0, 511, 0, 1, 1,
  182.             "make type declaration statements: sum of:\n\
  183. \t  1=declarations\n\
  184. \t  2=undeclared-only\n\
  185. \t  4=compact\n\
  186. \t  8=use-continuation-lines\n\
  187. \t 16=keywords-lowercase\n\
  188. \t 32=variables-and-constants-lowercase\n\
  189. \t 64=exclude-sftran3-internal-variables\n\
  190. \t128=asterisk-comment-character\n\
  191. \t256=lowercase-comment-char"},
  192.   {"usage",    &usage_check,    0, 3, 0, 0, 3,
  193.             "0=no check, 1=used-not-set 2=unused 3=all"},
  194.   {"wordsize",    &given_wordsize, 0, 16, 0, 0, 16,
  195.             "standard wordsize in bytes (0=no default)"},
  196.   {"wrap",    &wrap_column, 0, 999, 0, 0, 999,
  197.             "width of page to wrap error messages"},
  198. };
  199.  
  200.  
  201.         /* List of strsettings is defined here. Each entry gives
  202.            the name the corresponding string variable, and brief
  203.            explanation.  See set_option() for processing. */
  204. PRIVATE struct {
  205.     char *name;
  206.     char **strvalue;
  207.     char *explanation;
  208. } strsetting[]={
  209. #ifdef ALLOW_INCLUDE
  210.   {"include",    &include_path,    "include-file directory"},
  211. #endif
  212.   {"output",    &out_fname,    "output file name"},
  213. };
  214.  
  215. PRIVATE int must_open_outfile=FALSE; /* Flag set to TRUE when out=name given */
  216.  
  217. PRIVATE char *dclfile;
  218.  
  219. int
  220. main(argc,argv)
  221.     int argc;
  222.     char *argv[];
  223. {
  224.     int iarg;
  225.     int filecount=0,actioncount=0;
  226.     char *infile,*srcfile,*projfile;
  227.  
  228. #ifdef VMS            /* VMS version: expand wildcards, etc. */
  229.     shell_mung(&argc,&argv,1,NULL);
  230. #endif
  231.  
  232.     list_fd = stdout;
  233.     project_fd = (FILE *) NULL;
  234.     error_count = 0;
  235.     warning_count = 0;
  236.  
  237.     get_env_options();
  238. #ifdef ALLOW_INCLUDE
  239.     include_path_list = (IncludePathNode*) NULL;
  240.     if(include_path != (char *)NULL) {
  241.       append_include_path(include_path);
  242.       include_path = (char *)NULL; /* clear it for the next one */
  243.     }
  244. #endif
  245.     init_tables();        /* Initialize tables */
  246.     init_keyhashtab();
  247.     intrins_clashes = init_intrins_hashtab();
  248.     init_globals();
  249.     init_symtab();
  250.  
  251.     for(iarg=1; iarg < argc; iarg++) {
  252.  
  253.       int argchar=0;/* location of start of option */
  254. #ifdef OPTION_PREFIX_SLASH
  255.       do {            /* loop on flags within argv[iarg] */
  256. #endif
  257.         if( argv[iarg][argchar] == '-'
  258. #ifdef OPTION_PREFIX_SLASH
  259.          || argv[iarg][argchar] == '/'    /* Allow VMS /option form */
  260. #endif
  261.                      ) {
  262.             /* Process flags here */
  263.  
  264.         set_option(&argv[iarg][argchar]);
  265.         if(help_screen) goto do_action;
  266.                 /* Handle -include=path option here */
  267. #ifdef ALLOW_INCLUDE
  268.         if(include_path != (char *)NULL) {
  269.             append_include_path(include_path);
  270.             include_path = (char *)NULL;
  271.         }
  272. #endif
  273.  
  274.         }
  275.         else if(strcmp(&argv[iarg][argchar],"?") == 0) {
  276.             help_screen = TRUE;
  277.             goto do_action;
  278.         }/*end of processing options*/
  279.  
  280.         else {    /* Process file arguments */
  281. do_action:
  282.  
  283.         if( must_open_outfile )
  284.             open_outfile(out_fname);
  285.  
  286.         if(actioncount == 0) {
  287.           print_version_number();
  288.         }
  289.         ++actioncount;    /* Cause exit w/o reading stdin below */
  290.  
  291.                 /* Honor -help option */
  292.         if(help_screen) {
  293.           help_screen = FALSE;
  294.           list_options(list_fd);
  295.         }
  296.         else {    /* Process files here */
  297.             ++filecount;
  298.  
  299.             srcfile = add_ext(&argv[iarg][argchar],DEF_SRC_EXTENSION);
  300.             projfile = new_ext(&argv[iarg][argchar],DEF_PROJ_EXTENSION);
  301.             dclfile =  new_ext(&argv[iarg][argchar],DEF_DCL_EXTENSION);
  302.  
  303.                 /* Project file mode: open source for reading
  304.                    and .prj file for writing. */
  305.             if(make_project_file) {
  306.  
  307.               infile = srcfile;
  308.  
  309.               if( has_extension(infile,DEF_PROJ_EXTENSION) ) {
  310.             (void)fprintf(stderr,
  311.              "Input from %s disallowed in project mode\n",infile);
  312.             goto next_arg;
  313.               }
  314.  
  315.               if( (input_fd = fopen(infile,"r")) == NULL ) {
  316.             (void)fprintf(stderr,"Cannot open file %s\n",infile);
  317.             goto next_arg;
  318.               }
  319.  
  320.               project_fd = fopen(projfile,"w");
  321.               project_file_input = FALSE;
  322.             }
  323.             else {
  324.             /* Non project file mode: if input file extension
  325.                given, use it.  Otherwise read project file
  326.                if it exists else read source file. */
  327.               if( &argv[iarg][argchar]==srcfile
  328.                || (input_fd = fopen(projfile,"r")) == NULL) {
  329.             infile = srcfile;
  330.             if( (input_fd = fopen(infile,"r")) == NULL ) {
  331.               (void)fflush(list_fd);
  332.               (void)fprintf(stderr,"Cannot open file %s\n",infile);
  333.               goto next_arg;
  334.             }
  335.             project_file_input =
  336.               has_extension(infile,DEF_PROJ_EXTENSION);
  337.               }
  338.               else {
  339.             infile = projfile;
  340.             project_file_input = TRUE;
  341.               }
  342.             }
  343.  
  344.             /* now that we have a source file, try to open the 
  345.                declaration file */
  346.             dcl_fd = (make_dcls > 0 &&  ! project_file_input) ?
  347.               fopen(dclfile,"w") : (FILE*)NULL;
  348.  
  349.                 /* Always print input .f file name.  If
  350.                    verbose mode, print .prj file names too.
  351.                  */
  352.             if(verbose || !project_file_input)
  353.               (void)fprintf(list_fd,"\nFile %s:%s",
  354.                   infile,
  355.                   full_output?"\n":""
  356.                   );
  357.  
  358.                 /* In verbose mode, print .prj output
  359.                    file name to stderr.  Always print
  360.                    error message if couldn't open it. */
  361.             if( make_project_file ) {
  362.               if(project_fd != NULL) {
  363.             if(verbose) {
  364.               (void)fflush(list_fd);
  365.               (void)fprintf(stderr,
  366.                   "\nProject file is %s\n",projfile);
  367.             }
  368.               }
  369.               else {
  370.             (void)fflush(list_fd);
  371.             (void)fprintf(stderr,
  372.                 "\nCannot open %s for output\n",projfile);
  373.               }
  374.             }
  375.  
  376.  
  377.                 /* only has effect if done before 1st file*/
  378.             init_typesizes();
  379.  
  380.             if(project_file_input) {
  381.  
  382.                 current_filename = projfile;
  383.             proj_file_in(input_fd);
  384.  
  385.             }
  386.             else {
  387.  
  388.               src_file_in(infile);
  389.  
  390.             }
  391.  
  392.             (void) fclose(input_fd);
  393.         }/*end processing file args*/
  394.           }
  395. next_arg:
  396. #ifdef OPTION_PREFIX_SLASH
  397.                 /* Here we allow /opts to be stuck together */
  398.         while(argv[iarg][++argchar] != '\0'
  399.          && argv[iarg][argchar] != '/') /* look for next opt */
  400.           continue;
  401.  
  402.       } while(argv[iarg][argchar] != '\0'); /*end do-while*/
  403. #else
  404.       continue;
  405. #endif
  406.     }    /* end for-loop on argument list */
  407.  
  408.  
  409.                 /* No files given: read stdin */
  410.     if(actioncount == 0) {
  411.  
  412.         print_version_number();
  413.  
  414.         if( must_open_outfile )
  415.             open_outfile(out_fname);
  416.  
  417.         if(make_project_file) {
  418.               projfile = STDIN_PROJ_FILENAME;
  419.               if( (project_fd = fopen(projfile,"w")) == NULL) {
  420.             (void)fflush(list_fd);
  421.             (void)fprintf(stderr,
  422.                 "\nCannot open %s for output\n",projfile);
  423.               }
  424.               else {
  425.             if(verbose) {
  426.               (void)fflush(list_fd);
  427.               (void)fprintf(stderr,
  428.                 "\nProject file is %s\n",projfile);
  429.             }
  430.               }
  431.         }
  432.  
  433.         ++filecount;
  434.         input_fd = stdin;
  435.  
  436.         init_typesizes();
  437.  
  438.         src_file_in("std_input");
  439.     }
  440.     if(filecount > 0) {
  441.       wrapup();
  442.       (void)fprintf(list_fd,"\n");
  443.     }
  444.  
  445.     if(show_resources)
  446.         resource_summary();
  447.  
  448.     exit(0);
  449.     return 0;/*NOTREACHED*/
  450. }
  451.  
  452. PRIVATE void
  453. src_file_in(infile)
  454.      char *infile;        /* input filename */
  455. {
  456.     note_filename(infile);
  457.  
  458.     init_scan();
  459.     init_parser();
  460.  
  461.     (void) yyparse();
  462.  
  463.     finish_scan();
  464.  
  465.     if(make_project_file) {
  466.           proj_file_out(project_fd);
  467.           (void) fclose(project_fd);
  468.     }
  469.  
  470.     if ((make_dcls > 0) && (dcl_fd != stdout))
  471.     {
  472.         if (ftell(dcl_fd) == 0L)    /* delete an empty .dcl file */
  473.         (void)unlink(dclfile);
  474.         (void) fclose(dcl_fd);
  475.     }
  476.  
  477.     if(port_check && tab_count != 0) {
  478.       nonportable(NO_LINE_NUM,NO_COL_NUM,
  479.               "File contains tabs");
  480.     }
  481.  
  482.     error_summary(infile);
  483. }
  484.  
  485. PRIVATE void
  486. print_version_number()
  487. {
  488.   if(full_output || verbose)
  489.     (void)fprintf(list_fd,"\n");
  490.   (void)fprintf(list_fd,"%s",VERSION_NUMBER);
  491.   if(help_screen)
  492.     (void)fprintf(list_fd," %s",PATCHLEVEL);
  493.   if(full_output || verbose)
  494.     (void)fprintf(list_fd,"\n");
  495. }
  496.  
  497. PRIVATE void
  498. error_summary(fname)        /* Print out count of errors in file */
  499.     char *fname;
  500. {
  501.     FILE *fd = list_fd;
  502.  
  503.     if(full_output ||
  504.        (verbose && error_count+warning_count != 0))
  505.       (void)fprintf(fd,"\n");
  506.  
  507.     if(full_output || verbose || error_count != 0)
  508.       (void)fprintf(fd,"\n %u syntax error%s detected in file %s",
  509.             error_count, error_count==1? "":"s",
  510.             fname);
  511.  
  512.     if(warning_count != 0)
  513.         (void)fprintf(fd,"\n %u warning%s issued in file %s",
  514.             warning_count, warning_count==1? "":"s",
  515.             fname);
  516.  
  517.     if(full_output ||
  518.        (verbose && error_count+warning_count != 0))
  519.       (void)fprintf(fd,"\n");
  520.  
  521.     error_count = 0;
  522.     warning_count = 0;
  523. }
  524.  
  525. void
  526. print_a_line(fd,line,num)  /* Print source line with line number */
  527.     FILE *fd;
  528.     char *line;
  529.     unsigned num;
  530. {
  531.     (void)fprintf(fd,"\n %6u ",num); /* Print line number */
  532.  
  533. #ifdef DEC_TABS
  534.                 /* Tab-formatted source lines: tab in
  535.                    col 1-6 moves to col 7. */
  536.     if(dec_tabs) {
  537.       int i,col;
  538.       for(i=0,col=1; col < 7 && line[i] != '\0'; i++) {
  539.         if(line[i] == '\t') {
  540.           do{
  541.         (void)fprintf(fd," ");
  542.           } while(++col < 7);
  543.         }
  544.         else {
  545.         (void)fprintf(fd,"%c",line[i]);
  546.         ++col;
  547.         }
  548.       }
  549.       (void)fprintf(fd,"%s",line+i);
  550.     }
  551.     else
  552. #endif
  553.       (void)fprintf(fd,"%s",line);
  554. }
  555.  
  556.  
  557. void
  558. yyerror(s)
  559.     char *s;
  560. {
  561.     syntax_error(line_num,col_num,s);
  562. }
  563.  
  564.  
  565. void
  566. syntax_error(lineno,colno,s)        /* Syntax error message */
  567.     unsigned lineno,colno;
  568.     char *s;
  569. {
  570.     ++error_count;
  571.     error_message(lineno,colno,s,"Error");
  572. }
  573.  
  574. void
  575. warning(lineno,colno,s)        /* Print warning message */
  576.     unsigned lineno,colno;
  577.     char *s;
  578. {
  579.     ++warning_count;
  580.  
  581.     error_message(lineno,colno,s,"Warning");
  582. }
  583.  
  584. void
  585. ugly_code(lineno,colno,s)        /* -pretty message */
  586.     unsigned lineno,colno;
  587.     char *s;
  588. {
  589.     ++warning_count;
  590.  
  591.     error_message(lineno,colno,s,"Possibly misleading appearance");
  592. }
  593.  
  594. void
  595. nonstandard(lineno,colno)
  596.      unsigned lineno,colno;
  597. {
  598.     ++warning_count;
  599.     error_message(lineno,colno,"Nonstandard syntax","Warning");
  600. }
  601.  
  602. void
  603. nonportable(lineno,colno,s) /* Print warning about nonportable construction */
  604.     unsigned lineno,colno;
  605.     char *s;
  606. {
  607.     ++warning_count;
  608.     error_message(lineno,colno,s,"Nonportable usage");
  609. }
  610.  
  611. /* error_message prints out error messages and warnings.  It
  612.    now comes in two flavors.  If using lintstyle_error_message(),
  613.    messages are produced in style like UNIX lint:
  614.  
  615.     "main.f", line nn, col nn: Error: your message here
  616.  
  617.    Otherwise messages by oldstyle_error_message in old ftnchek style:
  618.  
  619.     Error near line nn col nn file main.f: your message here
  620.  
  621.    At this time, oldstyle_error_message is used when -novice is
  622.    in effect, lintstyle_error_message otherwise.
  623. */
  624.  
  625. PRIVATE int errmsg_col;
  626.     /* Crude macro to give number of digits in line and column numbers.
  627.        Used by line wrap computation. */
  628. #define NUM_DIGITS(n) ((n)<10?1:((n)<100?2:((n)<1000?3:(n)<10000?4:5)))
  629.  
  630. PRIVATE void
  631. error_message(lineno,colno,s,tag)
  632.     unsigned lineno,colno;
  633.     char *s,*tag;
  634. {
  635.   if(novice_help)
  636.     oldstyle_error_message(lineno,colno,s,tag);
  637.   else
  638.     lintstyle_error_message(lineno,colno,s,tag);
  639. }
  640.  
  641. PRIVATE void
  642. lintstyle_error_message(lineno,colno,s,tag)
  643.     unsigned lineno,colno;
  644.     char *s,*tag;
  645. {
  646.     int icol;
  647.     extern unsigned prev_stmt_line_num; /* shared with advance.c */
  648.  
  649.     errmsg_col=1;        /* Keep track of line length */
  650.  
  651.             /* Print the character ^ under the column number.
  652.                But if colno == 0, error occurred in prior line.
  653.                If colno is NO_COL_NUM, then print message
  654.                without any column number given.
  655.              */
  656.  
  657.     if(lineno != NO_LINE_NUM) {
  658.         if(colno == NO_COL_NUM) {
  659.             /* colno == NO_COL_NUM means don't give column number.*/
  660.         (void)flush_line_out(lineno);/* print line if not printed yet */
  661.         }
  662.         else if(colno != 0) {
  663.             /* print line if not printed yet */
  664.         if( flush_line_out(lineno) ) {
  665.                 /* If it was printed, put ^ under the col */
  666.             (void)fprintf(list_fd,"\n%8s","");
  667.  
  668.             for(icol=1; icol<colno; icol++)
  669.             (void)fprintf(list_fd," ");
  670.             (void)fprintf(list_fd,"^");
  671.         }
  672.         }
  673.         else {        /* colno == 0 */
  674.             /* print line if not printed yet */
  675.         (void)flush_line_out(prev_stmt_line_num);
  676.         }
  677.     }
  678.  
  679.     (void)fprintf(list_fd,"\n\"%s\"",current_filename);
  680.     errmsg_col += 2+strlen(current_filename);
  681.  
  682.     if(lineno != NO_LINE_NUM) { /* nonlocal error-- don't flush */
  683.         if(colno == NO_COL_NUM) {
  684.         (void)fprintf(list_fd,
  685.            ", near line %u",lineno);
  686.         errmsg_col += 12+NUM_DIGITS(lineno);
  687.         }
  688.         else if(colno != 0) {
  689.         (void)fprintf(list_fd,
  690.            ", line %u col %u",lineno,colno);
  691.         errmsg_col += 12+NUM_DIGITS(lineno);
  692.         }
  693.         else {        /* colno == 0 */
  694.         (void)fprintf(list_fd,
  695.            ", near line %u",prev_stmt_line_num);
  696.         errmsg_col += 12+NUM_DIGITS(lineno);
  697.         }
  698.     }
  699.  
  700.     (void)fprintf(list_fd,": %s:",tag); /* "Warning", "Error", etc. */
  701.     errmsg_col += 3+strlen(tag);
  702.  
  703.     msg_tail(s); /* now append the message string */
  704. }
  705.  
  706.                 /* Our own style messages */
  707. PRIVATE void
  708. oldstyle_error_message(lineno,colno,s,tag)
  709.     unsigned lineno,colno;
  710.     char *s,*tag;
  711. {
  712.     int icol;
  713.     extern unsigned prev_stmt_line_num; /* shared with advance.c */
  714.  
  715.     errmsg_col=1;        /* Keep track of line length */
  716.  
  717.             /* Print the character ^ under the column number.
  718.                But if colno == 0, error occurred in prior line.
  719.                If colno is NO_COL_NUM, then print message
  720.                without any column number given.
  721.              */
  722.  
  723.     if(lineno == NO_LINE_NUM) { /* nonlocal error-- don't flush */
  724.       (void)fprintf(list_fd,"\n%s",tag);
  725.       errmsg_col += strlen(tag);
  726.     }
  727.     else {
  728.         if(colno == NO_COL_NUM) {
  729.             /* colno == NO_COL_NUM means don't give column number.*/
  730.         (void)flush_line_out(lineno);/* print line if not printed yet */
  731.         (void)fprintf(list_fd,
  732.            "\n%s near line %u",tag,lineno);
  733.         errmsg_col += 11+NUM_DIGITS(lineno)+(unsigned)strlen(tag);
  734.         }
  735.         else if(colno != 0) {
  736.             /* print line if not printed yet */
  737.         if( flush_line_out(lineno) ) {
  738.                 /* If it was printed, put ^ under the col */
  739.             (void)fprintf(list_fd,"\n%8s","");
  740.  
  741.             for(icol=1; icol<colno; icol++)
  742.             (void)fprintf(list_fd," ");
  743.             (void)fprintf(list_fd,"^");
  744.         }
  745.         (void)fprintf(list_fd,
  746.            "\n%s near line %u col %u",tag,lineno,colno);
  747.         errmsg_col += 16+NUM_DIGITS(lineno)+NUM_DIGITS(colno)
  748.           +(unsigned)strlen(tag);
  749.         }
  750.         else {        /* colno == 0 */
  751.             /* print line if not printed yet */
  752.         (void)flush_line_out(prev_stmt_line_num);
  753.         (void)fprintf(list_fd,
  754.            "\n%s near line %u",tag,prev_stmt_line_num);
  755.         errmsg_col += 11+NUM_DIGITS(lineno)+(unsigned)strlen(tag);
  756.         }
  757.     }
  758.  
  759.     if(!full_output        /* If not listing, append file name */
  760.        || incdepth > 0){    /* Append include-file name if we are in one */
  761.       if(lineno == NO_LINE_NUM) { /* if no line no, preposition needed */
  762.         (void)fprintf(list_fd," in");
  763.         errmsg_col += 3;
  764.       }
  765.       (void)fprintf(list_fd," file %s",current_filename);
  766.       errmsg_col += 6+(unsigned)strlen(current_filename);
  767.     }
  768.  
  769.     (void)fprintf(list_fd,":");
  770.     errmsg_col++;
  771.  
  772.     msg_tail(s); /* now append the message string */
  773. }
  774.  
  775.         /* msg_tail appends string s to current error message.
  776.            It prints one word at a time, starting a new line
  777.            when the message gets to be too long for one line.
  778.          */
  779. void
  780. msg_tail(s)
  781.     char *s;
  782. {
  783.     int wordstart,wordend,leading_skip,wordchars;
  784.  
  785.     (void)fprintf(list_fd," ");
  786.     errmsg_col++;
  787.     wordstart=0;
  788.         /* Each iteration of loop prints leading space and the
  789.            nonspace characters of a word.  Loop invariant: wordstart
  790.            is index of leading space at start of word, wordend is
  791.            index of space char following word. */
  792.     while(s[wordstart] != '\0') {
  793.       leading_skip = TRUE;
  794.       for(wordend=wordstart; s[wordend] != '\0'; wordend++) {
  795.         if(leading_skip) {    /* If skipping leading space chars */
  796.           if(!isspace(s[wordend]))
  797.         leading_skip = FALSE; /* go out of skip mode at nonspace */
  798.         }
  799.         else {        /* If scanning word chars */
  800.           if(isspace(s[wordend]))
  801.         break;        /* quit loop when space char found */
  802.         }
  803.       }
  804.       wordchars = wordend-wordstart;
  805.                 /* If word doesn't fit, wrap to next line */
  806.       if( wrap_column > 0 && (errmsg_col += wordchars) > wrap_column) {
  807.         (void)fprintf(list_fd,"\n");
  808.         errmsg_col = wordchars;
  809.       }
  810.                 /* Print the word */
  811.       while(wordstart < wordend) {
  812.         (void)putc(s[wordstart++],list_fd);
  813.       }
  814.     }
  815. }
  816.  
  817.  
  818. void
  819. oops_message(severity,lineno,colno,s)
  820.     int severity;
  821.     unsigned lineno,colno;
  822.     char *s;
  823. {
  824.     (void)fflush(list_fd);
  825.     (void)fprintf(stderr,"\nOops");
  826.     if(lineno != NO_LINE_NUM) {
  827.       (void)fprintf(stderr," at line %u",lineno);
  828.       if(colno != NO_COL_NUM)
  829.         (void)fprintf(stderr," at col %u",colno);
  830.     }
  831.     (void)fprintf(stderr," in file %s",current_filename);
  832.     (void)fprintf(stderr," -- %s",s);
  833.     if(severity == OOPS_FATAL) {
  834.       (void)fprintf(stderr,"\nFtnchek aborted\n");
  835.       (void) exit(1);
  836.     }
  837. }
  838.  
  839. void
  840. oops_tail(s)
  841.     char *s;
  842. {
  843.     (void)fprintf(stderr," %s",s);
  844. }
  845.  
  846. /*    get_env_options picks up any options defined in the
  847.     environment.  A switch or setting is defined according to
  848.     the value of an environment variable whose name is the switch
  849.     or setting name (uppercased), prefixed by the string
  850.     ENV_PREFIX (e.g.  FTNCHEK_).  For settings and strsettings,
  851.     the value of the environment variable gives the value to be
  852.     used.  For switches, the environment variable is set to "0" or
  853.     "NO" to turn the switch off, or to any other value (including
  854.     null) to turn it on.
  855. */
  856.  
  857. PRIVATE void
  858. get_env_options()
  859. {
  860.     char env_option_name[32];
  861.     char *value;
  862.     int i;
  863.     for(i=0; i<NUM_SWITCHES; i++) {
  864.             /* Construct the env variable name for switch i */
  865.         make_env_name( env_option_name, switchopt[i].name);
  866.  
  867.             /* See if it is defined */
  868.         if( (value = getenv(env_option_name)) != (char *)NULL) {
  869.         *(switchopt[i].switchflag) =
  870.             !(strcmp(value,"0")==0 || strcmp(value,"NO")==0 );
  871.         }
  872.  
  873.     }
  874.  
  875.     for(i=0; i<NUM_SETTINGS; i++) {
  876.             /* Construct the env variable name for setting i */
  877.         make_env_name( env_option_name, setting[i].name);
  878.             /* See if it is defined */
  879.         if( (value = getenv(env_option_name)) != (char *)NULL) {
  880.         if(read_setting(value, setting[i].setvalue, setting[i].name,
  881.                 setting[i].minlimit, setting[i].maxlimit,
  882.                 setting[i].turnoff,
  883.                 setting[i].min_default_value,
  884.                 setting[i].max_default_value) != 0) {
  885.           (void)fflush(list_fd);
  886.           (void)fprintf(stderr,"Env setting garbled: %s=%s: ignored\n",
  887.                 env_option_name,value);
  888.         }
  889.         }
  890.     }
  891.  
  892.  
  893.     for(i=0; i<NUM_STRSETTINGS; i++) {
  894.             /* Construct the env variable name for setting i */
  895.         make_env_name( env_option_name, strsetting[i].name);
  896.             /* See if it is defined */
  897.         if( (value = getenv(env_option_name)) != (char *)NULL) {
  898.             *(strsetting[i].strvalue) = value;
  899.  
  900.             /* Handle necessary action for  -out=listfile */
  901.         if(strsetting[i].strvalue == &out_fname)
  902.             must_open_outfile = TRUE;
  903.         }
  904.     }
  905. }
  906.  
  907.         /* Routine to concatenate ENV_PREFIX onto option name
  908.            and uppercase the result.
  909.         */
  910. PRIVATE void
  911. make_env_name( env_name, option_name)
  912.     char *env_name, *option_name;
  913. {
  914.     int i,c;
  915.  
  916.     (void)strcat(strcpy(env_name,ENV_PREFIX),option_name);
  917.     for(i=sizeof(ENV_PREFIX)-1; (c=env_name[i]) != '\0'; i++) {
  918.     if( islower(c) )
  919.         env_name[i] = toupper(c);
  920.     }
  921. }
  922.  
  923.  
  924.     /* set_option processes an option from command line.  Argument s is
  925.        the option string. First s is compared against boolean switches
  926.        from list in switchopt[].  If s matches switch string,
  927.        corresponding flag is set to TRUE.  If no match, then s is compared
  928.        to the same switches prefixed by "no", and if match is found, then
  929.        flag is set to FALSE.  Finally, special flags are handled.  If still
  930.        no match, an error message is generated.
  931.      */
  932.  
  933. PRIVATE void
  934. set_option(s)
  935.     char *s;
  936. {
  937.     int i;
  938.         /* look for noswitch flags first since otherwise
  939.            an option starting with no might take precedence */
  940.     if(strncmp(s+1,"no",2) == 0) {
  941.         for(i=0; i<NUM_SWITCHES; i++) {
  942.         if( strncmp(s+3,switchopt[i].name,OPT_MATCH_LEN) == 0) {
  943.             *(switchopt[i].switchflag) = FALSE;
  944.             return;
  945.         }
  946.         }
  947.     }
  948.  
  949.         /* -noswitch not found: look for nosetting flag */
  950.     if(strncmp(s+1,"no",2) == 0) {
  951.         for(i=0; i<NUM_SETTINGS; i++) {
  952.         if( strncmp(s+3,setting[i].name,OPT_MATCH_LEN) == 0) {
  953.             *(setting[i].setvalue) = setting[i].turnoff;
  954.             return;
  955.         }
  956.         }
  957.     }
  958.  
  959.                 /* Next look for switches */
  960.     for(i=0; i<NUM_SWITCHES; i++) {
  961.         if( strncmp(s+1,switchopt[i].name,OPT_MATCH_LEN) == 0) {
  962.         *(switchopt[i].switchflag) = TRUE;
  963.         return;
  964.         }
  965.     }
  966.  
  967.         /* Handle settings of form "-opt=number" */
  968.     for(i=0; i<NUM_SETTINGS; i++)
  969.         if( strncmp(s+1,setting[i].name,OPT_MATCH_LEN) == 0) {
  970.         char *numstr;
  971.  
  972.         numstr = s + OPT_MATCH_LEN;
  973.         while(*++numstr != '\0')
  974.         {
  975.             if((*numstr == '=') || (*numstr == ':'))
  976.             {            /* Find the assignment operator */
  977.             numstr++;
  978.             break;
  979.             }
  980.         }
  981.         if(read_setting(numstr, setting[i].setvalue, setting[i].name,
  982.                 setting[i].minlimit, setting[i].maxlimit,
  983.                 setting[i].turnoff,
  984.                 setting[i].min_default_value,
  985.                 setting[i].max_default_value) != 0) {
  986.           (void)fflush(list_fd);
  987.           (void)fprintf(stderr,"Setting garbled: %s: ignored\n",s);
  988.         }
  989.         return;
  990.         }
  991.  
  992.  
  993.         /* Handle settings of form "-opt=string" */
  994.     for(i=0; i<NUM_STRSETTINGS; i++)
  995.         if( strncmp(s+1,strsetting[i].name,OPT_MATCH_LEN) == 0) {
  996.         char *strstart;
  997. #ifdef OPTION_PREFIX_SLASH
  998.         int numchars;
  999. #endif
  1000.         strstart = s + (OPT_MATCH_LEN + 1);
  1001.         while(*strstart != '=' && *strstart != '\0')
  1002.             strstart++;    /* Find the = sign */
  1003.         if(*strstart == '\0') {
  1004.             (void)fflush(list_fd);
  1005.             (void)fprintf(stderr,"String setting missing: %s: ignored\n",s);
  1006.             return;
  1007.         }
  1008.         else {
  1009.             *(strsetting[i].strvalue) = ++strstart;
  1010.                 /* In VMS,MSDOS worlds, user might not leave
  1011.                    blank space between options.  If string
  1012.                    is followed by '/', must make a properly
  1013.                    terminated copy.  */
  1014. #ifdef OPTION_PREFIX_SLASH
  1015.             for(numchars=0; strstart[numchars] != '\0'
  1016.             && strstart[numchars] != '/'; numchars++)
  1017.               continue;
  1018.             if(strstart[numchars] != '\0') {
  1019.               strncpy( *(strsetting[i].strvalue)=malloc(numchars+1),
  1020.                    strstart,numchars);
  1021.             }
  1022. #endif
  1023.  
  1024.         }
  1025.             /* Handle necessary action for  -out=listfile */
  1026.         if(strsetting[i].strvalue == &out_fname) {
  1027.             must_open_outfile = TRUE;
  1028.         }
  1029.         return;
  1030.         }
  1031.  
  1032.  
  1033.         /* No match found: issue error message */
  1034.  
  1035.     (void)fflush(list_fd);
  1036.     (void)fprintf(stderr,"\nUnknown commandline switch: %s\n",s);
  1037. }
  1038.  
  1039.  
  1040.     /* Routine to read integer setting from string s and check if valid */
  1041.  
  1042. PRIVATE int
  1043. read_setting(s, setvalue, name, minlimit, maxlimit, turnoff, min_default_value,
  1044.          max_default_value)
  1045.     char *s;
  1046.     int *setvalue;
  1047.     char *name;
  1048.     int minlimit, maxlimit, turnoff, min_default_value, max_default_value;
  1049. {
  1050.     int given_val;
  1051.  
  1052.     if(strcmp(s,"NO")==0) {
  1053.       *(setvalue) = turnoff;
  1054.     }
  1055.     else if(*s == '\0' || sscanf(s,"%d", &given_val) == 0) {
  1056.         return -1;    /* error return: garbled setting */
  1057.     }
  1058.     else {        /* If outside limits, set to default */
  1059.         int Ok=TRUE;
  1060.         if(given_val < minlimit) {
  1061.         given_val = min_default_value;
  1062.         Ok = FALSE;
  1063.         }
  1064.         else if(given_val > maxlimit) {
  1065.         given_val = max_default_value;
  1066.         Ok = FALSE;
  1067.         }
  1068.  
  1069.         if(! Ok ) {
  1070.             (void)fflush(list_fd);
  1071.         (void)fprintf(stderr,"\nSetting: %s",name);
  1072.         (void)fprintf(stderr," outside limits %d to %d",
  1073.                 minlimit,maxlimit);
  1074.         (void)fprintf(stderr,": set to default %d\n",given_val);
  1075.         }
  1076.  
  1077.         *(setvalue) = given_val;
  1078.     }
  1079.     return 0;
  1080. }
  1081.  
  1082. PRIVATE void
  1083. open_outfile(s)        /* open the output file for listing */
  1084.     char *s;
  1085. {
  1086.     char *fullname;        /* given name plus extension */
  1087.     FILE *fd;
  1088.  
  1089.     must_open_outfile = FALSE;    /* Turn off the flag */
  1090.  
  1091.     if(s == (char *) NULL || *s == '\0') {
  1092.         return;        /* No filename: no action  */
  1093.     }
  1094.  
  1095.     fullname = add_ext(s,DEF_LIST_EXTENSION);
  1096.     (void)fflush(list_fd);
  1097.     if( (fd = fopen(fullname,"w")) == NULL) {
  1098.         (void)fprintf(stderr,"\nCannot open %s for output\n",fullname);
  1099.     }
  1100.     else {
  1101.         (void)fprintf(stderr,"\nOutput sent to file %s\n",fullname);
  1102.         list_fd = fd;
  1103.     }
  1104. }
  1105.  
  1106.  
  1107. PRIVATE void
  1108. list_options(fd)/* List all commandline options, strsettings, and settings */
  1109.      FILE *fd;
  1110. {
  1111.     int i;
  1112.  
  1113.             /* Print the copyright notice */
  1114.     (void)fprintf(fd,"\n%s",COPYRIGHT_DATE);
  1115.     (void)fprintf(fd,"\n%s\n",COPYRIGHT_NOTICE);
  1116.  
  1117.         /* Note: Headings say "default" but to be accurate they
  1118.            should say "current value".  This would be confusing. */
  1119.     (void)fprintf(fd,"\nCommandline options [default]:");
  1120.     for(i=0; i<NUM_SWITCHES; i++) {
  1121.  
  1122.       if( !debug_latest &&
  1123.          strncmp(switchopt[i].explanation,"debug",5) == 0)
  1124.         continue;        /* skip debug switches unless debug mode */
  1125.  
  1126.       (void)fprintf(fd,"\n    %c[no]%s",OPT_PREFIX,switchopt[i].name);
  1127.       (void)fprintf(fd," [%s]",*(switchopt[i].switchflag)? "yes": "no");
  1128.       (void)fprintf(fd,": %s",switchopt[i].explanation);
  1129.     }
  1130.         /* String settings follow switches w/o their own heading */
  1131.     for(i=0; i<NUM_STRSETTINGS; i++) {
  1132.       if( !debug_latest &&
  1133.          strncmp(strsetting[i].explanation,"debug",5) == 0)
  1134.         continue;        /* skip debug settings unless debug mode */
  1135.  
  1136.       (void)fprintf(fd,"\n    %c%s=str ",OPT_PREFIX,strsetting[i].name);
  1137.       (void)fprintf(fd,"[%s]",
  1138.         *(strsetting[i].strvalue)? *(strsetting[i].strvalue): "NONE");
  1139.       (void)fprintf(fd,": %s",strsetting[i].explanation);
  1140.     }
  1141.  
  1142.     (void)fprintf(fd,"\nSettings (legal range) [default]:");
  1143.     for(i=0; i<NUM_SETTINGS; i++) {
  1144.  
  1145.       if( !debug_latest &&
  1146.          strncmp(setting[i].explanation,"debug",5) == 0)
  1147.         continue;        /* skip debug settings unless debug mode */
  1148.  
  1149.       (void)fprintf(fd,"\n    %c%s=dd ",OPT_PREFIX,setting[i].name);
  1150.       (void)fprintf(fd,"(%d to %d) ",setting[i].minlimit,
  1151.           setting[i].maxlimit);
  1152.       (void)fprintf(fd,"[%d]",*(setting[i].setvalue));
  1153.       (void)fprintf(fd,": %s",setting[i].explanation);
  1154.     }
  1155.  
  1156.     (void)fprintf(fd,
  1157.     "\n(First %d chars of option name significant)\n",OPT_MATCH_LEN);
  1158. }
  1159.  
  1160.  
  1161. PRIVATE void
  1162. wrapup()    /* look at cross references, etc. */
  1163. {
  1164.     if(debug_hashtab || debug_glob_symtab)
  1165.       debug_symtabs();
  1166.  
  1167.     visit_children();    /* Make call tree & check visited status */
  1168.     check_com_usage();    /* Look for unused common stuff */
  1169.     check_comlists();    /* Look for common block mismatches */
  1170.     check_arglists();    /* Look for subprog defn/call mismatches */
  1171.  
  1172. #ifdef DEBUG_GLOBAL_STRINGS
  1173.     if(debug_latest)
  1174.       print_global_strings();
  1175. #endif
  1176. }
  1177.  
  1178.  
  1179. #define MODE_DEFAULT_EXT 1
  1180. #define MODE_REPLACE_EXT 2
  1181. PRIVATE char *
  1182. append_extension(s,ext,mode)
  1183.      char *s,*ext;
  1184.      int mode;
  1185. {
  1186.         /* MODE_DEFAULT_EXT: Adds extension to file name s if
  1187.            none is present, and returns a pointer to the
  1188.            new name.  If extension was added, space is allocated
  1189.            for the new name.  If not, simply  returns pointer
  1190.            to original name.  MODE_REPLACE_EXT: same, except given
  1191.            extension replaces given one if any.
  1192.         */
  1193.     int i,len;
  1194.     char *newname;
  1195. #ifdef OPTION_PREFIX_SLASH    /* set len=chars to NUL or start of /opt */
  1196.     for(len=0; s[len] != '\0' && s[len] != '/'; len++)
  1197.       continue;
  1198. #else
  1199.     len=(unsigned)strlen(s);
  1200. #endif
  1201.         /* Search backwards till find the dot, but do not
  1202.            search past directory delimiter
  1203.         */
  1204.     for(i=len-1; i>0; i--) {
  1205.         if(s[i] == '.'
  1206. #ifdef UNIX
  1207.            || s[i] == '/'
  1208. #endif
  1209. #ifdef VMS
  1210.            || s[i] == ']' || s[i] == ':'
  1211. #endif
  1212. #ifdef MSDOS
  1213.            || s[i] == '\\' || s[i] == ':'
  1214. #endif
  1215.            )
  1216.         break;
  1217.     }
  1218.  
  1219.     if(mode == MODE_REPLACE_EXT) {
  1220.       if(s[i] == '.')    /* declare length = up to the dot */
  1221.         len = i;
  1222.       newname = (char *) malloc( (unsigned)(len+(unsigned)strlen(ext)+1) );
  1223.       (void)strncpy(newname,s,len);
  1224.       (void)strcpy(newname+len,ext);
  1225.     }
  1226.     else {            /* MODE_DEFAULT_EXT */
  1227. #ifdef OPTION_PREFIX_SLASH
  1228.         /* create new string if new ext or trailing /option */
  1229.       if(s[i] != '.' || s[len] != '\0') {
  1230.         if(s[i] != '.') {    /* no extension given */
  1231.           newname = (char *) malloc( (unsigned)(len+
  1232.                             (unsigned)strlen(ext)+1) );
  1233.           (void)strncpy(newname,s,len);
  1234.           (void)strcpy(newname+len,ext);
  1235.         }
  1236.         else {        /* extension given but /option follows */
  1237.           newname = (char *) malloc( (unsigned)(len+1) );
  1238.           (void)strncpy(newname,s,len);
  1239.         }
  1240.       }
  1241. #else
  1242.       if(s[i] != '.') {
  1243.         newname = (char *) malloc( (unsigned)(len+
  1244.                           (unsigned)strlen(ext)+1) );
  1245.         (void)strcpy(newname,s);
  1246.         (void)strcat(newname,ext);
  1247.       }
  1248. #endif
  1249.       else {
  1250.         newname = s;    /* use as is */
  1251.       }
  1252.     }
  1253.  
  1254.     return newname;
  1255. }
  1256.  
  1257.         /* Adds default extension to source file name, replacing
  1258.            any that is present, and returns a pointer to the
  1259.            new name.  Space is allocated for the new name.
  1260.         */
  1261. #ifndef VMS_INCLUDE
  1262. PRIVATE
  1263. #endif
  1264. char *
  1265. add_ext(s,ext)            /* adds default filename extension to s */
  1266.     char *s,*ext;
  1267. {
  1268.   return append_extension(s,ext,MODE_DEFAULT_EXT);
  1269. }
  1270.  
  1271. PRIVATE char *
  1272. new_ext(s,ext)
  1273.     char *s,*ext;
  1274. {
  1275.   return append_extension(s,ext,MODE_REPLACE_EXT);
  1276. }
  1277.  
  1278.  
  1279. PRIVATE int
  1280. cistrncmp(s1,s2,n)            /* case-insensitive strncmp */
  1281.      char *s1,*s2;
  1282.      unsigned n;
  1283. {
  1284.   while( n != 0 &&
  1285.       (isupper(*s1)?tolower(*s1):*s1) == (isupper(*s2)?tolower(*s2):*s2) ) {
  1286.     if(*s1 == '\0')
  1287.       return 0;
  1288.     if(*s2 == '\0')
  1289.       break;
  1290.     ++s1; ++s2; --n;
  1291.   }
  1292.   return n==0? 0: *s1 - *s2;
  1293. }
  1294.  
  1295. #ifndef VMS_INCLUDE
  1296. PRIVATE
  1297. #endif
  1298. int
  1299. has_extension(name,ext)        /* true if name ends in ext */
  1300.   char *name,*ext;
  1301. {
  1302.   unsigned name_len, ext_len;
  1303.   int stem_len;
  1304.   ext_len = strlen(ext);
  1305.  
  1306. #ifdef VMS    /* shell_glob adds version number: filename.ext;1 */
  1307.   if(strrchr(name,';') != NULL) {
  1308.     name_len = strrchr(name,';') - name; /* distance to the semicolon */
  1309.   }
  1310.   else
  1311. #endif
  1312.     name_len=strlen(name);    /* distance to the null */
  1313.  
  1314.   stem_len = (unsigned)(name_len - ext_len); /* distance to the dot */
  1315.  
  1316.   if( stem_len >= 0 &&
  1317.      (name_len-stem_len) == ext_len &&
  1318.      cistrncmp(name+stem_len,ext,ext_len) == 0 )
  1319.     return TRUE;
  1320.   else
  1321.     return FALSE;
  1322. }
  1323.  
  1324.         /* Add an include directory path to list of paths */
  1325. #ifdef ALLOW_INCLUDE
  1326. PRIVATE void
  1327. append_include_path(new_path)
  1328.      char *new_path;
  1329. {
  1330.   IncludePathNode *new_path_node, *p;
  1331.   if((new_path_node=(IncludePathNode *)malloc(sizeof(IncludePathNode)))
  1332.      ==(IncludePathNode *)NULL) {
  1333.     (void)fflush(list_fd);
  1334.     (void)fprintf(stderr,"\nmalloc error getting path list");
  1335.   }
  1336.   else {
  1337.     new_path_node->link = (IncludePathNode *)NULL;
  1338.     new_path_node->include_path = new_path;
  1339.                 /* Append the new node at end of list */
  1340.     if((p=include_path_list) == (IncludePathNode *)NULL)
  1341.       include_path_list = new_path_node;
  1342.     else {
  1343.       while(p->link != (IncludePathNode *)NULL)
  1344.     p = p->link;
  1345.       p->link = new_path_node;
  1346.     }
  1347.   }
  1348. }
  1349. #endif/*ALLOW_INCLUDE*/
  1350.  
  1351. PRIVATE void
  1352. resource_summary()
  1353. {
  1354. #ifdef DEBUG_SIZES
  1355.   if(debug_latest)
  1356.     print_sizeofs();    /* give sizeof various things */
  1357. #endif
  1358.  
  1359.   (void)fprintf(list_fd,
  1360.    "\n     Here are the amounts of ftnchek's resources that were used:\n");
  1361.  
  1362.   (void)fprintf(list_fd,
  1363.    "\nSource lines processed = %lu statement + %lu comment = %lu total",
  1364.         tot_stmt_line_count,
  1365.         tot_line_count-tot_stmt_line_count, /*tot_comment_line_count*/
  1366.         tot_line_count);
  1367.  
  1368.   (void)fprintf(list_fd,
  1369.    "\nTotal executable statements = %lu, max in any module = %lu",
  1370.         tot_exec_stmt_count,
  1371.         max_exec_stmt_count);
  1372.  
  1373.   (void)fprintf(list_fd,
  1374.    "\nTotal number of modules in program = %lu",
  1375.         tot_module_count);
  1376.  
  1377.   (void)fprintf(list_fd,
  1378.    "\nMax identifier name chars used = %lu local, %lu global, chunk size %lu",
  1379.             max_loc_strings,
  1380.             glob_strings_used,
  1381.             (unsigned long)STRSPACESZ);
  1382.   (void)fprintf(list_fd,
  1383.     "\nMax token text chars used = %lu, chunk size %lu ",
  1384.             max_srctextspace,
  1385.             (unsigned long)STRSPACESZ);
  1386.   (void)fprintf(list_fd,
  1387.     "\nMax local symbols used =  %lu out of %lu available",
  1388.             max_loc_symtab,
  1389.             (unsigned long)LOCSYMTABSZ);
  1390.   (void)fprintf(list_fd,
  1391.     "\nMax global symbols used = %lu out of %lu available",
  1392.             max_glob_symtab,
  1393.             (unsigned long)GLOBSYMTABSZ);
  1394.   (void)fprintf(list_fd,
  1395.     "\nMax number of parameter info fields used = %lu, chunk size = %lu",
  1396.             max_paraminfo,
  1397.             (unsigned long)PARAMINFOSPACESZ);
  1398.   (void)fprintf(list_fd,
  1399.     "\nMax number of tokenlists used = %lu, chunk size = %lu",
  1400.             max_tokenlists,
  1401.             (unsigned long)TOKHEADSPACESZ);
  1402.   (void)fprintf(list_fd,
  1403.     "\nMax token list/tree space used = %lu, chunk size = %lu",
  1404.             max_token_space,
  1405.             (unsigned long)TOKENSPACESZ);
  1406.   (void)fprintf(list_fd,
  1407.     "\nNumber of subprogram invocations = %lu totaling %lu args",
  1408.             arglist_head_used,
  1409.             arglist_element_used);
  1410.   (void)fprintf(list_fd,
  1411.     "\nArgument list header and element chunk sizes = %lu and %lu",
  1412.             (unsigned long)ARGLISTHEADSZ,
  1413.             (unsigned long)ARGLISTELTSZ);
  1414.   (void)fprintf(list_fd,
  1415.     "\nNumber of common block decls = %lu totaling %lu variables",
  1416.             comlist_head_used,
  1417.             comlist_element_used);
  1418.   (void)fprintf(list_fd,
  1419.     "\nCommon list header and element chunk sizes = %lu and %lu",
  1420.             (unsigned long)COMLISTHEADSZ,
  1421.             (unsigned long)COMLISTELTSZ);
  1422.   (void)fprintf(list_fd,
  1423.     "\nNumber of array dim ptrs used = %lu, chunk size = %lu",
  1424.             max_ptrspace,
  1425.             (unsigned long)PTRSPACESZ);
  1426.  
  1427. #ifdef DEBUG_SIZES
  1428.   (void)fprintf(list_fd,
  1429.     "\nIdentifier hashtable size = %6lu",
  1430.             (unsigned long)HASHSZ);
  1431. #ifdef KEY_HASH/* not used any more*/
  1432.   (void)fprintf(list_fd,
  1433.     "\nKeyword hashtable size = %6lu",
  1434.             (unsigned long)KEYHASHSZ);
  1435. #endif
  1436. #ifdef COUNT_REHASHES
  1437.   (void)fprintf(list_fd,
  1438.     "\nIdentifier rehash count = %6lu",
  1439.             rehash_count);
  1440. #endif
  1441.   (void)fprintf(list_fd,
  1442.     "\nIntrinsic function hashtable size=%6lu, clash count=%lu",
  1443.             (unsigned long)INTRINS_HASHSZ,
  1444.             intrins_clashes);
  1445. #endif /*DEBUG_SIZES*/
  1446.  
  1447.   (void)fprintf(list_fd,"\n\n");
  1448. }
  1449.