home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / FTNCHK32.ZIP / ftnchek.c < prev    next >
C/C++ Source or Header  |  1993-02-16  |  28KB  |  1,023 lines

  1. /*  ftnchek.c:
  2.  
  3.     Main program for Fortran Syntax Checker.
  4.  
  5.     Copyright (C) 1992 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. #define MAIN
  27. #include "ftnchek.h"
  28.  
  29. char *getenv(),*malloc();
  30. void exit();
  31.  
  32. PRIVATE void src_file_in(),
  33. error_message(), error_summary(), get_env_options(),
  34. make_env_name(), set_option(), list_options(), open_outfile(),
  35. resource_summary(), wrapup();
  36. #ifdef ALLOW_INCLUDE
  37. PRIVATE void append_include_path();
  38. #endif
  39.  
  40. PRIVATE int read_setting();
  41.  
  42. PRIVATE int project_file_input,    /* true if input is from .prj file */
  43.         full_output;    /* = (verbose || do_list | do_symtab) */
  44.  
  45. unsigned long intrins_clashes;    /* count of intrinsic hashtable clashes */
  46. #ifdef COUNT_REHASHES
  47. extern unsigned long rehash_count; /* count of calls to rehash() */
  48. #endif
  49.  
  50.     /* Here we define the commandline options.  Most options are boolean
  51.        switchopts, with "no" prefix to unset them.  Others (called
  52.        settings) are numeric quantities, defined using "=num".
  53.        A third category (strsettings) are string quantities, eg filenames.
  54.        The argument "?" will cause list of options to be printed out.
  55.        For VMS, options can be prefixed with either "-" or "/",
  56.        but messages will use the canonical form. */
  57.  
  58. #ifdef OPTION_PREFIX_SLASH
  59. #define OPT_PREFIX '/'    /* Canonical VMS prefix for commandline options */
  60. #else
  61. #define OPT_PREFIX '-'    /* Canonical Unix prefix for commandline options */
  62. #endif
  63.  
  64. #define OPT_MATCH_LEN 3    /* Options are matched only in 1st 3 chars */
  65. #define NUM_SWITCHES (sizeof(switchopt)/sizeof(switchopt[0]))
  66. #define NUM_SETTINGS (sizeof(setting)/sizeof(setting[0]))
  67. #define NUM_STRSETTINGS (sizeof(strsetting)/sizeof(strsetting[0]))
  68.  
  69. /*    Option definitions:
  70.        New options can be added to lists by inserting definition
  71.        here using same syntax as others, and declaring the variable
  72.        with OPT(type,name,default); in ftnchek.h.  No other changes
  73.        needed.
  74. */
  75.  
  76.  
  77.         /* List of switches is defined first.  Each entry gives the
  78.            name and the corresponding flag variable to be set
  79.            or cleared.  See set_option() for processing of switches.
  80.  
  81.            N.B. list_options() will suppress printing of any options
  82.            whose explanation starts with "debug" unless the -debug
  83.            switch was previously given.
  84.          */
  85. struct {
  86.     char *name;
  87.     int *switchflag;
  88.     char *explanation;
  89. } switchopt[]={
  90.     {"calltree",    &print_call_tree,"print subprogram call tree"},
  91.     {"declare",    &decls_required,"list undeclared variables"},
  92.     {"division",    &div_check,    "catch possible div by 0"},
  93.     {"extern",    &ext_def_check,    "check if externals defined"},
  94.     {"f77",        &f77_standard,    "warn of nonstandard constructs"},
  95.     {"help",    &help_screen,    "print help screen"},
  96.     {"hollerith",    &hollerith_check,"warn about holleriths under -port"},
  97.     {"library",    &library_mode,    "treat next files as library"},
  98.     {"linebreak",    &eol_is_space,    "treat linebreaks as space"},
  99.     {"list",    &do_list,    "print program listing"},
  100.     {"novice",    &novice_help,    "extra help for novices"},
  101.     {"portability",    &port_check,    "check for portability problems"},
  102.     {"pretty",    &pretty_flag,    "warn of deceiving appearances"},
  103.     {"project",    &make_project_file,    "create project file"},
  104.     {"pure",    &pure_functions,"functions have no side effects"},
  105.     {"sixchar",    &sixclash,    "catch nonunique names"},
  106.     {"symtab",    &do_symtab,    "print symbol table info"},
  107.     {"truncation",    &trunc_check,    "check for truncation pitfalls"},
  108.     {"verbose",    &verbose,    "verbose output"},
  109.     {"debug",    &debug_latest,    "debug latest code"},
  110.     {"global",    &debug_glob_symtab,    "debug global symtab info"},
  111.     {"grammar",    &debug_parser,    "debug printout in parser"},
  112.     {"hashtable",    &debug_hashtab,    "debug printout of hashtable"},
  113.     {"local",    &debug_loc_symtab,    "debug local symtab info"},
  114.     {"resources",    &show_resources,"debug info on resources"},
  115.     {"tokens",    &debug_lexer,    "debug printout in lexer"},
  116. #ifdef YYDEBUG
  117.     {"yydebug",    &yydebug,    "debug via yydebug"},
  118. #endif
  119. };
  120.  
  121.  
  122.         /* List of settings is defined here. Each entry gives
  123.            the name, the corresponding variable, the range
  124.            of permitted values, the value for turning it off,
  125.            followed by brief explanation.
  126.            See set_option() for processing. */
  127. struct {
  128.     char *name;
  129.     int *setvalue;
  130.     int minlimit,maxlimit,turnoff;
  131.     char *explanation;
  132. } setting[]={
  133.   {"array",    &array_arg_check, 0, 3, 0,
  134.             "check array args: 0=none 1=dims 2=size 3=all"},
  135.   {"columns",    &max_stmt_col,    1, MAXLINE, 72,
  136.             "max line length processed"},
  137.   {"common",    &comcheck_strictness,  0, 3, 0,
  138.             "common check: 0=none 3=most strict"},
  139.   {"usage",    &usage_check,    0, 3, 0,
  140.             "0=no check, 1=used-not-set 2=unused 3=all"},
  141. };
  142.  
  143.  
  144.         /* List of strsettings is defined here. Each entry gives
  145.            the name the corresponding string variable, and brief
  146.            explanation.  See set_option() for processing. */
  147. struct {
  148.     char *name;
  149.     char **strvalue;
  150.     char *explanation;
  151. } strsetting[]={
  152.   {"output",    &out_fname,    "output file name"},
  153. #ifdef ALLOW_INCLUDE
  154.   {"include",    &include_path,    "include-file directory"},
  155. #endif
  156. };
  157.  
  158. int must_open_outfile=FALSE;    /* Flag set to TRUE when out=name given */
  159.  
  160. int
  161. main(argc,argv)
  162.     int argc;
  163.     char *argv[];
  164. {
  165.     int iarg;
  166.     int filecount=0,actioncount=0;
  167.     char *infile,*srcfile,*projfile;
  168.  
  169.     list_fd = stdout;
  170.     project_fd = (FILE *) NULL;
  171.     error_count = 0;
  172.     warning_count = 0;
  173.  
  174.     get_env_options();
  175. #ifdef ALLOW_INCLUDE
  176.     include_path_list = (IncludePathNode*) NULL;
  177.     if(include_path != (char *)NULL) {
  178.       append_include_path(include_path);
  179.       include_path = (char *)NULL; /* clear it for the next one */
  180.     }
  181. #endif
  182.  
  183.     init_keyhashtab();        /* Initialize tables */
  184.     intrins_clashes = init_intrins_hashtab();
  185.     init_globals();
  186.     init_symtab();
  187.  
  188.     for(iarg=1; iarg < argc; iarg++) {
  189.  
  190.       int argchar=0;/* location of start of option */
  191. #ifdef OPTION_PREFIX_SLASH
  192.       do {            /* loop on flags within argv[iarg] */
  193. #endif
  194.         if( argv[iarg][argchar] == '-'
  195. #ifdef OPTION_PREFIX_SLASH
  196.          || argv[iarg][argchar] == '/'    /* Allow VMS /option form */
  197. #endif
  198.                      ) {
  199.             /* Process flags here */
  200.  
  201.         set_option(&argv[iarg][argchar]);
  202.  
  203.                 /* Handle -help option right here */
  204.         if(help_screen) {
  205.           ++actioncount;
  206.           help_screen = FALSE;
  207.           list_options(list_fd);
  208.         }
  209. #ifdef ALLOW_INCLUDE
  210.         else if(include_path != (char *)NULL) {
  211.             append_include_path(include_path);
  212.             include_path = (char *)NULL;
  213.         }
  214. #endif
  215.  
  216.         }/*end of processing options*/
  217.  
  218.         else {    /* Process '?' and file arguments */
  219.  
  220.             full_output = verbose || do_list || do_symtab;
  221.  
  222.         if( must_open_outfile )
  223.             open_outfile(out_fname);
  224.  
  225.         if(actioncount == 0) {
  226.             fprintf(list_fd,"%s%s%s",
  227.                 full_output?"\n":"",
  228.                 VERSION_NUMBER,
  229.                 full_output?"\n":"");
  230.         }
  231.         ++actioncount;    /* Cause exit w/o reading stdin below */
  232.  
  233.         if(strcmp(&argv[iarg][argchar],"?") == 0) {
  234.             list_options(list_fd);
  235.         }
  236.         else {        /* Process files here */
  237.             ++filecount;
  238.  
  239.             srcfile = add_ext(&argv[iarg][argchar],DEF_SRC_EXTENSION);
  240.             projfile = new_ext(&argv[iarg][argchar],DEF_PROJ_EXTENSION);
  241.  
  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.             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")) == NULL ) {
  255.             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")) == NULL) {
  268.             infile = srcfile;
  269.             if( (input_fd = fopen(infile,"r")) == NULL ) {
  270.               fprintf(stderr,"Cannot open file %s\n",infile);
  271.               goto next_arg;
  272.             }
  273.             project_file_input =
  274.               has_extension(infile,DEF_PROJ_EXTENSION);
  275.               }
  276.               else {
  277.             infile = projfile;
  278.             project_file_input = TRUE;
  279.               }
  280.             }
  281.  
  282.                 /* Always print input .f file name.  If
  283.                    verbose mode, print .prj file names too.
  284.                    In verbose mode, add blank line
  285.                    and after file name. */
  286.             if(verbose || !project_file_input)
  287.               fprintf(list_fd,"\nFile %s:%s",
  288.                   infile,
  289.                   full_output?"\n":""
  290.                   );
  291.  
  292.                 /* In verbose mode, print .prj output
  293.                    file name to stderr.  Always print
  294.                    error message if couldn't open it. */
  295.             if( make_project_file ) {
  296.               if(project_fd != NULL) {
  297.             if(verbose)
  298.               fprintf(stderr,
  299.                   "\nProject file is %s\n",projfile);
  300.               }
  301.               else {
  302.             fprintf(stderr,
  303.                 "\nCannot open %s for output\n",projfile);
  304.               }
  305.             }
  306.  
  307.  
  308.             if(project_file_input) {
  309.  
  310.             proj_file_in(input_fd);
  311.  
  312.             }
  313.             else {
  314.  
  315.               src_file_in(infile);
  316.  
  317.             }
  318.  
  319.             (void) fclose(input_fd);
  320.           }
  321.  
  322.           }/*end processing file args*/
  323. next_arg:
  324. #ifdef OPTION_PREFIX_SLASH
  325.                 /* Here we allow /opts to be stuck together */
  326.         while(argv[iarg][++argchar] != '\0'
  327.          && argv[iarg][argchar] != '/') /* look for next opt */
  328.           continue;
  329.  
  330.       } while(argv[iarg][argchar] != '\0'); /*end do-while*/
  331. #else
  332.       continue;
  333. #endif
  334.     }    /* end for-loop on argument list */
  335.  
  336.     if(actioncount == 0) {        /* No files given: read stdin */
  337.             full_output = verbose || do_list || do_symtab;
  338.  
  339.             fprintf(list_fd,"%s%s%s",
  340.             full_output?"\n":"",
  341.             VERSION_NUMBER,
  342.             full_output?"\n":"");
  343.  
  344.         if( must_open_outfile )
  345.             open_outfile(out_fname);
  346.  
  347.         if(make_project_file) {
  348.               projfile = STDIN_PROJ_FILENAME;
  349.               if( (project_fd = fopen(projfile,"w")) == NULL) {
  350.             fprintf(stderr,
  351.                 "\nCannot open %s for output\n",projfile);
  352.               }
  353.               else {
  354.             if(verbose)
  355.               fprintf(stderr,
  356.                 "\nProject file is %s\n",projfile);
  357.               }
  358.         }
  359.  
  360.         ++filecount;
  361.         input_fd = stdin;
  362.  
  363.         src_file_in("std_input");
  364.     }
  365.     if(filecount > 0)
  366.       wrapup();
  367.     fprintf(list_fd,"\n");
  368.  
  369.     if(show_resources)
  370.         resource_summary();
  371.  
  372.     exit(0);
  373.     return 0;/* make lint happy */
  374. }
  375.  
  376. PRIVATE void
  377. src_file_in(infile)
  378.      char *infile;        /* input filename */
  379. {
  380.     note_filename(infile);
  381.  
  382.     init_scan();
  383.     init_parser();
  384.  
  385.     (void) yyparse();
  386.  
  387.     finish_scan();
  388.  
  389.     if(make_project_file) {
  390.           proj_file_out(project_fd);
  391.           (void) fclose(project_fd);
  392.     }
  393.  
  394.     error_summary(infile);
  395. }
  396.  
  397.  
  398. PRIVATE void
  399. error_summary(fname)        /* Print out count of errors in file */
  400.     char *fname;
  401. {
  402.     FILE *fd = list_fd;
  403.  
  404.     if(full_output)
  405.       fprintf(fd,"\n");
  406.  
  407.     if(port_check && tab_count != 0) {
  408.         ++warning_count;
  409.         fprintf(list_fd,
  410.         "\n Warning: file contains tabs.  May not be portable.\n");
  411.     }
  412.  
  413.     if(full_output || error_count != 0)
  414.       fprintf(fd,"\n %u syntax error%s detected in file %s",
  415.             error_count, error_count==1? "":"s",
  416.             fname);
  417.  
  418.     if(warning_count != 0)
  419.         fprintf(fd,"\n %u warning%s issued in file %s",
  420.             warning_count, warning_count==1? "":"s",
  421.             fname);
  422.     if(full_output)
  423.       fprintf(fd,"\n");
  424.  
  425.     error_count = 0;
  426.     warning_count = 0;
  427. }
  428.  
  429. void
  430. print_a_line(fd,line,num)  /* Print source line with line number */
  431.     FILE *fd;
  432.     char *line;
  433.     unsigned num;
  434. {
  435.     fprintf(fd,"\n %6u %s",num,line);
  436. }
  437.  
  438.  
  439. void
  440. yyerror(s)
  441.     char *s;
  442. {
  443.     syntax_error(line_num,col_num,s);
  444. }
  445.  
  446.  
  447. void
  448. syntax_error(lineno,colno,s)        /* Syntax error message */
  449.     unsigned lineno,colno;
  450.     char *s;
  451. {
  452.     ++error_count;
  453.     error_message(lineno,colno,s,"Error");
  454. }
  455.  
  456. PRIVATE void
  457. error_message(lineno,colno,s,tag)
  458.     unsigned lineno,colno;
  459.     char *s,*tag;
  460. {
  461.     int icol;
  462.     extern unsigned prev_stmt_line_num; /* shared with advance.c */
  463.  
  464.             /* Print the character ^ under the column number.
  465.                But if colno == 0, error occurred in prior line.
  466.                If colno is NO_COL_NUM, then print message
  467.                without any column number given.
  468.              */
  469.  
  470.         if(colno == NO_COL_NUM) {
  471.             /* colno == NO_COL_NUM means don't give column number.*/
  472.         (void)flush_line_out(lineno);/* print line if not printed yet */
  473.         fprintf(list_fd,
  474.            "\n%s near line %u",tag,lineno);
  475.         }
  476.         else if(colno != 0) {
  477.             /* print line if not printed yet */
  478.         if( flush_line_out(lineno) ) {
  479.                 /* If it was printed, put ^ under the col */
  480.             fprintf(list_fd,"\n%8s","");
  481.  
  482.             for(icol=1; icol<colno; icol++)
  483.             fprintf(list_fd," ");
  484.             fprintf(list_fd,"^");
  485.         }
  486.         fprintf(list_fd,
  487.            "\n%s near line %u col %u",tag,lineno,colno);
  488.         }
  489.         else {        /* colno == 0 */
  490.             /* print line if not printed yet */
  491.         (void) flush_line_out(prev_stmt_line_num);
  492.         fprintf(list_fd,
  493.            "\n%s near line %u",tag,prev_stmt_line_num);
  494.         }
  495.  
  496.     if(incdepth > 0)    /* Append include-file name if we are in one */
  497.       fprintf(list_fd," file %s",current_filename);
  498.  
  499.     fprintf(list_fd,": %s",s); /* now append the message string */
  500. }
  501.  
  502.  
  503. void
  504. msg_tail(s)
  505.     char *s;
  506. {
  507.     fprintf(list_fd," %s",s);
  508. }
  509. void
  510. warning(lineno,colno,s)        /* Print warning message */
  511.     unsigned lineno,colno;
  512.     char *s;
  513. {
  514.     ++warning_count;
  515.  
  516.     error_message(lineno,colno,s,"Warning");
  517. }
  518.  
  519. void
  520. nonstandard(lineno,colno)
  521.      unsigned lineno,colno;
  522. {
  523.     ++warning_count;
  524.     error_message(lineno,colno,"Nonstandard syntax","Warning");
  525. }
  526.  
  527. void
  528. nonportable(lineno,colno,s) /* Print warning about nonportable construction */
  529.     unsigned lineno,colno;
  530.     char *s;
  531. {
  532.     ++warning_count;
  533.     error_message(lineno,colno,s,"Nonportable usage");
  534. }
  535.  
  536. /*    get_env_options picks up any options defined in the
  537.     environment.  A switch or setting is defined according to
  538.     the value of an environment variable whose name is the switch
  539.     or setting name (uppercased), prefixed by the string
  540.     ENV_PREFIX (e.g.  FTNCHEK_).  For settings and strsettings,
  541.     the value of the environment variable gives the value to be
  542.     used.  For switches, the environment variable is set to "0" or
  543.     "NO" to turn the switch off, or to any other value (including
  544.     null) to turn it on.
  545. */
  546.  
  547. PRIVATE void
  548. get_env_options()
  549. {
  550.     char env_option_name[32];
  551.     char *value;
  552.     int i;
  553.     for(i=0; i<NUM_SWITCHES; i++) {
  554.             /* Construct the env variable name for switch i */
  555.         make_env_name( env_option_name, switchopt[i].name);
  556.  
  557.             /* See if it is defined */
  558.         if( (value = getenv(env_option_name)) != (char *)NULL) {
  559.             *(switchopt[i].switchflag) =
  560.             !(strcmp(value,"0")==0 || strcmp(value,"NO")==0 );
  561.         }
  562.  
  563.     }
  564.  
  565.     for(i=0; i<NUM_SETTINGS; i++) {
  566.             /* Construct the env variable name for setting i */
  567.         make_env_name( env_option_name, setting[i].name);
  568.             /* See if it is defined */
  569.         if( (value = getenv(env_option_name)) != (char *)NULL) {
  570.         if(read_setting(value, setting[i].setvalue, setting[i].name,
  571.                 setting[i].minlimit, setting[i].maxlimit,
  572.                 setting[i].turnoff) != 0)
  573.             fprintf(stderr,"Env setting garbled: %s=%s: ignored\n",
  574.                 env_option_name,value);
  575.         }
  576.     }
  577.  
  578.  
  579.     for(i=0; i<NUM_STRSETTINGS; i++) {
  580.             /* Construct the env variable name for setting i */
  581.         make_env_name( env_option_name, strsetting[i].name);
  582.             /* See if it is defined */
  583.         if( (value = getenv(env_option_name)) != (char *)NULL) {
  584.             *(strsetting[i].strvalue) = value;
  585.  
  586.             /* Handle necessary action for  -out=listfile */
  587.         if(strsetting[i].strvalue == &out_fname)
  588.             must_open_outfile = TRUE;
  589.         }
  590.     }
  591. }
  592.  
  593.         /* Routine to concatenate ENV_PREFIX onto option name
  594.            and uppercase the result.
  595.         */
  596. PRIVATE void
  597. make_env_name( env_name, option_name)
  598.     char *env_name, *option_name;
  599. {
  600.     int i,c;
  601.  
  602.     strcat(strcpy(env_name,ENV_PREFIX),option_name);
  603.     for(i=sizeof(ENV_PREFIX)-1; (c=env_name[i]) != '\0'; i++) {
  604.     if( islower(c) )
  605.         env_name[i] = toupper(c);
  606.     }
  607. }
  608.  
  609.  
  610.     /* set_option processes an option from command line.  Argument s is
  611.        the option string. First s is compared against boolean switches
  612.        from list in switchopt[].  If s matches switch string,
  613.        corresponding flag is set to TRUE.  If no match, then s is compared
  614.        to the same switches prefixed by "no", and if match is found, then
  615.        flag is set to FALSE.  Finally, special flags are handled.  If still
  616.        no match, an error message is generated.
  617.      */
  618.  
  619. PRIVATE void
  620. set_option(s)
  621.     char *s;
  622. {
  623.     int i;
  624.         /* look for noswitch flags first since otherwise
  625.            an option starting with no might take precedence */
  626.     if(strncmp(s+1,"no",2) == 0) {
  627.         for(i=0; i<NUM_SWITCHES; i++) {
  628.         if( strncmp(s+3,switchopt[i].name,OPT_MATCH_LEN) == 0) {
  629.             *(switchopt[i].switchflag) = FALSE;
  630.             return;
  631.         }
  632.         }
  633.     }
  634.  
  635.         /* -noswitch not found: look for nosetting flag */
  636.     if(strncmp(s+1,"no",2) == 0) {
  637.         for(i=0; i<NUM_SETTINGS; i++) {
  638.         if( strncmp(s+3,setting[i].name,OPT_MATCH_LEN) == 0) {
  639.             *(setting[i].setvalue) = setting[i].turnoff;
  640.             return;
  641.         }
  642.         }
  643.     }
  644.  
  645.                 /* Next look for switches */
  646.     for(i=0; i<NUM_SWITCHES; i++) {
  647.         if( strncmp(s+1,switchopt[i].name,OPT_MATCH_LEN) == 0) {
  648.         *(switchopt[i].switchflag) = TRUE;
  649.         return;
  650.         }
  651.     }
  652.  
  653.         /* Handle settings of form "-opt=number" */
  654.     for(i=0; i<NUM_SETTINGS; i++)
  655.         if( strncmp(s+1,setting[i].name,OPT_MATCH_LEN) == 0) {
  656.         char *numstr;
  657.  
  658.         numstr = s + (OPT_MATCH_LEN + 1);
  659.         while(*numstr != '\0')
  660.             if(*numstr++ == '=')    /* Find the = sign */
  661.             break;
  662.  
  663.         if(read_setting(numstr, setting[i].setvalue, setting[i].name,
  664.                 setting[i].minlimit, setting[i].maxlimit,
  665.                 setting[i].turnoff) != 0)
  666.             fprintf(stderr,"Setting garbled: %s: ignored\n",s);
  667.         return;
  668.         }
  669.  
  670.  
  671.         /* Handle settings of form "-opt=string" */
  672.     for(i=0; i<NUM_STRSETTINGS; i++)
  673.         if( strncmp(s+1,strsetting[i].name,OPT_MATCH_LEN) == 0) {
  674.         char *strstart;
  675. #ifdef OPTION_PREFIX_SLASH
  676.         int numchars;
  677. #endif
  678.         strstart = s + (OPT_MATCH_LEN + 1);
  679.         while(*strstart != '=' && *strstart != '\0')
  680.             strstart++;    /* Find the = sign */
  681.         if(*strstart == '\0') {
  682.             fprintf(stderr,"String setting missing: %s: ignored\n",s);
  683.             return;
  684.         }
  685.         else {
  686.             *(strsetting[i].strvalue) = ++strstart;
  687.                 /* In VMS,MSDOS worlds, user might not leave
  688.                    blank space between options.  If string
  689.                    is followed by '/', must make a properly
  690.                    terminated copy.  */
  691. #ifdef OPTION_PREFIX_SLASH
  692.             for(numchars=0; strstart[numchars] != '\0'
  693.             && strstart[numchars] != '/'; numchars++)
  694.               continue;
  695.             if(strstart[numchars] != '\0') {
  696.               strncpy( *(strsetting[i].strvalue)=malloc(numchars+1),
  697.                    strstart,numchars);
  698.             }
  699. #endif
  700.  
  701.         }
  702.             /* Handle necessary action for  -out=listfile */
  703.         if(strsetting[i].strvalue == &out_fname) {
  704.             must_open_outfile = TRUE;
  705.         }
  706.         return;
  707.         }
  708.  
  709.  
  710.         /* No match found: issue error message */
  711.  
  712.     fprintf(stderr,"\nUnknown commandline switch: %s\n",s);
  713. }
  714.  
  715.  
  716.     /* Routine to read integer setting from string s and check if valid */
  717.  
  718. PRIVATE int
  719. read_setting(s, setvalue, name, minlimit, maxlimit, turnoff)
  720.     char *s;
  721.     int *setvalue;
  722.     char *name;
  723.     int minlimit, maxlimit, turnoff;
  724. {
  725.     int given_val;
  726.  
  727.     if(strcmp(s,"NO")==0) {
  728.       *(setvalue) = turnoff;
  729.     }
  730.     else if(*s == '\0' || sscanf(s,"%d", &given_val) == 0) {
  731.         return -1;    /* error return: garbled setting */
  732.     }
  733.     else {        /* If outside limits, set to nearest limit */
  734.         int Ok=TRUE;
  735.         if(given_val < minlimit) {
  736.         given_val = minlimit;
  737.         Ok = FALSE;
  738.         }
  739.         else if(given_val > maxlimit) {
  740.         given_val = maxlimit;
  741.         Ok = FALSE;
  742.         }
  743.  
  744.         if(! Ok ) {
  745.         fprintf(stderr,"\nSetting: %s",name);
  746.         fprintf(stderr," outside limits %d to %d",
  747.                 minlimit,maxlimit);
  748.         fprintf(stderr,": set to %d\n",given_val);
  749.         }
  750.  
  751.         *(setvalue) = given_val;
  752.     }
  753.     return 0;
  754. }
  755.  
  756. PRIVATE void
  757. open_outfile(s)        /* open the output file for listing */
  758.     char *s;
  759. {
  760.     char *fullname;        /* given name plus extension */
  761.     FILE *fd;
  762.  
  763.     must_open_outfile = FALSE;    /* Turn off the flag */
  764.  
  765.     if(s == (char *) NULL || *s == '\0') {
  766.         return;        /* No filename: no action  */
  767.     }
  768.  
  769.     fullname = add_ext(s,DEF_LIST_EXTENSION);
  770.     if( (fd = fopen(fullname,"w")) == NULL) {
  771.         fprintf(stderr,"\nCannot open %s for output\n",fullname);
  772.     }
  773.     else {
  774.         fprintf(stderr,"\nOutput sent to file %s\n",fullname);
  775.         list_fd = fd;
  776.     }
  777. }
  778.  
  779.  
  780. PRIVATE void
  781. list_options(fd)/* List all commandline options, strsettings, and settings */
  782.      FILE *fd;
  783. {
  784.     int i;
  785.         /* Note: Headings say "default" but to be accurate they
  786.            should say "current value".  This would be confusing. */
  787.     fprintf(fd,"\nCommandline options [default]:");
  788.     for(i=0; i<NUM_SWITCHES; i++) {
  789.  
  790.       if( !debug_latest &&
  791.          strncmp(switchopt[i].explanation,"debug",5) == 0)
  792.         continue;        /* skip debug switches unless debug mode */
  793.  
  794.       fprintf(fd,"\n\t%c[no]%s",OPT_PREFIX,switchopt[i].name);
  795.       fprintf(fd," [%s]",*(switchopt[i].switchflag)? "yes": "no");
  796.       fprintf(fd,": %s",switchopt[i].explanation);
  797.     }
  798.         /* String settings follow switches w/o their own heading */
  799.     for(i=0; i<NUM_STRSETTINGS; i++) {
  800.       if( !debug_latest &&
  801.          strncmp(strsetting[i].explanation,"debug",5) == 0)
  802.         continue;        /* skip debug settings unless debug mode */
  803.  
  804.       fprintf(fd,"\n\t%c%s=str ",OPT_PREFIX,strsetting[i].name);
  805.       fprintf(fd,"[%s]",
  806.           *(strsetting[i].strvalue)? *(strsetting[i].strvalue): "NONE");
  807.       fprintf(fd,": %s",strsetting[i].explanation);
  808.     }
  809.  
  810.     fprintf(fd,"\nSettings (legal range) [default]:");
  811.     for(i=0; i<NUM_SETTINGS; i++) {
  812.  
  813.       if( !debug_latest &&
  814.          strncmp(setting[i].explanation,"debug",5) == 0)
  815.         continue;        /* skip debug settings unless debug mode */
  816.  
  817.       fprintf(fd,"\n\t%c%s=dd ",OPT_PREFIX,setting[i].name);
  818.       fprintf(fd,"(%d to %d) ",setting[i].minlimit,
  819.           setting[i].maxlimit);
  820.       fprintf(fd,"[%d]",*(setting[i].setvalue));
  821.       fprintf(fd,": %s",setting[i].explanation);
  822.     }
  823.  
  824.     fprintf(fd,
  825.         "\n(First %d chars of option name significant)",OPT_MATCH_LEN);
  826. }
  827.  
  828.  
  829. PRIVATE void
  830. wrapup()    /* look at cross references, etc. */
  831. {
  832.     if(debug_hashtab || debug_glob_symtab)
  833.       debug_symtabs();
  834.  
  835.     visit_children();    /* Make call tree & check visited status */
  836.     check_comlists();    /* Look for common block mismatches */
  837.     check_arglists();    /* Look for subprog defn/call mismatches */
  838. }
  839.  
  840.  
  841. #define MODE_DEFAULT_EXT 1
  842. #define MODE_REPLACE_EXT 2
  843. PRIVATE char *
  844. append_extension(s,ext,mode)
  845.      char *s,*ext;
  846.      int mode;
  847. {
  848.         /* MODE_DEFAULT_EXT: Adds extension to file name s if
  849.            none is present, and returns a pointer to the
  850.            new name.  If extension was added, space is allocated
  851.            for the new name.  If not, simply  returns pointer
  852.            to original name.  MODE_REPLACE_EXT: same, except given
  853.            extension replaces given one if any.
  854.         */
  855.     int i,len;
  856.     char *newname;
  857. #ifdef OPTION_PREFIX_SLASH    /* set len=chars to NUL or start of /opt */
  858.     for(len=0; s[len] != '\0' && s[len] != '/'; len++)
  859.       continue;
  860. #else
  861.     len=strlen(s);
  862. #endif
  863.         /* Search backwards till find the dot, but do not
  864.            search past directory delimiter
  865.         */
  866.     for(i=len-1; i>0; i--) {
  867.         if(s[i] == '.'
  868. #ifdef UNIX
  869.            || s[i] == '/'
  870. #endif
  871. #ifdef VMS
  872.            || s[i] == ']' || s[i] == ':'
  873. #endif
  874. #ifdef MSDOS
  875.            || s[i] == '\\' || s[i] == ':'
  876. #endif
  877.            )
  878.         break;
  879.     }
  880.  
  881.     if(mode == MODE_REPLACE_EXT) {
  882.       if(s[i] == '.')    /* declare length = up to the dot */
  883.         len = i;
  884.       newname = (char *) malloc( (unsigned)(len+strlen(ext)+1) );
  885.       (void)strncpy(newname,s,len);
  886.       (void)strcpy(newname+len,ext);
  887.     }
  888.     else {            /* MODE_DEFAULT_EXT */
  889. #ifdef OPTION_PREFIX_SLASH
  890.         /* create new string if new ext or trailing /option */
  891.       if(s[i] != '.' || s[len] != '\0') {
  892.         if(s[i] != '.') {    /* no extension given */
  893.           newname = (char *) malloc( (unsigned)(len+strlen(ext)+1) );
  894.           (void)strncpy(newname,s,len);
  895.           (void)strcpy(newname+len,ext);
  896.         }
  897.         else {        /* extension given but /option follows */
  898.           newname = (char *) malloc( (unsigned)(len+1) );
  899.           (void)strncpy(newname,s,len);
  900.         }
  901.       }
  902. #else
  903.       if(s[i] != '.') {
  904.         newname = (char *) malloc( (unsigned)(len+strlen(ext)+1) );
  905.         (void)strcpy(newname,s);
  906.         (void)strcat(newname,ext);
  907.       }
  908. #endif
  909.       else {
  910.         newname = s;    /* use as is */
  911.       }
  912.     }
  913.  
  914.     return newname;
  915. }
  916.  
  917.         /* Adds default extension to source file name, replacing
  918.            any that is present, and returns a pointer to the
  919.            new name.  Space is allocated for the new name.
  920.         */
  921. char *
  922. add_ext(s,ext)            /* adds default filename extension to s */
  923.     char *s,*ext;
  924. {
  925.   return append_extension(s,ext,MODE_DEFAULT_EXT);
  926. }
  927.  
  928. char *
  929. new_ext(s,ext)
  930.     char *s,*ext;
  931. {
  932.   return append_extension(s,ext,MODE_REPLACE_EXT);
  933. }
  934.  
  935.  
  936. PRIVATE int
  937. cistrcmp(s1,s2)            /* case-insensitive strcmp */
  938.      char *s1,*s2;
  939. {
  940.   while( (isupper(*s1)?tolower(*s1):*s1) == (isupper(*s2)?tolower(*s2):*s2) ) {
  941.     if(*s1 == '\0')
  942.       return 0;
  943.     if(*s2 == '\0')
  944.       break;
  945.     ++s1; ++s2;
  946.   }
  947.   return *s1 - *s2;
  948. }
  949.  
  950. int
  951. has_extension(name,ext)        /* true if name ends in ext */
  952.   char *name,*ext;
  953. {
  954.   int stem_len = strlen(name) - strlen(ext);
  955.   if( stem_len >= 0 && cistrcmp(name+stem_len,ext) == 0 )
  956.     return TRUE;
  957.   else
  958.     return FALSE;
  959. }
  960.  
  961.         /* Add an include directory path to list of paths */
  962. #ifdef ALLOW_INCLUDE
  963. PRIVATE void
  964. append_include_path(new_path)
  965.      char *new_path;
  966. {
  967.   IncludePathNode *new_path_node, *p;
  968.   if((new_path_node=(IncludePathNode *)malloc(sizeof(IncludePathNode)))
  969.      ==(IncludePathNode *)NULL)
  970.     fprintf(stderr,"\nmalloc error getting path list");
  971.   else {
  972.     new_path_node->link = (IncludePathNode *)NULL;
  973.     new_path_node->include_path = new_path;
  974.                 /* Append the new node at end of list */
  975.     if((p=include_path_list) == (IncludePathNode *)NULL)
  976.       include_path_list = new_path_node;
  977.     else {
  978.       while(p->link != (IncludePathNode *)NULL)
  979.     p = p->link;
  980.       p->link = new_path_node;
  981.     }
  982.   }
  983. }
  984. #endif/*ALLOW_INCLUDE*/
  985.  
  986. PRIVATE void
  987. resource_summary()
  988. {
  989.         fprintf(list_fd,
  990.     "\nMax namestring space used = %lu local, %lu global out of %lu chars",
  991.             max_loc_strings,
  992.             max_glob_strings,
  993.             (unsigned long)STRSPACESZ);
  994.         fprintf(list_fd,
  995.         "\nMax local symbols used =  %lu out of %lu available",
  996.             max_loc_symtab,
  997.             (unsigned long)LOCSYMTABSZ);
  998.         fprintf(list_fd,
  999.         "\nMax global symbols used = %lu out of %lu available",
  1000.             max_glob_symtab,
  1001.             (unsigned long)GLOBSYMTABSZ);
  1002.         fprintf(list_fd,
  1003.         "\nMax tokenlist space used = %lu out of %lu available",
  1004.             max_token_space,
  1005.             (unsigned long)TOKENSPACESZ);
  1006.         fprintf(list_fd,
  1007.         "\nIdentifier hashtable size = %6lu",
  1008.             (unsigned long)HASHSZ);
  1009.         fprintf(list_fd,
  1010.         "\nKeyword hashtable size = %6lu",
  1011.             (unsigned long)KEYHASHSZ);
  1012. #ifdef COUNT_REHASHES
  1013.         fprintf(list_fd,
  1014.         "\nIdentifier rehash count = %6lu",
  1015.             rehash_count);
  1016. #endif
  1017.         fprintf(list_fd,
  1018.         "\nIntrinsic function hashtable size=%6lu, clash count=%lu",
  1019.             (unsigned long)INTRINS_HASHSZ,
  1020.             intrins_clashes);
  1021.         fprintf(list_fd,"\n\n");
  1022. }
  1023.