home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / fchk294s.zip / ftnchek-2.9.4 / ftnchek.c.distribution < prev    next >
Text File  |  1996-10-04  |  65KB  |  2,295 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. #else
  35. PROTO( int unlink,( const char *pathname ) );
  36. #endif
  37.  
  38.                 /* Define warn_option_list struct here */
  39. typedef struct {
  40.   char *name;
  41.   int *flag;
  42.   char *explanation;
  43. } WarnOptionList;
  44.  
  45. typedef struct {
  46.     char *name;
  47.     char **strvalue;
  48.     char *turnon, *turnoff;
  49.     WarnOptionList *option_list;
  50.     char *explanation;
  51. } StrsettingList;
  52.  
  53.  
  54. PROTO( char * add_ext,( char *s, char *ext ));
  55.  
  56. PROTO(PRIVATE char * append_extension,( char *s, char *ext, int mode ));
  57.  
  58. PROTO(PRIVATE void append_include_path,( char *new_path ));
  59.  
  60. PROTO(PRIVATE int cistrncmp,( char *s1, char *s2, unsigned n ));
  61.  
  62. PROTO(PRIVATE void error_summary,( char *fname ));
  63.  
  64. PROTO(PRIVATE void error_message,( unsigned lineno, unsigned colno, char *s,
  65.                char *tag ));
  66.  
  67. PROTO(PRIVATE void get_env_options,( void ));
  68.  
  69. PROTO(PRIVATE void get_rc_options,( void ));
  70.  
  71. PROTO(PRIVATE FILE *find_rc,( void ));
  72.  
  73. PROTO( int has_extension,( char *name, char *ext ));
  74.  
  75. PROTO(PRIVATE void lintstyle_error_message,( unsigned lineno, unsigned colno,
  76.                      char *s, char *tag ));
  77.  
  78. PROTO(PRIVATE void list_options,( FILE *fd ));
  79.  
  80. PROTO(PRIVATE void list_warn_options,(WarnOptionList warn_option[]));
  81.  
  82. PROTO(int main,( int argc, char *argv[] ));
  83.  
  84. PROTO(PRIVATE void make_env_name,( char *env_name, char *option_name ));
  85.  
  86. PROTO(PRIVATE char * new_ext,( char *s, char *ext ));
  87.  
  88. PROTO(PRIVATE void oldstyle_error_message,( unsigned lineno, unsigned colno,
  89.                     char *s, char *tag ));
  90.  
  91. PROTO(PRIVATE void open_outfile,( char *s ));
  92.  
  93. #ifdef DEBUG_SIZES
  94. PROTO(extern void print_sizeofs,( void ));    /* in symtab.c */
  95. #endif
  96.  
  97. PROTO(PRIVATE void print_version_number,( void ));
  98.  
  99. PROTO(PRIVATE void process_warn_string,
  100.  ( char *warn_string, WarnOptionList warn_option[] ));
  101.  
  102. PROTO(PRIVATE int read_setting,( char *s, int *setvalue, char *name, int
  103.              minlimit, int maxlimit, int turnoff, int
  104.              turnon, int min_default_value, int
  105.              max_default_value ));
  106.  
  107. PROTO(PRIVATE void resource_summary,( void ));
  108.  
  109. PROTO(PRIVATE void set_option,( char *s, char *where ));
  110.  
  111. PROTO(PRIVATE void set_warn_option,
  112.  ( char *s, WarnOptionList warn_option[] ));
  113.  
  114. PROTO(PRIVATE void src_file_in,( char *infile ));
  115.  
  116. PROTO(PRIVATE void turn_off_checks,( void ));
  117.  
  118. PROTO(PRIVATE void update_str_options,( StrsettingList *strset ));
  119.  
  120. PROTO(PRIVATE void wrapup,( void ));
  121.  
  122.  
  123.  
  124. PRIVATE int project_file_input;    /* true if input is from .prj file */
  125.  
  126. #define full_output    (do_list || do_symtab)
  127.  
  128. PRIVATE unsigned long intrins_clashes;    
  129.                 /* count of intrinsic hashtable clashes */
  130. #ifdef COUNT_REHASHES
  131. extern unsigned long rehash_count; /* count of calls to rehash() */
  132. #endif
  133.  
  134.     /* Here we define the commandline options.  Most options are boolean
  135.        switchopts, with "no" prefix to unset them.  Others (called
  136.        settings) are numeric quantities, defined using "=num".
  137.        A third category (strsettings) are string quantities, eg filenames.
  138.        The argument "?" will cause list of options to be printed out.
  139.        For VMS, options can be prefixed with either "-" or "/",
  140.        but messages will use the canonical form.  Since VMS allows
  141.        options to be smushed together, end-of-option is signalled by
  142.        either NUL or the / of next option.
  143.      */
  144.  
  145. #ifdef OPTION_PREFIX_SLASH
  146. #define OPT_PREFIX '/'    /* Canonical VMS prefix for commandline options */
  147. #define END_OF_OPT( C )  ((C) == '\0' || (C) == '/')
  148. #else
  149. #define OPT_PREFIX '-'    /* Canonical Unix prefix for commandline options */
  150. #define END_OF_OPT( C )  ((C) == '\0')
  151. #endif
  152.  
  153. #define OPT_MATCH_LEN 3    /* Options are matched only in 1st 3 chars */
  154. #define NUM_SWITCHES (sizeof(switchopt)/sizeof(switchopt[0]))
  155. #define NUM_SETTINGS (sizeof(setting)/sizeof(setting[0]))
  156. #define NUM_STRSETTINGS (sizeof(strsetting)/sizeof(strsetting[0]))
  157.  
  158. /*    Option definitions:
  159.        New options can be added to lists by inserting definition
  160.        here using same syntax as others, and declaring the variable
  161.        with OPT(type,name,default); in ftnchek.h.  No other changes
  162.        needed.
  163. */
  164.  
  165.  
  166.         /* List of switches is defined first.  Each entry gives the
  167.            name and the corresponding flag variable to be set
  168.            or cleared.  See set_option() for processing of switches.
  169.  
  170.            N.B. list_options() will suppress printing of any options
  171.            whose explanation starts with "debug" unless the -debug
  172.            switch was previously given.
  173.          */
  174. PRIVATE struct {
  175.     char *name;
  176.     int *switchflag;
  177.     char *explanation;
  178. } switchopt[]={
  179.     {"check",    &do_check,    "perform checking"},
  180.     {"crossref",    &print_xref_list,"print call cross-reference list"},
  181.     {"declare",    &decls_required,"list undeclared variables"},
  182.     {"division",    &div_check,    "catch possible div by 0"},
  183.     {"extern",    &ext_def_check,    "check if externals defined"},
  184.     {"help",    &help_screen,    "print help screen"},
  185.     {"library",    &library_mode,    "treat next files as library"},
  186. #ifdef EOLSKIP
  187.     {"linebreak",    &eol_is_space,    "treat linebreaks as space"},
  188. #endif
  189.     {"list",    &do_list,    "print program listing"},
  190.     {"novice",    &novice_help,    "extra help for novices"},
  191.     {"project",    &make_project_file,    "create project file"},
  192.     {"pure",    &pure_functions,"functions have no side effects"},
  193.     {"quiet",    &quiet,        "less verbose output"},
  194.     {"reference",    &print_ref_list,"print who-calls-who reference list"},
  195.     {"resources",    &show_resources,"show info on resource usage"},
  196.     {"sixchar",    &sixclash,    "catch nonunique names"},
  197.     {"sort",    &print_topo_sort,"prerequisite-order sort of modules"},
  198.     {"symtab",    &do_symtab,    "print symbol table info"},
  199. #ifdef VCG_SUPPORT
  200.     {"vcg",        &print_vcg_list,"print call graph in vcg format"},
  201. #endif
  202.     {"version",    &print_version,    "print version number"},
  203.     {"volatile",    &volatile_flag,    "assume volatile common blocks"},
  204.  
  205.     {"debug",    &debug_latest,    "debug latest code"},
  206.     {"global",    &debug_glob_symtab,    "debug global symtab info"},
  207.     {"grammar",    &debug_parser,    "debug printout in parser"},
  208.     {"hashtable",    &debug_hashtab,    "debug printout of hashtable"},
  209.     {"local",    &debug_loc_symtab,    "debug local symtab info"},
  210.     {"tokens",    &debug_lexer,    "debug printout in lexer"},
  211.     {"yydebug",    &yydebug,    "debug via yydebug"},
  212. };
  213.  
  214.  
  215.         /* List of settings is defined here. Each entry gives
  216.            the name, the corresponding variable, the range
  217.            of permitted values, the value for turning it off,
  218.            followed by brief explanation.
  219.            See set_option() for processing. */
  220. PRIVATE struct {
  221.     char *name;
  222.     int *setvalue;
  223.     int minlimit,maxlimit,turnoff,turnon,min_default_value,max_default_value;
  224.     char *explanation;
  225. } setting[]={
  226.   {"arguments",    &argcheck_strictness, 0, 3, 0, 3, 0, 3,
  227.             "check args: 0=none 1=number 2=type 3=all"},
  228.   {"array",    &array_arg_check, 0, 3, 0, 3, 0, 3,
  229.             "check array args: 0=none 1=dims 2=size 3=all"},
  230. #ifdef VCG_SUPPORT
  231.   {"calltree",    &call_tree_options, 0, 15, 0, 1, 1, 1,
  232.             "print subprogram call graph: sum of:\
  233. \n\t  1=print call graph in tree format\
  234. \n\t  2=who-calls-who format\
  235. \n\t  3=VCG format\
  236. \n\t  4=do not prune routines printed earlier\
  237. \n\t  8=keep program order, not alphabetic"},
  238. #else
  239.   {"calltree",    &call_tree_options, 0, 15, 0, 1, 1, 1,
  240.             "print subprogram call graph: sum of:\
  241. \n\t  1=print call graph in tree format\
  242. \n\t  2=who-calls-who format\
  243. \n\t  4=do not prune routines printed earlier\
  244. \n\t  8=keep program order, not alphabetic"},
  245. #endif
  246.   {"columns",    &max_stmt_col,  72, MAXLINE, 72, MAXLINE, 72, MAXLINE,
  247.             "max line length processed"},
  248.   {"common",    &comcheck_strictness,  0, 3, 0, 3, 0, 3,
  249.             "common check: 0=none 3=most strict"},
  250.   {"intrinsic",    &intrinsic_opt,    0, 223, 0, DEF_INTRINSIC_OPT,
  251.                 0, 220+DEF_INTRINSIC_SET,
  252.             "intrinsic function options: three digits:\n\
  253. \tones digit=choice: 0=f77, 1=extra, 2=unix, 3=vms\n\
  254. \ttens digit=RAND form: 0=no arg, 1=one arg, 2=either\n\
  255. \thundreds digit=IARGC form: 0=no arg, 1=one arg, 2=either"},
  256.   {"makedcls",  &make_dcls, 0, 1023, 0, 1, 1, 1,
  257.             "make type declaration statements: sum of:\n\
  258. \t  1=declarations\n\
  259. \t  2=undeclared-only\n\
  260. \t  4=compact\n\
  261. \t  8=use-continuation-lines\n\
  262. \t 16=keywords-lowercase\n\
  263. \t 32=variables-and-constants-lowercase\n\
  264. \t 64=exclude-sftran3-internal-variables\n\
  265. \t128=asterisk-comment-character\n\
  266. \t256=lowercase-comment-char\n\
  267. \t512=no-array-dimensions"},
  268.   {"source",    &source_format, 0, 7, 0, 7, 0, 7,
  269.             "source format options: sum of:\n\
  270. \t  1=DEC Fortran tab-format\n\
  271. \t  2=VMS-style INCLUDE statement\n\
  272. \t  4=UNIX-style backslash escape char"},
  273.   {"usage",    &usage_check,    000, 333, 000, 333, 000, 333,
  274.             "check usage: three digits:\n\
  275. \t1st digit=subprogs, 2nd digit=common vars, 3rd digit=local vars\n\
  276. \tdigit 0=no check, 1=used-not-defined 2=unused 3=all"},
  277.   {"wordsize",    &given_wordsize, 0, 16, 0, BpW, 0, 16,
  278.             "standard wordsize in bytes (0=no default)"},
  279.   {"wrap",    &wrap_column, 0, 999, 0, WRAP_COLUMN, 0, 999,
  280.             "width of page to wrap error messages"},
  281. };
  282.  
  283.         /* Here define list of warning options.  These are set
  284.            or cleared by -[no]f77=list option.  Note that the variables
  285.            are FALSE if feature is ALLOWED, and TRUE if feature is
  286.            to be WARNED about.  List must be alphabetized or at
  287.            least options with matching prefix strings must be
  288.            adjacent. */
  289. /*** (struct was declared above: repeated in comment here for reference)
  290. WarnOptionList {
  291.   char *name;
  292.   int *flag;
  293.   char *explanation;
  294. };***/
  295.  
  296. PRIVATE WarnOptionList
  297.  f77_warn_option[]={
  298.   {
  299. #if F77_ALL
  300.    "all"     /* used by -help */
  301. #else
  302.    "none"
  303. #endif
  304.      , (int *)NULL,        "Fortran 77"},    /* Title for list */
  305.   {"accept-type",    &f77_accept_type,
  306.                 "ACCEPT and TYPE I/O statements"},
  307.   {"backslash",        &f77_unix_backslash,
  308.                 "Unix backslash escape in strings"},
  309.   {"byte",        &f77_byte,
  310.                 "BYTE data type"},
  311.   {"common-subprog-name",&f77_common_subprog_name,
  312.                 "Common block & subprog with same name "},
  313.   {"continuation",    &f77_20_continue,
  314.                 "More than 19 continuation lines"},
  315.   {"cpp",        &f77_unix_cpp,
  316.                 "Unix C preprocessor directives"},
  317.   {"d-comment",        &f77_d_comment,
  318.                 "Debug comments starting with D"},
  319.   {"dec-tab"    ,    &f77_dec_tabs,
  320.                 "DEC Fortran tab-formatted source"},
  321.   {"do-enddo",        &f77_do_enddo,
  322.                 "DO loop extensions"},
  323.   {"double-complex",    &f77_double_complex,
  324.                 "Double complex datatype"},
  325.   {"format-dollarsign",    &f77_format_dollarsigns,
  326.                 "$ control code in FORMAT"},
  327.   {"format-edit-descr",    &f77_format_extensions,
  328.                 "Nonstandard edit descriptors"},
  329.   {"function-noparen",    &f77_function_noparen,
  330.                 "FUNCTION defined without parens"},
  331.   {"implicit-none",    &f77_implicit_none,
  332.                 "IMPLICIT NONE statement"},
  333.   {"include",        &f77_include,
  334.                 "INCLUDE statement"},
  335.   {"inline-comment",    &f77_inline_comment,
  336.                 "Inline comments starting with !"},
  337.   {"internal-list-io",    &f77_internal_list_io,
  338.                 "List-directed I/O to internal file"},
  339.   {"intrinsic",        &f77_intrinsics,
  340.                 "Nonstandard intrinsic functions"},
  341.   {"long-line",        &f77_overlength,
  342.                 "Statements with code past 72 columns"},
  343.   {"long-name",        &f77_long_names,
  344.                 "Identifiers over 6 chars"},
  345.   {"mixed-common",    &f77_mixed_common,
  346.                 "Mixed char and nonchar data in common"},
  347.   {"mixed-expr",    &f77_mixed_expr,
  348.                 "Nonstandard type combinations in exprs"},
  349.   {"name-dollarsign",    &f77_dollarsigns,
  350.                 "$ in identifiers"},
  351.   {"name-underscore",    &f77_underscores,
  352.                 "Underscores in variable names "},
  353.   {"namelist",        &f77_namelist,
  354.                 "NAMELIST statement"},
  355.   {"param-intrinsic",    &f77_param_intrinsic,
  356.                 "Intrinsics and **real in PARAMETER defns"},
  357.   {"param-noparen",    &f77_param_noparen,
  358.                 "PARAMETER statement without parens"},
  359.   {"pointer",        &f77_cray_pointers,
  360.                 "Cray pointer syntax"},
  361.   {"quad-constant",    &f77_quad_constants,
  362.                 "Quad precision constants like 1.23Q4"},
  363.   {"quotemark",        &f77_quotemarks,
  364.                 "Strings delimited by \"quote marks\""},
  365.   {"statement-order",    &f77_stmt_order,
  366.                 "Statement out of order"},
  367.   {"typeless-constant",    &f77_typeless_constants,
  368.                 "Typeless constants like Z'19AF"},
  369.   {"type-size",        &f77_typesize,
  370.                 "Sized type declarations like REAL*8"},
  371.   {"variable-format",    &f77_variable_format,
  372.                 "Variable format repeat spec or field size"},
  373.   {"vms-io",        &f77_vms_io,
  374.                 "VMS Fortran I/O keywords"},
  375.   {(char *)NULL, (int *)NULL, (char *)NULL},
  376. };
  377.  
  378.  
  379. PRIVATE WarnOptionList
  380.  port_warn_option[]={
  381.   {
  382. #if PORT_ALL
  383.    "all"     /* used by -help */
  384. #else
  385.    "none"
  386. #endif
  387.      , (int *)NULL,        "Portability"},    /* Title for list */
  388.   {"backslash",        &port_backslash,
  389.                 "Backslash in standard-conforming strings"},
  390.   {"common-alignment",    &port_common_alignment,
  391.                 "COMMON not in descending size order"},
  392.   {"hollerith",        &port_hollerith,
  393.                 "Hollerith constants (except in FORMAT)"},
  394.   {"long-string",    &port_long_string,
  395.                 "Strings over 255 chars long"},
  396.   {"mixed-equivalence",    &port_mixed_equiv,
  397.                 "Different data types equivalenced"},
  398.   {"mixed-size",    &port_mixed_size,
  399.                 "Default and explicit size types mixed"},
  400.   {"real-do",        &port_real_do,
  401.                 "Non-integer DO loops"},
  402.   {"tab",        &port_tabs,
  403.                 "Tabs in source code"},
  404.   {(char *)NULL, (int *)NULL, (char *)NULL},
  405. };
  406.  
  407. PRIVATE WarnOptionList
  408.  pretty_warn_option[]={
  409.   {
  410. #if PRETTY_ALL
  411.    "all"     /* used by -help */
  412. #else
  413.    "none"
  414. #endif
  415.      , (int *)NULL,        "Appearance"},    /* Title for list */
  416.   {"embedded-space",    &pretty_extra_space,
  417.                 "Space in variable names"},
  418.   {"continuation",    &pretty_contin,
  419.                 "Continuation mark following comment line"},
  420.   {"long-line",        &pretty_overlength,
  421.                 "Lines over 72 columns"},
  422.   {"missing-space",    &pretty_no_space,
  423.                 "Missing space between variable & keyword"},
  424.   {"multiple-common",    &pretty_multiple_common,
  425.                 "COMMON declared in multiple stmts"},
  426.   {"multiple-namelist",    &pretty_multiple_namelist,
  427.                 "NAMELIST declared in multiple stmts"},
  428.   {"parentheses",    &pretty_parens,
  429.                 "Parentheses around a variable"},
  430.   {(char *)NULL, (int *)NULL, (char *)NULL},
  431.  
  432. };
  433.  
  434. PRIVATE WarnOptionList
  435.  trunc_warn_option[]={
  436.   {
  437. #if TRUNC_ALL
  438.    "all"     /* used by -help */
  439. #else
  440.    "none"
  441. #endif
  442.      , (int *)NULL,        "Truncation"},    /* Title for list */
  443.   {"int-div-exponent",    &trunc_int_div_exponent,
  444.                 "int/int used as exponent"},
  445.   {"int-div-real",    &trunc_int_div_real,
  446.                 "int/int converted to real"},
  447.   {"int-div-zero",    &trunc_int_div_zero,
  448.                 "int/int = constant 0 "},
  449.   {"int-neg-power",    &trunc_int_neg_power,
  450.                 "int**(-int), usually equals 0"},
  451.   {"promotion",        &trunc_promotion,
  452.                 "lower precision promoted to higher"},
  453.   {"real-do-index",    &trunc_real_do_index,
  454.                 "real DO index with int bounds"},
  455.   {"real-subscript",    &trunc_real_subscript,
  456.                 "real array subscript"},
  457.   {"significant-figures",&trunc_sigfigs,
  458.                 "single precision const overspecified"},
  459.   {"size-demotion",        &trunc_size_demotion,
  460.             "higher precision truncated to lower, same type"},
  461.   {"type-demotion",        &trunc_type_demotion,
  462.             "higher precision truncated to lower, different type"},
  463.   {(char *)NULL, (int *)NULL, (char *)NULL},
  464.  
  465. };
  466.  
  467.         /* List of strsettings is defined here. Each entry
  468.            gives the name of the corresponding string
  469.            variable, value to set if "=str" omitted, and brief
  470.            explanation.  See set_option() for processing. */
  471.  
  472. /*** (struct was declared above: repeated in comment here for reference)
  473. StrsettingList {
  474.     char *name;
  475.     char **strvalue;
  476.     char *turnon, *turnoff;
  477.     WarnOptionList *option_list;
  478.     char *explanation;
  479. };***/
  480.  
  481. PRIVATE StrsettingList strsetting[]={
  482.   {"f77",    &f77_warn_list,    "all", "none",
  483.      f77_warn_option,
  484.      "warn about non-F77 extensions"},
  485. #ifdef ALLOW_INCLUDE
  486.   {"include",    &include_path,  (char *)NULL, (char *)NULL,
  487.      (WarnOptionList *)NULL,
  488.      "include-file directory"},
  489. #endif
  490.   {"output",    &out_fname,    (char *)NULL, (char *)NULL,
  491.      (WarnOptionList *)NULL,
  492.      "output file name"},
  493.   {"portability",&port_warn_list,"all,", "none",
  494.      port_warn_option,
  495.      "warn about portability problems"},
  496.   {"pretty",    &pretty_warn_list,"all", "none",
  497.      pretty_warn_option,
  498.      "warn about deceiving appearances"},
  499.   {"truncation",&trunc_warn_list,"all", "none",
  500.      trunc_warn_option,
  501.      "check for truncation pitfalls"},
  502. };
  503.  
  504.  
  505. PRIVATE int must_open_outfile=FALSE; /* Flag set to TRUE when out=name given */
  506. PRIVATE int checks_on=TRUE; /* Keep track whether -nocheck was given */
  507.  
  508. PRIVATE char *dclfile;
  509. PRIVATE int actioncount=0;
  510. int
  511. #if HAVE_STDC
  512. main(int argc, char **argv)
  513. #else /* K&R style */
  514. main(argc,argv)
  515.     int argc;
  516.     char *argv[];
  517. #endif /* HAVE_STDC */
  518. {
  519.     int iarg;
  520.     int filecount=0;
  521.     char *infile,*srcfile,*projfile;
  522.     int prev_intrinsic_opt= DEF_INTRINSIC_OPT;
  523.  
  524. #ifdef VMS            /* VMS version: expand wildcards, etc. */
  525.     shell_mung(&argc,&argv,1,NULL);
  526. #endif
  527.  
  528.     list_fd = stdout;
  529.     project_fd = (FILE *) NULL;
  530.     error_count = 0;
  531.     warning_count = 0;
  532.     include_path_list = (IncludePathNode*) NULL;
  533.  
  534.     get_env_options();    /* Pick up options from environment */
  535.     get_rc_options();    /* Pick up options from "rc" file */
  536.  
  537.     init_tables();        /* Initialize tables */
  538.     init_keyhashtab();
  539.     intrins_clashes = init_intrins_hashtab();
  540.     init_globals();
  541.     init_symtab();
  542.  
  543.     for(iarg=1; iarg < argc; iarg++) {
  544.  
  545.       int argchar=0;/* location of start of option */
  546.             /* Note to maintainer: since the /option version
  547.                has a loop here instead of an if, do not
  548.                use continue but goto next_arg for skipping
  549.                to the next argument.  This is a mess, isn't it?
  550.              */
  551. #ifdef OPTION_PREFIX_SLASH
  552.       do {            /* loop on flags within argv[iarg] */
  553. #endif
  554.         if( argv[iarg][argchar] == '-'
  555. #ifdef OPTION_PREFIX_SLASH
  556.          || argv[iarg][argchar] == '/'    /* Allow VMS /option form */
  557. #endif
  558.                      ) {
  559.             /* Process flags here */
  560.  
  561.         set_option(&argv[iarg][argchar],"commandline");
  562.  
  563.             /* Handle -version, -help, or -f77=help */
  564.         if(print_version) goto do_action;
  565.  
  566.         if(help_screen) goto do_action;
  567.  
  568.                 /* Allow checking to be turned off */
  569.         if( !do_check && checks_on ) {
  570.           turn_off_checks();
  571.           checks_on = FALSE;    /* remember it was done */
  572.         }
  573.  
  574.                 /* Derive usage options from -usage setting */
  575.         var_usage_check = usage_check % 10;
  576.         com_usage_check = (usage_check/10) % 10;
  577.         ext_usage_check = (usage_check/100) % 10;
  578.  
  579.                 /* intrinsic_set = last digit of -intrinsic */
  580.         intrinsic_set = intrinsic_opt % 10;
  581.                 /* Other digits used to fix intrins table */
  582.         if(intrinsic_opt != prev_intrinsic_opt) {
  583.           set_intrinsic_options(intrinsic_opt);
  584.           prev_intrinsic_opt = intrinsic_opt;
  585.         }
  586.         }
  587.         else if(strcmp(&argv[iarg][argchar],"?") == 0) {
  588.             help_screen = TRUE;
  589.             goto do_action;
  590.         }/*end of processing options*/
  591.  
  592.         else {    /* Process file arguments */
  593. do_action:
  594.  
  595.         if( must_open_outfile )
  596.             open_outfile(out_fname);
  597.  
  598.         if(actioncount == 0) {
  599.           print_version_number();
  600.         }
  601.         ++actioncount;    /* Cause exit w/o reading stdin below */
  602.  
  603.             /* Honor -version, -help and -f77=help options */
  604.         if(print_version) {
  605.           print_version = FALSE;
  606.           goto next_arg;
  607.         }
  608.  
  609.         if(help_screen) {
  610.           help_screen = FALSE;
  611.           list_options(list_fd);
  612.         }
  613.         else {    /* Process files here */
  614.             ++filecount;
  615.  
  616.             srcfile = add_ext(&argv[iarg][argchar],DEF_SRC_EXTENSION);
  617.             projfile = new_ext(&argv[iarg][argchar],DEF_PROJ_EXTENSION);
  618.             dclfile =  new_ext(&argv[iarg][argchar],DEF_DCL_EXTENSION);
  619. #ifdef VCG_SUPPORT
  620.                 /* Initialize main_filename to 1st file arg */
  621.             if(main_filename == (char *)NULL)
  622.               main_filename = argv[iarg];
  623. #endif
  624.                 /* Project file mode: open source for reading
  625.                    and .prj file for writing. */
  626.             if(make_project_file) {
  627.  
  628.               infile = srcfile;
  629.  
  630.               if( has_extension(infile,DEF_PROJ_EXTENSION) ) {
  631.             (void)fprintf(stderr,
  632.              "Input from %s disallowed in project mode\n",infile);
  633.             goto next_arg;
  634.               }
  635.  
  636.               if( (input_fd = fopen(infile,"r")) == (FILE *)NULL ) {
  637.             (void)fprintf(stderr,"Cannot open file %s\n",infile);
  638.             goto next_arg;
  639.               }
  640.  
  641.               project_fd = fopen(projfile,"w");
  642.               project_file_input = FALSE;
  643.             }
  644.             else {
  645.             /* Non project file mode: if input file extension
  646.                given, use it.  Otherwise read project file
  647.                if it exists else read source file. */
  648.               if( &argv[iarg][argchar]==srcfile
  649.                || (input_fd = fopen(projfile,"r")) == (FILE *)NULL) {
  650.             infile = srcfile;
  651.             if( (input_fd = fopen(infile,"r")) == (FILE *)NULL ) {
  652.               (void)fflush(list_fd);
  653.               (void)fprintf(stderr,"Cannot open file %s\n",infile);
  654.               goto next_arg;
  655.             }
  656.             project_file_input =
  657.               has_extension(infile,DEF_PROJ_EXTENSION);
  658.               }
  659.               else {
  660.             infile = projfile;
  661.             project_file_input = TRUE;
  662.               }
  663.             }
  664.  
  665.             /* now that we have a source file, try to open the 
  666.                declaration file */
  667.             dcl_fd = (make_dcls > 0 &&  ! project_file_input) ?
  668.               fopen(dclfile,"w") : (FILE*)NULL;
  669.  
  670.                 /* Always print input .f file name.  If
  671.                    verbose mode, print .prj file names too.
  672.                  */
  673.             if(!quiet || !project_file_input)
  674.               (void)fprintf(list_fd,"\nFile %s:%s",
  675.                   infile,
  676.                   full_output?"\n":""
  677.                   );
  678.  
  679.                 /* In verbose mode, print .prj output
  680.                    file name to stderr.  Always print
  681.                    error message if couldn't open it. */
  682.             if( make_project_file ) {
  683.               if(project_fd != (FILE *)NULL) {
  684.             if(!quiet) {
  685.               (void)fflush(list_fd);
  686.               (void)fprintf(stderr,
  687.                   "\nProject file is %s\n",projfile);
  688.             }
  689.               }
  690.               else {
  691.             (void)fflush(list_fd);
  692.             (void)fprintf(stderr,
  693.                 "\nCannot open %s for output\n",projfile);
  694.               }
  695.             }
  696.  
  697.  
  698.                 /* only has effect if done before 1st file*/
  699.             init_typesizes();
  700.  
  701.             if(project_file_input) {
  702.  
  703.                 current_filename = projfile;
  704.             proj_file_in(input_fd);
  705.  
  706.             }
  707.             else {
  708.  
  709.               src_file_in(infile);
  710.  
  711.             }
  712.  
  713.             (void) fclose(input_fd);
  714.         }/*end processing file args*/
  715.           }
  716. next_arg:
  717. #ifdef OPTION_PREFIX_SLASH
  718.                 /* Here we allow /opts to be stuck together */
  719.         while(argv[iarg][++argchar] != '\0'
  720.          && argv[iarg][argchar] != '/') /* look for next opt */
  721.           continue;
  722.  
  723.       } while(argv[iarg][argchar] != '\0'); /*end do-while*/
  724. #else
  725.       continue;
  726. #endif
  727.     }    /* end for-loop on argument list */
  728.  
  729.  
  730.                 /* No files given: read stdin */
  731.     if(actioncount == 0) {
  732.  
  733.         print_version_number();
  734.  
  735.         if( must_open_outfile )
  736.             open_outfile(out_fname);
  737.  
  738.         if(make_project_file) {
  739.               projfile = STDIN_PROJ_FILENAME;
  740.               if( (project_fd = fopen(projfile,"w")) == (FILE *)NULL) {
  741.             (void)fflush(list_fd);
  742.             (void)fprintf(stderr,
  743.                 "\nCannot open %s for output\n",projfile);
  744.               }
  745.               else {
  746.             if(!quiet) {
  747.               (void)fflush(list_fd);
  748.               (void)fprintf(stderr,
  749.                 "\nProject file is %s\n",projfile);
  750.             }
  751.               }
  752.         }
  753.  
  754.         ++filecount;
  755.         input_fd = stdin;
  756.  
  757.         init_typesizes();
  758.  
  759.         src_file_in("std_input");
  760.     }
  761.     if(filecount > 0) {
  762.       wrapup();
  763.       (void)fprintf(list_fd,"\n");
  764.     }
  765.  
  766.     if(show_resources)
  767.         resource_summary();
  768.  
  769.     exit(0);
  770.     return 0;/*NOTREACHED*/
  771. }
  772.  
  773. PRIVATE void
  774. #if HAVE_STDC
  775. src_file_in(char *infile)
  776.                           /* input filename */
  777. #else /* K&R style */
  778. src_file_in(infile)
  779.      char *infile;        /* input filename */
  780. #endif /* HAVE_STDC */
  781. {
  782.     note_filename(infile);
  783.  
  784.     init_scan();
  785.     init_parser();
  786.  
  787.     (void) yyparse();
  788.  
  789.     finish_scan();
  790.  
  791.     if(make_project_file) {
  792.           proj_file_out(project_fd);
  793.           (void) fclose(project_fd);
  794.     }
  795.  
  796.     if ((make_dcls > 0) && (dcl_fd != stdout))
  797.     {
  798.         if (ftell(dcl_fd) == 0L)    /* delete an empty .dcl file */
  799.         (void)unlink(dclfile);
  800.         (void) fclose(dcl_fd);
  801.     }
  802.  
  803.     if(port_tabs && (tab_filename != (char *)NULL)) {
  804.       if(tab_filename != top_filename) {
  805.         nonportable(NO_LINE_NUM,NO_COL_NUM,
  806.             "Included file");
  807.         msg_tail(tab_filename);
  808.       }
  809.       else {
  810.         nonportable(NO_LINE_NUM,NO_COL_NUM,
  811.               "File");
  812.       }
  813.       msg_tail("contains tabs");
  814.     }
  815.  
  816.     error_summary(infile);
  817. }
  818.  
  819. PRIVATE void
  820. print_version_number(VOID)
  821. {
  822.   if((full_output || !quiet) && !print_version)
  823.     (void)fprintf(list_fd,"\n");
  824.   (void)fprintf(list_fd,"%s",VERSION_NUMBER);
  825.   if(help_screen || print_version)
  826.     (void)fprintf(list_fd," %s",PATCHLEVEL);
  827.   if(full_output || !quiet || print_version)
  828.     (void)fprintf(list_fd,"\n");
  829. }
  830.  
  831. PRIVATE void
  832. #if HAVE_STDC
  833. error_summary(char *fname)        /* Print out count of errors in file */
  834. #else /* K&R style */
  835. error_summary(fname)        /* Print out count of errors in file */
  836.     char *fname;
  837. #endif /* HAVE_STDC */
  838. {
  839.     FILE *fd = list_fd;
  840.  
  841.     if(full_output ||
  842.        (!quiet && error_count+warning_count != 0))
  843.       (void)fprintf(fd,"\n");
  844.  
  845.     if(full_output || !quiet || error_count != 0)
  846.       (void)fprintf(fd,"\n %u syntax error%s detected in file %s",
  847.             error_count, error_count==1? "":"s",
  848.             fname);
  849.  
  850.     if(warning_count != 0)
  851.         (void)fprintf(fd,"\n %u warning%s issued in file %s",
  852.             warning_count, warning_count==1? "":"s",
  853.             fname);
  854.  
  855.     if(full_output ||
  856.        (!quiet && error_count+warning_count != 0))
  857.       (void)fprintf(fd,"\n");
  858.  
  859.     error_count = 0;
  860.     warning_count = 0;
  861. }
  862.  
  863. void
  864. #if HAVE_STDC
  865. print_a_line(FILE *fd, char *line, unsigned int num)  /* Print source line with line number */
  866. #else /* K&R style */
  867. print_a_line(fd,line,num)  /* Print source line with line number */
  868.     FILE *fd;
  869.     char *line;
  870.     unsigned num;
  871. #endif /* HAVE_STDC */
  872. {
  873.     (void)fprintf(fd,"\n %6u ",num); /* Print line number */
  874.  
  875. #ifdef DEC_TABS
  876.                 /* Tab-formatted source lines: tab in
  877.                    col 1-6 moves to col 7. */
  878.     if(dec_tabs) {
  879.       int i,col;
  880.       for(i=0,col=1; col < 7 && line[i] != '\0'; i++) {
  881.         if(line[i] == '\t') {
  882.           do{
  883.         (void)fprintf(fd," ");
  884.           } while(++col < 7);
  885.         }
  886.         else {
  887.         (void)fprintf(fd,"%c",line[i]);
  888.         ++col;
  889.         }
  890.       }
  891.       (void)fprintf(fd,"%s",line+i);
  892.     }
  893.     else
  894. #endif
  895.       (void)fprintf(fd,"%s",line);
  896. }
  897.  
  898.  
  899. void
  900. #if HAVE_STDC
  901. yyerror(char *s)
  902. #else /* K&R style */
  903. yyerror(s)
  904.     char *s;
  905. #endif /* HAVE_STDC */
  906. {
  907.     syntax_error(line_num,col_num,s);
  908. }
  909.  
  910.  
  911. void
  912. #if HAVE_STDC
  913. syntax_error(unsigned int lineno, unsigned int colno, char *s)        /* Syntax error message */
  914. #else /* K&R style */
  915. syntax_error(lineno,colno,s)        /* Syntax error message */
  916.     unsigned lineno,colno;
  917.     char *s;
  918. #endif /* HAVE_STDC */
  919. {
  920.     ++error_count;
  921.     error_message(lineno,colno,s,"Error");
  922. }
  923.  
  924. void
  925. #if HAVE_STDC
  926. warning(unsigned int lineno, unsigned int colno, char *s)        /* Print warning message */
  927. #else /* K&R style */
  928. warning(lineno,colno,s)        /* Print warning message */
  929.     unsigned lineno,colno;
  930.     char *s;
  931. #endif /* HAVE_STDC */
  932. {
  933.     ++warning_count;
  934.  
  935.     error_message(lineno,colno,s,"Warning");
  936. }
  937.  
  938. void
  939. #if HAVE_STDC
  940. ugly_code(unsigned int lineno, unsigned int colno, char *s)        /* -pretty message */
  941. #else /* K&R style */
  942. ugly_code(lineno,colno,s)        /* -pretty message */
  943.     unsigned lineno,colno;
  944.     char *s;
  945. #endif /* HAVE_STDC */
  946. {
  947.     ++warning_count;
  948.  
  949.     error_message(lineno,colno,s,"Possibly misleading appearance");
  950. }
  951.  
  952. void
  953. #if HAVE_STDC
  954. nonstandard(unsigned int lineno, unsigned int colno)
  955. #else /* K&R style */
  956. nonstandard(lineno,colno)
  957.      unsigned lineno,colno;
  958. #endif /* HAVE_STDC */
  959. {
  960.     ++warning_count;
  961.     error_message(lineno,colno,"Nonstandard syntax","Warning");
  962. }
  963.  
  964. void
  965. #if HAVE_STDC
  966. nonportable(unsigned int lineno, unsigned int colno, char *s) /* Print warning about nonportable construction */
  967. #else /* K&R style */
  968. nonportable(lineno,colno,s) /* Print warning about nonportable construction */
  969.     unsigned lineno,colno;
  970.     char *s;
  971. #endif /* HAVE_STDC */
  972. {
  973.     ++warning_count;
  974.     error_message(lineno,colno,s,"Nonportable usage");
  975. }
  976.  
  977. /* error_message prints out error messages and warnings.  It
  978.    now comes in two flavors.  If using lintstyle_error_message(),
  979.    messages are produced in style like UNIX lint:
  980.  
  981.     "main.f", line nn, col nn: Error: your message here
  982.  
  983.    Otherwise messages by oldstyle_error_message in old ftnchek style:
  984.  
  985.     Error near line nn col nn file main.f: your message here
  986.  
  987.    At this time, oldstyle_error_message is used when -novice is
  988.    in effect, lintstyle_error_message otherwise.
  989. */
  990.  
  991. PRIVATE int errmsg_col;
  992.     /* Crude macro to give number of digits in line and column numbers.
  993.        Used by line wrap computation. */
  994. #define NUM_DIGITS(n) ((n)<10?1:((n)<100?2:((n)<1000?3:(n)<10000?4:5)))
  995.  
  996. PRIVATE void
  997. #if HAVE_STDC
  998. error_message(unsigned int lineno, unsigned int colno, char *s, char *tag)
  999. #else /* K&R style */
  1000. error_message(lineno,colno,s,tag)
  1001.     unsigned lineno,colno;
  1002.     char *s,*tag;
  1003. #endif /* HAVE_STDC */
  1004. {
  1005.   if(novice_help)
  1006.     oldstyle_error_message(lineno,colno,s,tag);
  1007.   else
  1008.     lintstyle_error_message(lineno,colno,s,tag);
  1009. }
  1010.  
  1011. PRIVATE void
  1012. #if HAVE_STDC
  1013. lintstyle_error_message(unsigned int lineno, unsigned int colno, char *s, char *tag)
  1014. #else /* K&R style */
  1015. lintstyle_error_message(lineno,colno,s,tag)
  1016.     unsigned lineno,colno;
  1017.     char *s,*tag;
  1018. #endif /* HAVE_STDC */
  1019. {
  1020.     int icol;
  1021.     extern unsigned prev_stmt_line_num; /* shared with advance.c */
  1022.  
  1023.     errmsg_col=1;        /* Keep track of line length */
  1024.  
  1025.             /* Print the character ^ under the column number.
  1026.                But if colno == 0, error occurred in prior line.
  1027.                If colno is NO_COL_NUM, then print message
  1028.                without any column number given.
  1029.              */
  1030.  
  1031.     if(lineno != NO_LINE_NUM) {
  1032.         if(colno == NO_COL_NUM) {
  1033.             /* colno == NO_COL_NUM means don't give column number.*/
  1034.         (void)flush_line_out(lineno);/* print line if not printed yet */
  1035.         }
  1036.         else if(colno != 0) {
  1037.             /* print line if not printed yet */
  1038.         if( flush_line_out(lineno) ) {
  1039.                 /* If it was printed, put ^ under the col */
  1040.             (void)fprintf(list_fd,"\n%8s","");
  1041.  
  1042.             for(icol=1; icol<colno; icol++)
  1043.             (void)fprintf(list_fd," ");
  1044.             (void)fprintf(list_fd,"^");
  1045.         }
  1046.         }
  1047.         else {        /* colno == 0 */
  1048.             /* print line if not printed yet */
  1049.         (void)flush_line_out(prev_stmt_line_num);
  1050.         }
  1051.     }
  1052.  
  1053.     (void)fprintf(list_fd,"\n\"%s\"",current_filename);
  1054.     errmsg_col += 2+strlen(current_filename);
  1055.  
  1056.     if(lineno != NO_LINE_NUM) { /* nonlocal error-- don't flush */
  1057.         if(colno == NO_COL_NUM) {
  1058.         (void)fprintf(list_fd,
  1059.            ", near line %u",lineno);
  1060.         errmsg_col += 12+NUM_DIGITS(lineno);
  1061.         }
  1062.         else if(colno != 0) {
  1063.         (void)fprintf(list_fd,
  1064.            ", line %u col %u",lineno,colno);
  1065.         errmsg_col += 12+NUM_DIGITS(lineno);
  1066.         }
  1067.         else {        /* colno == 0 */
  1068.         (void)fprintf(list_fd,
  1069.            ", near line %u",prev_stmt_line_num);
  1070.         errmsg_col += 12+NUM_DIGITS(lineno);
  1071.         }
  1072.     }
  1073.  
  1074.     (void)fprintf(list_fd,": %s:",tag); /* "Warning", "Error", etc. */
  1075.     errmsg_col += 3+strlen(tag);
  1076.  
  1077.     msg_tail(s); /* now append the message string */
  1078. }
  1079.  
  1080.                 /* Our own style messages */
  1081. PRIVATE void
  1082. #if HAVE_STDC
  1083. oldstyle_error_message(unsigned int lineno, unsigned int colno, char *s, char *tag)
  1084. #else /* K&R style */
  1085. oldstyle_error_message(lineno,colno,s,tag)
  1086.     unsigned lineno,colno;
  1087.     char *s,*tag;
  1088. #endif /* HAVE_STDC */
  1089. {
  1090.     int icol;
  1091.     extern unsigned prev_stmt_line_num; /* shared with advance.c */
  1092.  
  1093.     errmsg_col=1;        /* Keep track of line length */
  1094.  
  1095.             /* Print the character ^ under the column number.
  1096.                But if colno == 0, error occurred in prior line.
  1097.                If colno is NO_COL_NUM, then print message
  1098.                without any column number given.
  1099.              */
  1100.  
  1101.     if(lineno == NO_LINE_NUM) { /* nonlocal error-- don't flush */
  1102.       (void)fprintf(list_fd,"\n%s",tag);
  1103.       errmsg_col += strlen(tag);
  1104.     }
  1105.     else {
  1106.         if(colno == NO_COL_NUM) {
  1107.             /* colno == NO_COL_NUM means don't give column number.*/
  1108.         (void)flush_line_out(lineno);/* print line if not printed yet */
  1109.         (void)fprintf(list_fd,
  1110.            "\n%s near line %u",tag,lineno);
  1111.         errmsg_col += 11+NUM_DIGITS(lineno)+(unsigned)strlen(tag);
  1112.         }
  1113.         else if(colno != 0) {
  1114.             /* print line if not printed yet */
  1115.         if( flush_line_out(lineno) ) {
  1116.                 /* If it was printed, put ^ under the col */
  1117.             (void)fprintf(list_fd,"\n%8s","");
  1118.  
  1119.             for(icol=1; icol<colno; icol++)
  1120.             (void)fprintf(list_fd," ");
  1121.             (void)fprintf(list_fd,"^");
  1122.         }
  1123.         (void)fprintf(list_fd,
  1124.            "\n%s near line %u col %u",tag,lineno,colno);
  1125.         errmsg_col += 16+NUM_DIGITS(lineno)+NUM_DIGITS(colno)
  1126.           +(unsigned)strlen(tag);
  1127.         }
  1128.         else {        /* colno == 0 */
  1129.             /* print line if not printed yet */
  1130.         (void)flush_line_out(prev_stmt_line_num);
  1131.         (void)fprintf(list_fd,
  1132.            "\n%s near line %u",tag,prev_stmt_line_num);
  1133.         errmsg_col += 11+NUM_DIGITS(lineno)+(unsigned)strlen(tag);
  1134.         }
  1135.     }
  1136.  
  1137.     if(!full_output        /* If not listing, append file name */
  1138.        || incdepth > 0){    /* Append include-file name if we are in one */
  1139.       if(lineno == NO_LINE_NUM) { /* if no line no, preposition needed */
  1140.         (void)fprintf(list_fd," in");
  1141.         errmsg_col += 3;
  1142.       }
  1143.       (void)fprintf(list_fd," file %s",current_filename);
  1144.       errmsg_col += 6+(unsigned)strlen(current_filename);
  1145.     }
  1146.  
  1147.     (void)fprintf(list_fd,":");
  1148.     errmsg_col++;
  1149.  
  1150.     msg_tail(s); /* now append the message string */
  1151. }
  1152.  
  1153.         /* msg_tail appends string s to current error message.
  1154.            It prints one word at a time, starting a new line
  1155.            when the message gets to be too long for one line.
  1156.          */
  1157. void
  1158. #if HAVE_STDC
  1159. msg_tail(char *s)
  1160. #else /* K&R style */
  1161. msg_tail(s)
  1162.     char *s;
  1163. #endif /* HAVE_STDC */
  1164. {
  1165.     int wordstart,wordend,leading_skip,wordchars;
  1166.  
  1167.     (void)fprintf(list_fd," ");
  1168.     errmsg_col++;
  1169.     wordstart=0;
  1170.         /* Each iteration of loop prints leading space and the
  1171.            nonspace characters of a word.  Loop invariant: wordstart
  1172.            is index of leading space at start of word, wordend is
  1173.            index of space char following word. */
  1174.     while(s[wordstart] != '\0') {
  1175.       leading_skip = TRUE;
  1176.       for(wordend=wordstart; s[wordend] != '\0'; wordend++) {
  1177.         if(leading_skip) {    /* If skipping leading space chars */
  1178.           if(!isspace(s[wordend]))
  1179.         leading_skip = FALSE; /* go out of skip mode at nonspace */
  1180.         }
  1181.         else {        /* If scanning word chars */
  1182.           if(isspace(s[wordend]))
  1183.         break;        /* quit loop when space char found */
  1184.         }
  1185.       }
  1186.       wordchars = wordend-wordstart;
  1187.                 /* If word doesn't fit, wrap to next line */
  1188.       if( wrap_column > 0 && (errmsg_col += wordchars) > wrap_column) {
  1189.         (void)fprintf(list_fd,"\n");
  1190.         errmsg_col = wordchars;
  1191.       }
  1192.                 /* Print the word */
  1193.       while(wordstart < wordend) {
  1194.         (void)putc(s[wordstart++],list_fd);
  1195.       }
  1196.     }
  1197. }
  1198.  
  1199.  
  1200. void
  1201. #if HAVE_STDC
  1202. oops_message(int severity, unsigned int lineno, unsigned int colno, char *s)
  1203. #else /* K&R style */
  1204. oops_message(severity,lineno,colno,s)
  1205.     int severity;
  1206.     unsigned lineno,colno;
  1207.     char *s;
  1208. #endif /* HAVE_STDC */
  1209. {
  1210.     (void)fflush(list_fd);
  1211.     (void)fprintf(stderr,"\nOops");
  1212.     if(lineno != NO_LINE_NUM) {
  1213.       (void)fprintf(stderr," at line %u",lineno);
  1214.       if(colno != NO_COL_NUM)
  1215.         (void)fprintf(stderr," at col %u",colno);
  1216.     }
  1217.     (void)fprintf(stderr," in file %s",current_filename);
  1218.     (void)fprintf(stderr," -- %s",s);
  1219.     if(severity == OOPS_FATAL) {
  1220.       (void)fprintf(stderr,"\nFtnchek aborted\n");
  1221.       (void) exit(1);
  1222.     }
  1223. }
  1224.  
  1225. void
  1226. #if HAVE_STDC
  1227. oops_tail(char *s)
  1228. #else /* K&R style */
  1229. oops_tail(s)
  1230.     char *s;
  1231. #endif /* HAVE_STDC */
  1232. {
  1233.     (void)fprintf(stderr," %s",s);
  1234. }
  1235.  
  1236. /*    get_env_options picks up any options defined in the
  1237.     environment.  A switch or setting is defined according to
  1238.     the value of an environment variable whose name is the switch
  1239.     or setting name (uppercased), prefixed by the string
  1240.     ENV_PREFIX (e.g.  FTNCHEK_).  For settings and strsettings,
  1241.     the value of the environment variable gives the value to be
  1242.     used.  For switches, the environment variable is set to "0" or
  1243.     "NO" to turn the switch off, or to any other value (including
  1244.     null) to turn it on.
  1245. */
  1246.  
  1247. PRIVATE void
  1248. get_env_options(VOID)
  1249. {
  1250.     char env_option_name[32];
  1251.     char *value;
  1252.     int i;
  1253.     for(i=0; i<NUM_SWITCHES; i++) {
  1254.             /* Construct the env variable name for switch i */
  1255.         make_env_name( env_option_name, switchopt[i].name);
  1256.  
  1257.             /* See if it is defined */
  1258.         if( (value = getenv(env_option_name)) != (char *)NULL) {
  1259.         *(switchopt[i].switchflag) =
  1260.             !(strcmp(value,"0")==0 || strcmp(value,"NO")==0 );
  1261.         }
  1262.  
  1263.     }
  1264.  
  1265.     for(i=0; i<NUM_SETTINGS; i++) {
  1266.             /* Construct the env variable name for setting i */
  1267.         make_env_name( env_option_name, setting[i].name);
  1268.             /* See if it is defined */
  1269.         if( (value = getenv(env_option_name)) != (char *)NULL) {
  1270.         if(read_setting(value, setting[i].setvalue, setting[i].name,
  1271.                 setting[i].minlimit, setting[i].maxlimit,
  1272.                 setting[i].turnon,
  1273.                 setting[i].turnoff,
  1274.                 setting[i].min_default_value,
  1275.                 setting[i].max_default_value) != 0) {
  1276.           (void)fflush(list_fd);
  1277.           (void)fprintf(stderr,"Env setting garbled: %s=%s: ignored\n",
  1278.                 env_option_name,value);
  1279.         }
  1280.         }
  1281.     }
  1282.  
  1283.  
  1284.     for(i=0; i<NUM_STRSETTINGS; i++) {
  1285.             /* Construct the env variable name for setting i */
  1286.         make_env_name( env_option_name, strsetting[i].name);
  1287.             /* See if it is defined */
  1288.         if( (value = getenv(env_option_name)) != (char *)NULL) {
  1289.  
  1290.                 /* setenv nothing or "1" or "YES" --> turnon*/
  1291.           if(value[0] == '\0'
  1292.          || cistrncmp(value,"1",strlen(value)) == 0
  1293.          || cistrncmp(value,"yes",strlen(value)) == 0
  1294.          ) {
  1295.         *(strsetting[i].strvalue) = strsetting[i].turnon;
  1296.           }
  1297.           else if(cistrncmp(value,"no",strlen(value)) == 0) {
  1298.         *(strsetting[i].strvalue) = strsetting[i].turnoff;
  1299.           }
  1300.           else {        /* Otherwise use the given value */
  1301.             *(strsetting[i].strvalue) = value;
  1302.           }
  1303.  
  1304.           if( *(strsetting[i].strvalue) == (char *)NULL ) {
  1305.         (void)fflush(list_fd);
  1306.         (void)fprintf(stderr,
  1307.              "Environment variable %s needs string value: ignored\n",
  1308.              env_option_name);
  1309.           }
  1310.           else {
  1311.         update_str_options(&strsetting[i]);
  1312.           }
  1313.         }
  1314.     }
  1315. }
  1316.  
  1317.         /* Routine to concatenate ENV_PREFIX onto option name
  1318.            and uppercase the result.
  1319.         */
  1320. PRIVATE void
  1321. #if HAVE_STDC
  1322. make_env_name(char *env_name, char *option_name)
  1323. #else /* K&R style */
  1324. make_env_name( env_name, option_name)
  1325.     char *env_name, *option_name;
  1326. #endif /* HAVE_STDC */
  1327. {
  1328.     int i,c;
  1329.  
  1330.     (void)strcat(strcpy(env_name,ENV_PREFIX),option_name);
  1331.     for(i=sizeof(ENV_PREFIX)-1; (c=env_name[i]) != '\0'; i++) {
  1332.     if( islower(c) )
  1333.         env_name[i] = toupper(c);
  1334.     }
  1335. }
  1336.  
  1337.         /* get_rc_options picks up options from an "rc" file.
  1338.          */
  1339. PRIVATE void
  1340. get_rc_options(VOID)
  1341. {
  1342.   FILE *rc_fp;
  1343.   char rc_option_string[MAX_RC_LINE];
  1344.   int i;
  1345.  
  1346.   rc_option_string[0] = '-';
  1347.  
  1348.   if( (rc_fp = find_rc()) != (FILE *)NULL ) {
  1349.     for(;;) {
  1350.       if( fgets(rc_option_string+1,sizeof(rc_option_string)-1,rc_fp)
  1351.      == (char *)NULL)
  1352.     break;
  1353.                 /* Terminate line at start of comment.
  1354.                    This also changes final \n to \0. */
  1355.       for(i=1; rc_option_string[i] != '\0'; i++) {
  1356.     if(rc_option_string[i] == RC_COMMENT_CHAR ||
  1357.        isspace(rc_option_string[i])) {
  1358.       rc_option_string[i] = '\0';
  1359.       break;
  1360.     }
  1361.       }
  1362.       if(i==1)            /* Skip blank line */
  1363.     continue;
  1364.  
  1365.       set_option(rc_option_string,"startup file");
  1366.     }
  1367.   }
  1368. }
  1369.  
  1370.         /* find_rc locates the "rc" file. */
  1371. PRIVATE FILE *
  1372. find_rc(VOID)
  1373. {
  1374.   FILE *fp;
  1375.   char fname[100];
  1376.   char *homedir=getenv("HOME");
  1377.             /* Look first for file in local directory */
  1378.   (void)strcpy(fname,UNIX_RC_FILE);
  1379.   if( (fp=fopen(fname,"r")) != (FILE *)NULL)
  1380.     return fp;
  1381.  
  1382.             /* Look for alternate name in local directory */
  1383.   (void)strcpy(fname,NONUNIX_RC_FILE);
  1384.   if( (fp=fopen(fname,"r")) != (FILE *)NULL)
  1385.     return fp;
  1386.  
  1387.             /* Allow local option of special home directory
  1388.                for non-unix (usually VMS) systems. */
  1389. #ifdef SPECIAL_HOMEDIR
  1390.   if(homedir == (char *)NULL) {
  1391.     homedir = SPECIAL_HOMEDIR;
  1392.   }
  1393. #endif
  1394.             /* If not found, look in home directory */
  1395.   if(homedir != (char *)NULL) {
  1396.     (void)strcpy(fname,homedir);
  1397. #ifdef UNIX
  1398.     (void)strcat(fname,"/");
  1399. #endif
  1400.     (void)strcat(fname,UNIX_RC_FILE);
  1401.     if( (fp=fopen(fname,"r")) != (FILE *)NULL)
  1402.       return fp;
  1403.  
  1404.             /* If look for alternate name in home directory */
  1405.     (void)strcpy(fname,homedir);
  1406. #ifdef UNIX
  1407.     (void)strcat(fname,"/");
  1408. #endif
  1409.     (void)strcat(fname,NONUNIX_RC_FILE);
  1410.     if( (fp=fopen(fname,"r")) != (FILE *)NULL)
  1411.       return fp;
  1412.   }
  1413.  
  1414.   return (FILE *)NULL;        /* Not found: return NULL */
  1415. }
  1416.  
  1417.  
  1418.     /* set_option processes an option from command line.  Argument s is
  1419.        the option string. First s is compared against boolean switches
  1420.        from list in switchopt[].  If s matches switch string,
  1421.        corresponding flag is set to TRUE.  If no match, then s is compared
  1422.        to the same switches prefixed by "no", and if match is found, then
  1423.        flag is set to FALSE.  Finally, special flags are handled.  If still
  1424.        no match, an error message is generated.
  1425.      */
  1426.  
  1427. PRIVATE void
  1428. #if HAVE_STDC
  1429. set_option(char *s, char *where)
  1430.                     /* Option to interpret, including initial - */
  1431.                         /* String to identify cmd line vs rc file */
  1432. #else /* K&R style */
  1433. set_option(s,where)
  1434.     char *s,        /* Option to interpret, including initial - */
  1435.          *where;        /* String to identify cmd line vs rc file */
  1436. #endif /* HAVE_STDC */
  1437. {
  1438.     int i;
  1439.         /* look for noswitch flags first since otherwise
  1440.            an option starting with no might take precedence */
  1441.     if(strncmp(s+1,"no",2) == 0) {
  1442.         for(i=0; i<NUM_SWITCHES; i++) {
  1443.         if( strncmp(s+3,switchopt[i].name,OPT_MATCH_LEN) == 0) {
  1444.             *(switchopt[i].switchflag) = FALSE;
  1445.             return;
  1446.         }
  1447.         }
  1448.     }
  1449.  
  1450.         /* -noswitch not found: look for nosetting flag */
  1451.     if(strncmp(s+1,"no",2) == 0) {
  1452.         for(i=0; i<NUM_SETTINGS; i++) {
  1453.         if( strncmp(s+3,setting[i].name,OPT_MATCH_LEN) == 0) {
  1454.             *(setting[i].setvalue) = setting[i].turnoff;
  1455.             return;
  1456.         }
  1457.         }
  1458.     }
  1459.  
  1460.                 /* Next look for switches */
  1461.     for(i=0; i<NUM_SWITCHES; i++) {
  1462.         if( strncmp(s+1,switchopt[i].name,OPT_MATCH_LEN) == 0) {
  1463.         *(switchopt[i].switchflag) = TRUE;
  1464.         return;
  1465.         }
  1466.     }
  1467.  
  1468.         /* Handle settings of form "-opt=number" */
  1469.     for(i=0; i<NUM_SETTINGS; i++)
  1470.         if( strncmp(s+1,setting[i].name,OPT_MATCH_LEN) == 0) {
  1471.         char *numstr;
  1472.  
  1473.         numstr = s + OPT_MATCH_LEN;
  1474.         while(++numstr, ! END_OF_OPT(*numstr) )
  1475.         {
  1476.             if((*numstr == '=') || (*numstr == ':'))
  1477.             {            /* Find the assignment operator */
  1478.             numstr++;
  1479.             break;
  1480.             }
  1481.         }
  1482.         if(read_setting(numstr, setting[i].setvalue, setting[i].name,
  1483.                 setting[i].minlimit, setting[i].maxlimit,
  1484.                 setting[i].turnoff,
  1485.                 setting[i].turnon,
  1486.                 setting[i].min_default_value,
  1487.                 setting[i].max_default_value) != 0) {
  1488.           (void)fflush(list_fd);
  1489.           (void)fprintf(stderr,"Setting garbled: %s: ignored\n",s);
  1490.         }
  1491.         return;
  1492.         }
  1493.  
  1494.  
  1495.         /* Handle settings of form "-opt=string" */
  1496.     for(i=0; i<NUM_STRSETTINGS; i++) {
  1497.         int is_a_turnoff=FALSE;
  1498.  
  1499.                 /* First look for setting prefixed by "no"
  1500.                    if it allows turnon/turnoff. */
  1501.         if( strsetting[i].turnoff != (char *)NULL &&
  1502.            strncmp(s+1,"no",2) == 0 &&
  1503.            strncmp(s+3,strsetting[i].name,OPT_MATCH_LEN) == 0) {
  1504.           is_a_turnoff=TRUE;
  1505.         }
  1506.  
  1507.         if(is_a_turnoff ||
  1508.            strncmp(s+1,strsetting[i].name,OPT_MATCH_LEN) == 0) {
  1509.         char *strstart;
  1510.         int numchars;
  1511.  
  1512.         strstart = s + (OPT_MATCH_LEN + 1);
  1513.         while( *strstart != '=' && *strstart != ':'
  1514.               && ! END_OF_OPT(*strstart) )
  1515.             strstart++;    /* Find the = sign */
  1516.         if( END_OF_OPT(*strstart) ) {
  1517.                 /* no = sign: use turnon/turnoff */
  1518.           if(is_a_turnoff)
  1519.             *(strsetting[i].strvalue) = strsetting[i].turnoff;
  1520.           else
  1521.             *(strsetting[i].strvalue) = strsetting[i].turnon;
  1522.         }
  1523.         else {        /* = sign found: use it but forbid -no form */
  1524.             if(is_a_turnoff) {
  1525.               (void)fflush(list_fd);
  1526.               (void)fprintf(stderr,
  1527.                   "No string setting allowed for %s: ignored\n",s);
  1528.               return;
  1529.             }
  1530.             ++strstart;    /* skip past the "=" */
  1531.                 /* In VMS,MSDOS worlds, user might not leave
  1532.                    blank space between options.  If string
  1533.                    is followed by '/', must make a properly
  1534.                    terminated copy.  In any case, make a
  1535.                    copy in case this option comes from
  1536.                    the rc file. */
  1537.             for(numchars=0;!END_OF_OPT(strstart[numchars]);numchars++)
  1538.               continue;
  1539.  
  1540.             *(strsetting[i].strvalue) = (char *)malloc(numchars+1);
  1541.             (void)strncpy( *(strsetting[i].strvalue),
  1542.                    strstart,numchars);
  1543.             (*(strsetting[i].strvalue))[numchars] = '\0';
  1544.         }
  1545.  
  1546.             /* Handle actions needed after new strsetting
  1547.                is read. If it was a turn-on where turnon is
  1548.                NULL, give a warning. */
  1549.         if( *(strsetting[i].strvalue) == (char *)NULL ) {
  1550.           (void)fflush(list_fd);
  1551.           (void)fprintf(stderr,
  1552.                 "String setting missing: %s: ignored\n",s);
  1553.         }
  1554.         else {
  1555.           update_str_options(&strsetting[i]);
  1556.         }
  1557.  
  1558.         return;
  1559.         }
  1560.  
  1561.     }
  1562.         /* No match found: issue error message */
  1563.  
  1564.     (void)fflush(list_fd);
  1565.     (void)fprintf(stderr,"\nUnknown %s switch: %s\n",where,s);
  1566. }
  1567.  
  1568.  
  1569.     /* Routine to read integer setting from string s and check if valid */
  1570.  
  1571. PRIVATE int
  1572. #if HAVE_STDC
  1573. read_setting(char *s, int *setvalue, char *name, int minlimit, int maxlimit, int turnoff, int turnon, int min_default_value, int max_default_value)
  1574. #else /* K&R style */
  1575. read_setting(s, setvalue, name, minlimit, maxlimit, turnoff, turnon,
  1576.          min_default_value,
  1577.          max_default_value)
  1578.     char *s;
  1579.     int *setvalue;
  1580.     char *name;
  1581.     int minlimit, maxlimit,
  1582.          turnon, turnoff,
  1583.          min_default_value, max_default_value;
  1584. #endif /* HAVE_STDC */
  1585. {
  1586.     int given_val;
  1587.  
  1588.     if(strcmp(s,"NO")==0) {    /* -setting=no */
  1589.       *(setvalue) = turnoff;
  1590.     }
  1591.     else if(END_OF_OPT(*s)) { /* -setting */
  1592.       *(setvalue) = turnon;
  1593.     }
  1594.     else if(sscanf(s,"%d", &given_val) == 0) {
  1595.         return -1;    /* error return: garbled setting */
  1596.     }
  1597.     else {        /* If outside limits, set to default */
  1598.         int Ok=TRUE;
  1599.         if(given_val < minlimit) {
  1600.         given_val = min_default_value;
  1601.         Ok = FALSE;
  1602.         }
  1603.         else if(given_val > maxlimit) {
  1604.         given_val = max_default_value;
  1605.         Ok = FALSE;
  1606.         }
  1607.  
  1608.         if(! Ok ) {
  1609.             (void)fflush(list_fd);
  1610.         (void)fprintf(stderr,"\nSetting: %s",name);
  1611.         (void)fprintf(stderr," outside limits %d to %d",
  1612.                 minlimit,maxlimit);
  1613.         (void)fprintf(stderr,": set to default %d\n",given_val);
  1614.         }
  1615.  
  1616.         *(setvalue) = given_val;
  1617.     }
  1618.     return 0;
  1619. }
  1620.  
  1621.             /* Handle actions needed to update things after
  1622.                getting a non-null strsetting option.
  1623.              */
  1624. PRIVATE void
  1625. #if HAVE_STDC
  1626. update_str_options(StrsettingList *strset)
  1627. #else /* K&R style */
  1628. update_str_options(strset)
  1629.   StrsettingList *strset;
  1630. #endif /* HAVE_STDC */
  1631. {
  1632.  
  1633.             /* Handle necessary action for  -out=listfile */
  1634.   if(strset->strvalue == &out_fname)
  1635.     must_open_outfile = TRUE;
  1636.  
  1637.                 /* Update include path */
  1638. #ifdef ALLOW_INCLUDE
  1639.   if(strset->strvalue == &include_path) {
  1640.     append_include_path(include_path);
  1641.   }
  1642. #endif
  1643.  
  1644.                 /* Handle warnings like -f77=list */
  1645.   if(strset->option_list != (WarnOptionList *)NULL) {
  1646.     process_warn_string(*(strset->strvalue), strset->option_list);
  1647.   }
  1648. }
  1649.  
  1650. #define MAX_OPT_LEN 32        /* Big enough to hold any option name */
  1651.  
  1652.                 /* Process list of warn options.  Return
  1653.                    TRUE if "help" requested, else FALSE */
  1654. PRIVATE void
  1655. #if HAVE_STDC
  1656. process_warn_string(char *warn_string, WarnOptionList *warn_option)
  1657.                              /* Names of options to set */
  1658.                                             /* array where options defined */
  1659.                        /* size of warn_option array */
  1660. #else /* K&R style */
  1661. process_warn_string( warn_string, warn_option )
  1662.      char *warn_string;        /* Names of options to set */
  1663.      WarnOptionList warn_option[]; /* array where options defined */
  1664. #endif /* HAVE_STDC */
  1665. {
  1666.   int i,c;
  1667.   char opt_buf[MAX_OPT_LEN+1];
  1668.  
  1669.   if(strcmp(warn_string,"help") == 0) { /* Print warning help screen */
  1670.     list_warn_options(warn_option);
  1671.     return;
  1672.   }
  1673.   else {
  1674.                 /* Loop on warn options in string */
  1675.     while(!END_OF_OPT(*warn_string)) {
  1676.                 /* Copy next warn option into buffer */
  1677.       for(i=0; !END_OF_OPT(*warn_string); ) {
  1678.     c = *warn_string++;
  1679.     if(c == ',' || c == ':') /* quit when reach next warn option */
  1680.       break;
  1681.     if(i<MAX_OPT_LEN)
  1682.       opt_buf[i++] = c;
  1683.       }
  1684.       opt_buf[i] = '\0';
  1685.  
  1686.       set_warn_option(opt_buf, warn_option );
  1687.     }
  1688.   }
  1689.   return;
  1690. }
  1691.  
  1692.             /* Routine to print list of warning options */
  1693. PRIVATE void
  1694. #if HAVE_STDC
  1695. list_warn_options(WarnOptionList *warn_option)
  1696. #else /* K&R style */
  1697. list_warn_options(warn_option)
  1698.      WarnOptionList warn_option[]; /* array of defns */
  1699. #endif /* HAVE_STDC */
  1700. {
  1701.   int i;
  1702.  
  1703.   ++actioncount;    /* Treat as an action so if no files, quit */
  1704.  
  1705.   (void)fprintf(list_fd,"\n%s Warning Options:",warn_option[0].explanation);
  1706.   for(i=1; warn_option[i].name != (char *)NULL; i++) {
  1707.     (void)fprintf(list_fd,"\n  %s [%s]: %s",
  1708.         warn_option[i].name,
  1709.         *(warn_option[i].flag)? "yes" : "no",
  1710.         warn_option[i].explanation);
  1711.   }
  1712.   (void)fprintf(list_fd,"\nPrefix option with no- to turn off warning");
  1713.   (void)fprintf(list_fd,"\nSpecial keywords:");
  1714.   (void)fprintf(list_fd,"\n  %s: %s","help","Print this list");
  1715.   (void)fprintf(list_fd,"\n  %s: %s","all","Set all options");
  1716.   (void)fprintf(list_fd,"\n  %s: %s","none","Clear all options");
  1717.   (void)fprintf(list_fd,"\n");
  1718. }
  1719.  
  1720.             /* Routine to set warning options to given values */
  1721. PRIVATE void
  1722. #if HAVE_STDC
  1723. set_warn_option(char *s, WarnOptionList *warn_option)
  1724. #else /* K&R style */
  1725. set_warn_option(s, warn_option )
  1726.      char *s;
  1727.      WarnOptionList warn_option[];
  1728. #endif /* HAVE_STDC */
  1729. {
  1730.   int i, matchlen, offset;
  1731.   int value;
  1732.  
  1733.             /* Special keyword "all": set all options on */
  1734.   if(strcmp(s,"all") == 0) {
  1735.     for(i=1; warn_option[i].name != (char *)NULL; i++)
  1736.       *(warn_option[i].flag) = TRUE;
  1737.     return;
  1738.   }
  1739.             /* Special keyword "none": set all options off */
  1740.   else if(strcmp(s,"none") == 0 ) {
  1741.     for(i=1; warn_option[i].name != (char *)NULL; i++)
  1742.       *(warn_option[i].flag) = FALSE;
  1743.     return;
  1744.   }
  1745.   else {
  1746.                 /* Look for "no-" prefix on option name */
  1747.     if(strncmp(s,"no-",strlen("no-")) == 0) {
  1748.       offset = strlen("no-");
  1749.       value = FALSE;
  1750.     }
  1751.     else {
  1752.       offset = 0;
  1753.       value = TRUE;
  1754.     }
  1755.                 /* Go thru list to find a match at minimum
  1756.                    nonambiguous length. */
  1757.     for(i=1,matchlen=1; warn_option[i].name != (char *)NULL; i++) {
  1758.             /* Look for a match at current matchlen, then 
  1759.               if found see if unique.  List must have names
  1760.               with matching prefixes adjacent. */
  1761.       while(strncmp(s+offset,warn_option[i].name,matchlen) == 0) {
  1762.     if(warn_option[i+1].name == (char *)NULL ||
  1763.        strncmp(s+offset,warn_option[i+1].name,matchlen) != 0) {
  1764.       *(warn_option[i].flag) = value;
  1765.       return;
  1766.     }
  1767.     else {
  1768.       if(   s[offset+matchlen] == '\0'
  1769.          || warn_option[i].name[matchlen] == '\0') {
  1770.         (void)fflush(list_fd);
  1771.         (void)fprintf(stderr,
  1772.            "\nAmbiguous warning option: %s: ignored\n",s);
  1773.         return;
  1774.       }
  1775.       ++matchlen;
  1776.     }
  1777.       }
  1778.     }
  1779.   }
  1780.   (void)fflush(list_fd);
  1781.   (void)fprintf(stderr,"\nUnknown warning option: %s: ignored\n",s);
  1782.   return;
  1783. }
  1784.  
  1785.     /* Routine to turn off all switches and numeric settings except
  1786.        -word and -wrap.  The effect is as if -no had been given
  1787.        for each switch and setting.  Useful when other features
  1788.        like calltree are being used and checking is not needed.
  1789.     */
  1790. PRIVATE void turn_off_checks(VOID)
  1791. {
  1792.     int save_wordsize=given_wordsize,
  1793.         save_wrapcol=wrap_column,
  1794.         save_source_format=source_format,
  1795.         save_quiet=quiet;
  1796.     int i;
  1797.  
  1798.                 /* Put all switches to FALSE */
  1799.     for(i=0; i<NUM_SWITCHES; i++) {
  1800.       *(switchopt[i].switchflag) = FALSE;
  1801.     }
  1802.  
  1803.                 /* Put all settings to turnoff value */
  1804.     for(i=0; i<NUM_SETTINGS; i++) {
  1805.       *(setting[i].setvalue) = setting[i].turnoff;
  1806.     }
  1807.  
  1808.                 /* Turn off warn lists */
  1809.     for(i=0; i<NUM_STRSETTINGS; i++) {
  1810.       if( strsetting[i].option_list != (WarnOptionList *)NULL ) {
  1811.         set_warn_option( strsetting[i].turnoff,
  1812.                   strsetting[i].option_list);
  1813.                 /* Set strvalue so -help reports correctly */
  1814.         *(strsetting[i].strvalue) = strsetting[i].turnoff;
  1815.       }
  1816.     }
  1817.                 /* Turn off checks without own options */
  1818.     misc_warn = FALSE;
  1819.  
  1820. /* Restore the ones that aren't for checks */
  1821.     quiet=save_quiet;
  1822.     source_format=save_source_format;
  1823.     given_wordsize = save_wordsize;
  1824.     wrap_column = save_wrapcol;
  1825. }
  1826.  
  1827.  
  1828. PRIVATE void
  1829. #if HAVE_STDC
  1830. open_outfile(char *s)        /* open the output file for listing */
  1831. #else /* K&R style */
  1832. open_outfile(s)        /* open the output file for listing */
  1833.     char *s;
  1834. #endif /* HAVE_STDC */
  1835. {
  1836.     char *fullname;        /* given name plus extension */
  1837.     FILE *fd;
  1838.  
  1839.     must_open_outfile = FALSE;    /* Turn off the flag */
  1840.  
  1841.     if(s == (char *) NULL || *s == '\0') {
  1842.         return;        /* No filename: no action  */
  1843.     }
  1844.  
  1845.     fullname = add_ext(s,DEF_LIST_EXTENSION);
  1846.     (void)fflush(list_fd);
  1847.     if( (fd = fopen(fullname,"w")) == (FILE *)NULL) {
  1848.         (void)fprintf(stderr,"\nCannot open %s for output\n",fullname);
  1849.     }
  1850.     else {
  1851.         (void)fprintf(stderr,"\nOutput sent to file %s\n",fullname);
  1852.         list_fd = fd;
  1853.     }
  1854. }
  1855.  
  1856.  
  1857. PRIVATE void
  1858. #if HAVE_STDC
  1859. list_options(FILE *fd)/* List all commandline options, strsettings, and settings */
  1860. #else /* K&R style */
  1861. list_options(fd)/* List all commandline options, strsettings, and settings */
  1862.      FILE *fd;
  1863. #endif /* HAVE_STDC */
  1864. {
  1865.     int i;
  1866.  
  1867.             /* Print the copyright notice */
  1868.     (void)fprintf(fd,"\n%s",COPYRIGHT_DATE);
  1869.     (void)fprintf(fd,"\n%s\n",COPYRIGHT_NOTICE);
  1870.  
  1871.         /* Note: Headings say "default" but to be accurate they
  1872.            should say "current value".  This would be confusing. */
  1873.     (void)fprintf(fd,"\nCommandline options [default]:");
  1874.     for(i=0; i<NUM_SWITCHES; i++) {
  1875.  
  1876.       if( !debug_latest &&
  1877.          strncmp(switchopt[i].explanation,"debug",5) == 0)
  1878.         continue;        /* skip debug switches unless debug mode */
  1879.  
  1880.       (void)fprintf(fd,"\n    %c[no]%s",OPT_PREFIX,switchopt[i].name);
  1881.       (void)fprintf(fd," [%s]",*(switchopt[i].switchflag)? "yes": "no");
  1882.       (void)fprintf(fd,": %s",switchopt[i].explanation);
  1883.     }
  1884.         /* String settings follow switches w/o their own heading */
  1885.     for(i=0; i<NUM_STRSETTINGS; i++) {
  1886.       if( !debug_latest &&
  1887.          strncmp(strsetting[i].explanation,"debug",5) == 0)
  1888.         continue;        /* skip debug settings unless debug mode */
  1889.  
  1890.       (void)fprintf(fd,"\n    %c%s=str ",OPT_PREFIX,strsetting[i].name);
  1891.             /* If strvalue has been given, list it.  Otherwise,
  1892.                if this has an optionlist, the default value is
  1893.                given as 'name' of option 0, which is the title
  1894.                entry of the list.
  1895.             */
  1896.       (void)fprintf(fd,"[%s]",
  1897.         *(strsetting[i].strvalue)?
  1898.             *(strsetting[i].strvalue):
  1899.             strsetting[i].option_list != (WarnOptionList *)NULL?
  1900.                strsetting[i].option_list[0].name:
  1901.                "NONE");
  1902.       (void)fprintf(fd,": %s",strsetting[i].explanation);
  1903.       if( strsetting[i].option_list != (WarnOptionList *)NULL )
  1904.         (void)fprintf(fd,"\n        Use %c%s=help for list of options",
  1905. #ifdef OPT_PREFIX_SLASH
  1906.               '/',
  1907. #else
  1908.               '-',
  1909. #endif
  1910.               strsetting[i].name);
  1911.     }
  1912.  
  1913.     (void)fprintf(fd,"\nSettings (legal range) [default]:");
  1914.     for(i=0; i<NUM_SETTINGS; i++) {
  1915.  
  1916.       if( !debug_latest &&
  1917.          strncmp(setting[i].explanation,"debug",5) == 0)
  1918.         continue;        /* skip debug settings unless debug mode */
  1919.  
  1920.       (void)fprintf(fd,"\n    %c%s=dd ",OPT_PREFIX,setting[i].name);
  1921.       (void)fprintf(fd,"(%d to %d) ",setting[i].minlimit,
  1922.           setting[i].maxlimit);
  1923.       (void)fprintf(fd,"[%d]",*(setting[i].setvalue));
  1924.       (void)fprintf(fd,": %s",setting[i].explanation);
  1925.     }
  1926.  
  1927.     (void)fprintf(fd,
  1928.     "\n(First %d chars of option name significant)\n",OPT_MATCH_LEN);
  1929. }
  1930.  
  1931.  
  1932. PRIVATE void
  1933. wrapup(VOID)    /* look at cross references, etc. */
  1934. {
  1935.  
  1936.     if(debug_hashtab || debug_glob_symtab)
  1937.       debug_symtabs();
  1938.  
  1939.                 /* Interpret -[no]ext option as synonym for
  1940.                    turning on[off] bit 1 in ext_usage_check.
  1941.                  */
  1942.     if(ext_def_check) {
  1943.       if(!checks_on)    /* -nocheck followed by -ext */
  1944.         ext_usage_check |= 0x1;
  1945.     }
  1946.     else {
  1947.       ext_usage_check &= 0x2; /* -noext given */
  1948.     }
  1949.  
  1950.                 /* Sort out calltree options.  Don't forget
  1951.                    that reflist and vcg can be set by their
  1952.                    own convenience flags, if -call not given.
  1953.                 */
  1954.     if(call_tree_options > 0) {
  1955.       print_call_tree = FALSE;
  1956.       print_ref_list = FALSE;
  1957. #ifdef VCG_SUPPORT
  1958.       print_vcg_list = FALSE;
  1959. #endif
  1960.       switch( call_tree_options & 0x0003 ) { /* Low-order two bits => format */
  1961.       case CALLTREE_REFLIST:
  1962.         print_ref_list = TRUE;
  1963.         break;
  1964. #ifdef VCG_SUPPORT
  1965.       case CALLTREE_VCG:
  1966.         print_vcg_list = TRUE;
  1967.         break;
  1968. #endif
  1969.       default:
  1970.         print_call_tree = TRUE;
  1971.         break;
  1972.       }
  1973.     }
  1974.                 /* VCG output file uses stem of file
  1975.                    containing main prog or 1st file on
  1976.                    command line. If none, output is to stdout.
  1977.                  */
  1978. #ifdef VCG_SUPPORT
  1979.     if(print_vcg_list) {
  1980.       vcg_fd = (input_fd == stdin || main_filename == (char *)NULL)?
  1981.         stdout :
  1982.         fopen(new_ext(main_filename,DEF_VCG_EXTENSION) ,"w");
  1983.     }
  1984. #endif
  1985.  
  1986.     visit_children();    /* Make call tree & check visited status */
  1987.     check_com_usage();    /* Look for unused common stuff */
  1988.     check_comlists();    /* Look for common block mismatches */
  1989.     check_arglists();    /* Look for subprog defn/call mismatches */
  1990.  
  1991. #ifdef DEBUG_GLOBAL_STRINGS
  1992.     if(debug_latest)
  1993.       print_global_strings();
  1994. #endif
  1995. }
  1996.  
  1997.  
  1998. #define MODE_DEFAULT_EXT 1
  1999. #define MODE_REPLACE_EXT 2
  2000. PRIVATE char *
  2001. #if HAVE_STDC
  2002. append_extension(char *s, char *ext, int mode)
  2003. #else /* K&R style */
  2004. append_extension(s,ext,mode)
  2005.      char *s,*ext;
  2006.      int mode;
  2007. #endif /* HAVE_STDC */
  2008. {
  2009.         /* MODE_DEFAULT_EXT: Adds extension to file name s if
  2010.            none is present, and returns a pointer to the
  2011.            new name.  If extension was added, space is allocated
  2012.            for the new name.  If not, simply  returns pointer
  2013.            to original name.  MODE_REPLACE_EXT: same, except given
  2014.            extension replaces given one if any.
  2015.         */
  2016.     int i,len;
  2017.     char *newname;
  2018. #ifdef OPTION_PREFIX_SLASH    /* set len=chars to NUL or start of /opt */
  2019.     for(len=0; s[len] != '\0' && s[len] != '/'; len++)
  2020.       continue;
  2021. #else
  2022.     len=(unsigned)strlen(s);
  2023. #endif
  2024.         /* Search backwards till find the dot, but do not
  2025.            search past directory delimiter
  2026.         */
  2027.     for(i=len-1; i>0; i--) {
  2028.         if(s[i] == '.'
  2029. #ifdef UNIX
  2030.            || s[i] == '/'
  2031. #endif
  2032. #ifdef VMS
  2033.            || s[i] == ']' || s[i] == ':'
  2034. #endif
  2035. #ifdef MSDOS
  2036.            || s[i] == '\\' || s[i] == ':'
  2037. #endif
  2038.            )
  2039.         break;
  2040.     }
  2041.  
  2042.     if(mode == MODE_REPLACE_EXT) {
  2043.       if(s[i] == '.')    /* declare length = up to the dot */
  2044.         len = i;
  2045.       newname = (char *) malloc( (unsigned)(len+(unsigned)strlen(ext)+1) );
  2046.       (void)strncpy(newname,s,len);
  2047.       (void)strcpy(newname+len,ext);
  2048.     }
  2049.     else {            /* MODE_DEFAULT_EXT */
  2050. #ifdef OPTION_PREFIX_SLASH
  2051.         /* create new string if new ext or trailing /option */
  2052.       if(s[i] != '.' || s[len] != '\0') {
  2053.         if(s[i] != '.') {    /* no extension given */
  2054.           newname = (char *) malloc( (unsigned)(len+
  2055.                             (unsigned)strlen(ext)+1) );
  2056.           (void)strncpy(newname,s,len);
  2057.           (void)strcpy(newname+len,ext);
  2058.         }
  2059.         else {        /* extension given but /option follows */
  2060.           newname = (char *) malloc( (unsigned)(len+1) );
  2061.           (void)strncpy(newname,s,len);
  2062.         }
  2063.       }
  2064. #else
  2065.       if(s[i] != '.') {
  2066.         newname = (char *) malloc( (unsigned)(len+
  2067.                           (unsigned)strlen(ext)+1) );
  2068.         (void)strcpy(newname,s);
  2069.         (void)strcat(newname,ext);
  2070.       }
  2071. #endif
  2072.       else {
  2073.         newname = s;    /* use as is */
  2074.       }
  2075.     }
  2076.  
  2077.     return newname;
  2078. }
  2079.  
  2080.         /* Adds default extension to source file name, replacing
  2081.            any that is present, and returns a pointer to the
  2082.            new name.  Space is allocated for the new name.
  2083.         */
  2084. char *
  2085. #if HAVE_STDC
  2086. add_ext(char *s, char *ext)            /* adds default filename extension to s */
  2087. #else /* K&R style */
  2088. add_ext(s,ext)            /* adds default filename extension to s */
  2089.     char *s,*ext;
  2090. #endif /* HAVE_STDC */
  2091. {
  2092.   return append_extension(s,ext,MODE_DEFAULT_EXT);
  2093. }
  2094.  
  2095. PRIVATE char *
  2096. #if HAVE_STDC
  2097. new_ext(char *s, char *ext)
  2098. #else /* K&R style */
  2099. new_ext(s,ext)
  2100.     char *s,*ext;
  2101. #endif /* HAVE_STDC */
  2102. {
  2103.   return append_extension(s,ext,MODE_REPLACE_EXT);
  2104. }
  2105.  
  2106.  
  2107. PRIVATE int
  2108. #if HAVE_STDC
  2109. cistrncmp(char *s1, char *s2, unsigned int n)            /* case-insensitive strncmp */
  2110. #else /* K&R style */
  2111. cistrncmp(s1,s2,n)            /* case-insensitive strncmp */
  2112.      char *s1,*s2;
  2113.      unsigned n;
  2114. #endif /* HAVE_STDC */
  2115. {
  2116.   while( n != 0 &&
  2117.       (isupper(*s1)?tolower(*s1):*s1) == (isupper(*s2)?tolower(*s2):*s2) ) {
  2118.     if(*s1 == '\0')
  2119.       return 0;
  2120.     if(*s2 == '\0')
  2121.       break;
  2122.     ++s1; ++s2; --n;
  2123.   }
  2124.   return n==0? 0: *s1 - *s2;
  2125. }
  2126.  
  2127. int
  2128. #if HAVE_STDC
  2129. has_extension(char *name, char *ext)        /* true if name ends in ext */
  2130. #else /* K&R style */
  2131. has_extension(name,ext)        /* true if name ends in ext */
  2132.   char *name,*ext;
  2133. #endif /* HAVE_STDC */
  2134. {
  2135.   unsigned name_len, ext_len;
  2136.   int stem_len;
  2137.   ext_len = strlen(ext);
  2138.  
  2139. #ifdef VMS    /* shell_glob adds version number: filename.ext;1 */
  2140.   if(strrchr(name,';') != (char *)NULL) {
  2141.     name_len = strrchr(name,';') - name; /* distance to the semicolon */
  2142.   }
  2143.   else
  2144. #endif
  2145.     name_len=strlen(name);    /* distance to the null */
  2146.  
  2147.   stem_len = (unsigned)(name_len - ext_len); /* distance to the dot */
  2148.  
  2149.   if( stem_len >= 0 &&
  2150.      (name_len-stem_len) == ext_len &&
  2151.      cistrncmp(name+stem_len,ext,ext_len) == 0 )
  2152.     return TRUE;
  2153.   else
  2154.     return FALSE;
  2155. }
  2156.  
  2157.         /* Add an include directory path to list of paths */
  2158. #ifdef ALLOW_INCLUDE
  2159. PRIVATE void
  2160. #if HAVE_STDC
  2161. append_include_path(char *new_path)
  2162. #else /* K&R style */
  2163. append_include_path(new_path)
  2164.      char *new_path;
  2165. #endif /* HAVE_STDC */
  2166. {
  2167.   IncludePathNode *new_path_node, *p;
  2168.   if((new_path_node=(IncludePathNode *)malloc(sizeof(IncludePathNode)))
  2169.      ==(IncludePathNode *)NULL) {
  2170.     (void)fflush(list_fd);
  2171.     (void)fprintf(stderr,"\nmalloc error getting path list");
  2172.   }
  2173.   else {
  2174.     new_path_node->link = (IncludePathNode *)NULL;
  2175.     new_path_node->include_path = new_path;
  2176.                 /* Append the new node at end of list */
  2177.     if((p=include_path_list) == (IncludePathNode *)NULL)
  2178.       include_path_list = new_path_node;
  2179.     else {
  2180.       while(p->link != (IncludePathNode *)NULL)
  2181.     p = p->link;
  2182.       p->link = new_path_node;
  2183.     }
  2184.   }
  2185. #ifdef DEBUG_INCLUDE_PATH    /* Print path as it grows */
  2186.   if(getenv("DEBUG")) {
  2187.     fprintf(list_fd,"\nINCLUDE path=");
  2188.     for(p=include_path_list; p != (IncludePathNode *)NULL; p=p->link) {
  2189.       fprintf(list_fd,"%s ",p->include_path);
  2190.     }
  2191.     fprintf(list_fd,"\n");
  2192.   }
  2193. #endif
  2194. }
  2195. #endif/*ALLOW_INCLUDE*/
  2196.  
  2197. PRIVATE void
  2198. resource_summary(VOID)
  2199. {
  2200. #ifdef DEBUG_SIZES
  2201.   if(debug_latest)
  2202.     print_sizeofs();    /* give sizeof various things */
  2203. #endif
  2204.  
  2205.   (void)fprintf(list_fd,
  2206.    "\n     Here are the amounts of ftnchek's resources that were used:\n");
  2207.  
  2208.   (void)fprintf(list_fd,
  2209.    "\nSource lines processed = %lu statement + %lu comment = %lu total",
  2210.         tot_stmt_line_count,
  2211.         tot_line_count-tot_stmt_line_count, /*tot_comment_line_count*/
  2212.         tot_line_count);
  2213.  
  2214.   (void)fprintf(list_fd,
  2215.    "\nTotal executable statements = %lu, max in any module = %lu",
  2216.         tot_exec_stmt_count,
  2217.         max_exec_stmt_count);
  2218.  
  2219.   (void)fprintf(list_fd,
  2220.    "\nTotal number of modules in program = %lu",
  2221.         tot_module_count);
  2222.  
  2223.   (void)fprintf(list_fd,
  2224.    "\nMax identifier name chars used = %lu local, %lu global, chunk size %lu",
  2225.             max_loc_strings,
  2226.             glob_strings_used,
  2227.             (unsigned long)STRSPACESZ);
  2228.   (void)fprintf(list_fd,
  2229.     "\nMax token text chars used = %lu, chunk size %lu ",
  2230.             max_srctextspace,
  2231.             (unsigned long)STRSPACESZ);
  2232.   (void)fprintf(list_fd,
  2233.     "\nMax local symbols used =  %lu out of %lu available",
  2234.             max_loc_symtab,
  2235.             (unsigned long)LOCSYMTABSZ);
  2236.   (void)fprintf(list_fd,
  2237.     "\nMax global symbols used = %lu out of %lu available",
  2238.             max_glob_symtab,
  2239.             (unsigned long)GLOBSYMTABSZ);
  2240.   (void)fprintf(list_fd,
  2241.     "\nMax number of parameter info fields used = %lu, chunk size = %lu",
  2242.             max_paraminfo,
  2243.             (unsigned long)PARAMINFOSPACESZ);
  2244.   (void)fprintf(list_fd,
  2245.     "\nMax number of tokenlists used = %lu, chunk size = %lu",
  2246.             max_tokenlists,
  2247.             (unsigned long)TOKHEADSPACESZ);
  2248.   (void)fprintf(list_fd,
  2249.     "\nMax token list/tree space used = %lu, chunk size = %lu",
  2250.             max_token_space,
  2251.             (unsigned long)TOKENSPACESZ);
  2252.   (void)fprintf(list_fd,
  2253.     "\nNumber of subprogram invocations = %lu totaling %lu args",
  2254.             arglist_head_used,
  2255.             arglist_element_used);
  2256.   (void)fprintf(list_fd,
  2257.     "\nArgument list header and element chunk sizes = %lu and %lu",
  2258.             (unsigned long)ARGLISTHEADSZ,
  2259.             (unsigned long)ARGLISTELTSZ);
  2260.   (void)fprintf(list_fd,
  2261.     "\nNumber of common block decls = %lu totaling %lu variables",
  2262.             comlist_head_used,
  2263.             comlist_element_used);
  2264.   (void)fprintf(list_fd,
  2265.     "\nCommon list header and element chunk sizes = %lu and %lu",
  2266.             (unsigned long)COMLISTHEADSZ,
  2267.             (unsigned long)COMLISTELTSZ);
  2268.   (void)fprintf(list_fd,
  2269.     "\nNumber of array dim ptrs used = %lu, chunk size = %lu",
  2270.             max_ptrspace,
  2271.             (unsigned long)PTRSPACESZ);
  2272.  
  2273. #ifdef DEBUG_SIZES
  2274.   (void)fprintf(list_fd,
  2275.     "\nIdentifier hashtable size = %6lu",
  2276.             (unsigned long)HASHSZ);
  2277. #ifdef KEY_HASH/* not used any more*/
  2278.   (void)fprintf(list_fd,
  2279.     "\nKeyword hashtable size = %6lu",
  2280.             (unsigned long)KEYHASHSZ);
  2281. #endif
  2282. #ifdef COUNT_REHASHES
  2283.   (void)fprintf(list_fd,
  2284.     "\nIdentifier rehash count = %6lu",
  2285.             rehash_count);
  2286. #endif
  2287.   (void)fprintf(list_fd,
  2288.     "\nIntrinsic function hashtable size=%6lu, clash count=%lu",
  2289.             (unsigned long)INTRINS_HASHSZ,
  2290.             intrins_clashes);
  2291. #endif /*DEBUG_SIZES*/
  2292.  
  2293.   (void)fprintf(list_fd,"\n\n");
  2294. }
  2295.