1 /* $Id: options.c,v 1.42 2004/12/29 19:27:25 moniot Exp $
2
3 Definitions of command-line options and routines to set them.
4
5 */
6
7 /*
8
9
10 Copyright (c) 2001 by Robert K. Moniot.
11
12 Permission is hereby granted, free of charge, to any person
13 obtaining a copy of this software and associated documentation
14 files (the "Software"), to deal in the Software without
15 restriction, including without limitation the rights to use,
16 copy, modify, merge, publish, distribute, sublicense, and/or
17 sell copies of the Software, and to permit persons to whom the
18 Software is furnished to do so, subject to the following
19 conditions:
20
21 The above copyright notice and this permission notice shall be
22 included in all copies or substantial portions of the
23 Software.
24
25 THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY
26 KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE
27 WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
28 PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR
29 COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
30 LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR
31 OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
32 SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
33
34 Acknowledgement: the above permission notice is what is known
35 as the "MIT License."
36 */
37
38 #include <stdio.h>
39 #include <string.h>
40 #if HAVE_STRINGS_H
41 #include <strings.h> /* we use strncasecmp */
42 #endif
43 #include <ctype.h>
44 #include "ftnchek.h"
45 #include "options.h" /* Prototypes of external routines defined below */
46 #include "utils.h" /* we use strncasecmp */
47
48
49 typedef enum { /* for isacheck fields. Used to suppress -nocheck */
50 NOT_A_CHECK, IS_A_CHECK
51 } isacheck_t;
52
53 /* Define WarnOptionList struct here */
54 typedef struct {
55 char *name; /* user knows the sub-setting by this name */
56 int *flag; /* ptr to the option variable itself */
57 char *explanation; /* for use by -warning=help */
58 } WarnOptionList;
59
60 /* Define StrsettingList struct here */
61 typedef struct {
62 char *name; /* user knows the setting by this name */
63 char **strvalue; /* the string argument goes here */
64 char *turnon, *turnoff; /* e.g. "all", "none" */
65 isacheck_t isacheck; /* tells -nocheck to turn it off */
66 WarnOptionList *option_list;/* this holds the set of options */
67 /* For compatibility with -option=num form: */
68 PROTO(void (*numeric_form_handler),(int num, char *setting_name));
69 char *explanation; /* for use by -help */
70 } StrsettingList;
71
72 extern int yydebug; /* for grammar debugging via -yydebug */
73
74 /* Prototypes of private routines defined */
75
76 PROTO(PRIVATE void append_include_path,( char *new_path ));
77
78 PROTO(PRIVATE FILE *find_rc,( void ));
79
80 PROTO(PRIVATE void list_warn_options,( StrsettingList *strsetting ));
81
82 PROTO(PRIVATE void make_env_name,( char *env_name, char *option_name ));
83
84 PROTO(PRIVATE void mutual_exclude, ( WarnOptionList wList[], const char *opt_name,
85 int *thisflag, int *otherflags[] ));
86
87 PROTO(PRIVATE void process_warn_string,
88 ( char *warn_string, StrsettingList *strsetting ));
89
90 PROTO(PRIVATE int str_to_num,(char *s));
91
92 PROTO(PRIVATE int read_setting,( char *s, int *setvalue, char *name, int
93 minlimit, int maxlimit, int turnoff, int
94 turnon, int min_default_value, int
95 max_default_value ));
96
97 PROTO(PRIVATE void set_warn_option,
98 ( char *s, WarnOptionList warn_option[] ));
99
100 PROTO(PRIVATE void set_warn_option_value, ( int *flag, int value));
101
102 PROTO(PRIVATE void update_str_options,( StrsettingList *strset ));
103
104 PROTO(PRIVATE int wildcard_match, (char *pat, char *str));
105
106
107 /* The following routines handle compatibility with older
108 numeric form of settings that are now WarnOptionLists.
109 */
110 PROTO(PRIVATE void argcheck_numeric_option, ( int value, char *setting_name ));
111
112 PROTO(PRIVATE void arraycheck_numeric_option, ( int value, char *setting_name ));
113
114 PROTO(PRIVATE void calltree_numeric_option, ( int value, char *setting_name ));
115
116 PROTO(PRIVATE void comcheck_numeric_option, ( int value, char *setting_name ));
117
118 PROTO(PRIVATE void intrinsic_numeric_option,( int value, char *setting_name ));
119
120 PROTO(PRIVATE void makedcl_numeric_option, ( int value, char *setting_name ));
121
122 PROTO(PRIVATE void mkhtml_numeric_option, ( int value, char *setting_name ));
123
124 PROTO(PRIVATE void source_numeric_option, ( int value, char *setting_name ));
125
126 PROTO(PRIVATE void usage_numeric_option, ( int value, char *setting_name ));
127
128 PROTO(PRIVATE void numeric_option_error,( char *s, int minlimit, int maxlimit ));
129
130 /* Here we define the commandline options. Most options are boolean
131 switchopts, with "no" prefix to unset them. Others (called
132 settings) are numeric quantities, defined using "=num".
133 A third category (strsettings) are string quantities, eg filenames.
134 The argument "?" will cause list of options to be printed out.
135 For VMS, options can be prefixed with either "-" or "/",
136 but messages will use the canonical form. Since VMS allows
137 options to be smushed together, end-of-option is signalled by
138 either NUL or the / of next option.
139 */
140
141 #ifdef OPTION_PREFIX_SLASH
142 #define OPT_PREFIX '/' /* Canonical VMS prefix for commandline options */
143 #define END_OF_OPT( C ) ((C) == '\0' || (C) == '/')
144 #else
145 #define OPT_PREFIX '-' /* Canonical Unix prefix for commandline options */
146 #define END_OF_OPT( C ) ((C) == '\0')
147 #endif
148
149 #define OPT_MATCH_LEN 3 /* Options are matched only in 1st 3 chars */
150 #define NUM_SWITCHES (sizeof(switchopt)/sizeof(switchopt[0]))
151 #define NUM_SETTINGS (sizeof(setting)/sizeof(setting[0]))
152 #define NUM_STRSETTINGS (sizeof(strsetting)/sizeof(strsetting[0]))
153 #define MAX_OPT_LEN 32 /* Big enough to hold any warn option name */
154
155
156 /* Adding new options:
157
158 New options with boolean (switchopt) or numeric (setting)
159 values can be added to the lists below by inserting a definition
160 using the same syntax as the others, and declaring the
161 controlled variable with a line in ftnchek.h of the form:
162 OPT(type,name,default-value);
163 No other changes are needed. (For boolean options, make
164 sure they precede "-debug" in order for them to appear in
165 the -help page.)
166
167 New options with string values (strsetting) are added
168 similarly, but they have option_list and numeric_form_handler
169 fields that must also be defined. The strsettings come in
170 two flavors: those whose string value is used literally
171 (like -include) and those whose string value is a list of
172 sub-options (like -f77). For the first type, just set the
173 option_list and numeric_form_handler fields to NULL. For
174 the second type, create a new WarnOptionList following the
175 pattern of f77_warn_option. This list must precede the
176 strsettings definition. For each item in this list, a
177 corresponding char * variable (e.g. f77_warn_list) must
178 be declared as well. Then insert the name of the list
179 into the option_list field, and the name of the companion
180 variable into the strvalue field, of the strsetting entry. The
181 numeric_form_handler field is used for strsettings that
182 used to take a numeric value and have been converted to the
183 option-list form. See usage_numeric_handler for an example
184 of how these work. This field is NULL if there is no
185 handler. If there is a handler, put its prototype with the
186 others above, add the code at a suitable point in this
187 file, and put its name in the numeric_form_handler field of
188 the WarnOptionList.
189
190 */
191
192
193 /* Option definitions: */
194
195 /* List of switches is defined first. Each entry gives the
196 name and the corresponding flag variable to be set
197 or cleared. See set_option() for processing of switches.
198
199 N.B. list_options() will suppress printing of any options
200 whose explanation starts with "debug" unless the -debug
201 switch was previously given.
202 */
203 PRIVATE struct {
204 char *name; /* User knows it by this name */
205 int *switchflag; /* Pointer to variable that controls it */
206 char *explanation; /* For use by -help */
207 isacheck_t isacheck; /* Tells -nocheck to turn it off */
208 } switchopt[]={
209 {"brief", &brief,
210 "briefer form of error messages",NOT_A_CHECK},
211 {"check", &do_check,
212 "perform checking",IS_A_CHECK},
213 {"declare", &decls_required,
214 "list undeclared variables",IS_A_CHECK},
215 {"division", &div_check,
216 "catch possible div by 0",IS_A_CHECK},
217 {"extern", &usage_ext_undefined,
218 "check if externals defined",IS_A_CHECK},
219 {"help", &help_screen,
220 "print help screen",NOT_A_CHECK},
221 {"library", &library_mode,
222 "treat next files as library",NOT_A_CHECK},
223 {"list", &do_list,
224 "print program listing",NOT_A_CHECK},
225 {"novice", &novice_help,
226 "extra help for novices",NOT_A_CHECK},
227 {"pure", &pure_functions,
228 "functions have no side effects",IS_A_CHECK},
229 {"quiet", &quiet,
230 "less verbose output",NOT_A_CHECK},
231 {"reference", &print_ref_list,
232 "print who-calls-who reference list",NOT_A_CHECK},
233 {"resources", &show_resources,
234 "show info on resource usage",NOT_A_CHECK},
235 {"sixchar", &sixclash,
236 "catch nonunique names",IS_A_CHECK},
237 {"sort", &print_topo_sort,
238 "prerequisite-order sort of modules",NOT_A_CHECK},
239 {"symtab", &do_symtab,
240 "print symbol table info",NOT_A_CHECK},
241 #ifdef VCG_SUPPORT
242 {"vcg", &print_vcg_list,
243 "print call graph in vcg format",NOT_A_CHECK},
244 #endif
245 {"version", &print_version,
246 "print version number",NOT_A_CHECK},
247 {"volatile", &comcheck_volatile,
248 "assume volatile common blocks",IS_A_CHECK},
249
250 {"debug", &debug_latest,
251 "debug latest code",IS_A_CHECK},
252 {"global", &debug_glob_symtab,
253 "debug global symtab info",IS_A_CHECK},
254 {"grammar", &debug_parser,
255 "debug printout in parser",IS_A_CHECK},
256 {"hashtable", &debug_hashtab,
257 "debug printout of hashtable",IS_A_CHECK},
258 {"local", &debug_loc_symtab,
259 "debug local symtab info",IS_A_CHECK},
260 #if defined(DEBUG_FORLEX) || defined(DEBUG_IS_KEYWORD)
261 {"tokens", &debug_lexer,
262 "debug printout in lexer",IS_A_CHECK},
263 #endif
264 {"yydebug", &yydebug,
265 "debug via yydebug",IS_A_CHECK},
266 };
267
268
269 /* List of settings is defined here. Each entry gives
270 the name, the corresponding variable, the range
271 of permitted values, the value for turning it off,
272 the values to assign if below or above the limits rsptly,
273 whether it is a check to be turned off by -nocheck,
274 followed by brief explanation.
275 See set_option() for processing. */
276 PRIVATE struct {
277 char *name;
278 int *setvalue;
279 int minlimit,maxlimit,turnoff,turnon,min_default_value,max_default_value;
280 isacheck_t isacheck;
281 char *explanation;
282 } setting[]={
283 {"columns", &fixed_max_stmt_col, 72, MAXLINE, 72, MAXLINE, 72, MAXLINE, NOT_A_CHECK,
284 "max fixed-form line length processed"},
285 {"errors",&error_cascade_limit, 0, 999, 0, DEF_ERROR_CASCADE_LIMIT, 0, 999, NOT_A_CHECK,
286 "max number of error messages per cascade"},
287 {"pointersize",&given_ptrsize, 1, 16, PTRSIZE, PTRSIZE, 1, 16, NOT_A_CHECK,
288 "standard pointer size in bytes"},
289 {"wordsize", &given_wordsize, 0, 16, 0, BpW, 0, 16, NOT_A_CHECK,
290 "standard wordsize in bytes (0=no default)"},
291 {"wrap", &wrap_column, 0, 999, 0, WRAP_COLUMN, 0, 999, NOT_A_CHECK,
292 "width of page to wrap error messages"},
293 };
294
295
296
297
298 /* Now we define the various "warn list" options. Each
299 has a char* pointer used to point to the options given
300 with the command-line argument.
301 Each entry in the WarnOptionList has the name of the
302 sub-option, the address of the flag variable it
303 controls, and an explanation used when printing the
304 help page for the option.
305
306 Each list must be alphabetized or at least options with
307 matching prefix strings must be adjacent. When a
308 new option list is defined, it must also be entered
309 into strsetting array below.
310 */
311
312 PRIVATE char *argcheck_warn_list=(char *)NULL;/* Arg mismatches to warn about */
313
314 PRIVATE WarnOptionList
315 argcheck_warn_option[]={
316 {
317 #if ARGCHECK_ALL
318 "all" /* used by -help */
319 #else
320 "none"
321 #endif
322 , (int *)NULL,"Function Argument Mismatch Warning"},/* Title for list */
323 {"arrayness", &argcheck_arrayness,
324 "argument arrayness mismatch"},
325 {"type", &argcheck_argtype,
326 "argument type mismatch"},
327 {"function-type", &argcheck_functype,
328 "function type mismatch"},
329 {"number", &argcheck_argnumber,
330 "wrong number of arguments"},
331 {(char *)NULL, (int *)NULL, (char *)NULL},
332 };
333
334
335 PRIVATE char *arraycheck_warn_list=(char *)NULL;/* Arg arrayness warnings */
336
337 PRIVATE WarnOptionList
338 arraycheck_warn_option[]={
339 {
340 #if ARRAYCHECK_ALL
341 "all" /* used by -help */
342 #else
343 "none"
344 #endif
345 , (int *)NULL,"Argument Arrayness Mismatch Warning"},/* Title for list */
346 {"dimensions", &arraycheck_dims,
347 "different number of dimensions"},
348 {"size", &arraycheck_size,
349 "different number of elements"},
350 {(char *)NULL, (int *)NULL, (char *)NULL},
351 };
352
353
354 PRIVATE char *calltree_opt_list=(char *)NULL;/* Subprogram call graph options */
355
356 PRIVATE WarnOptionList
357 calltree_option[]={ /* not really a warning */
358 {
359 "none" /* used by -help */
360 , (int *)NULL,"Call-Tree Output"},/* Title for list */
361 {"prune", &call_tree_prune,
362 "prune repeated subtrees"},
363 {"reference", &print_ref_list,
364 "produce call tree in who-calls-who format"},
365 {"sort", &call_tree_sort,
366 "sort call tree alphabetically"},
367 {"tree", &print_call_tree,
368 "produce call tree in text format"},
369 #ifdef VCG_SUPPORT
370 {"vcg", &print_vcg_list,
371 "produce call tree in vcg format"},
372 #endif
373 {(char *)NULL, (int *)NULL, (char *)NULL},
374 };
375
376
377 PRIVATE char *comcheck_warn_list=(char *)NULL;/* Common block mismatch warnings */
378
379 PRIVATE WarnOptionList
380 comcheck_warn_option[]={
381 {
382 #if COMCHECK_ALL
383 "dimensions,exact,length,type" /* used by -help */
384 #else
385 "none"
386 #endif
387 , (int *)NULL,"Common Block Mismatch Warning"},/* Title for list */
388 {"dimensions", &comcheck_dims,
389 "arrays differ in dimensions"},
390 {"exact", &comcheck_by_name,
391 "require variable-by-variable correspondence"},
392 {"length", &comcheck_length,
393 "blocKs differ in total length"},
394 {"type", &comcheck_type,
395 "data type mismatch at corresponding locations"},
396 {"volatile", &comcheck_volatile,
397 "assume blocks are volatile"},
398 {(char *)NULL, (int *)NULL, (char *)NULL},
399 };
400
401
402 PRIVATE char *crossref_opt_list=(char *)NULL; /* Cross-ref listing options */
403
404 PRIVATE WarnOptionList
405 crossref_option[]={ /* not a warning */
406 {
407 "none" /* used by -help */
408 , (int *)NULL, "Cross-Ref Output"}, /* Title for list */
409 {"calls", &print_xref_list, "print call cross-reference list"},
410
411 {"common", &print_com_xrefs,
412 "print common block cross-reference list"},
413
414 {"labels", &print_lab_refs, "print label cross-reference list"},
415
416 {(char *)NULL, (int *)NULL, (char *)NULL},
417 };
418 /* Here define list of -f77 warning options. These are set
419 or cleared by -[no]f77=list option. Note that the variables
420 are FALSE if feature is ALLOWED, and TRUE if feature is
421 to be WARNED about.
422 */
423
424 PRIVATE char *f77_warn_list=(char *)NULL; /* Non F77 extensions to warn about */
425
426 PRIVATE WarnOptionList
427 f77_warn_option[]={
428 {
429 #if F77_ALL
430 "all" /* used by -help */
431 #else
432 "none"
433 #endif
434 , (int *)NULL, "Fortran 77 Warning"}, /* Title for list */
435 {"accept-type", &f77_accept_type,
436 "ACCEPT and TYPE I/O statements"},
437 {"array-bounds", &f77_array_bounds,
438 "array bounds expressions"},
439 {"assignment-stmt", &f77_assignment,
440 "assignment involving array"},
441 {"attribute-based-decl",&f77_attrbased_typedecl,
442 "attribute-based (:: -style) variable declaration"},
443 {"automatic-array", &f77_automatic_array,
444 "local array of variable size"},
445 {"backslash", &f77_unix_backslash,
446 "Unix backslash escape in strings"},
447 {"byte", &f77_byte,
448 "BYTE data type"},
449 {"case-construct", &f77_case_construct,
450 "CASE construct"},
451 {"character", &f77_char_extension,
452 "Character variable defined length <= 0"},
453 {"common-subprog-name",&f77_common_subprog_name,
454 "Common block & subprog with same name"},
455 {"construct-name", &f77_construct_name,
456 "Construct names on DO statements"},
457 {"continuation", &f77_20_continue,
458 "More than 19 continuation lines"},
459 {"cpp", &f77_unix_cpp,
460 "Unix C preprocessor directives"},
461 {"cray-pointer", &f77_cray_pointers,
462 "Cray pointer syntax"},
463 {"cycle-exit", &f77_cycle_exit,
464 "CYCLE or EXIT statement"},
465 {"d-comment", &f77_d_comment,
466 "Debug comments starting with D"},
467 {"dec-tab" , &f77_dec_tabs,
468 "DEC Fortran tab-formatted source"},
469 {"do-enddo", &f77_do_enddo,
470 "DO loop extensions"},
471 {"double-complex", &f77_double_complex,
472 "Double complex datatype"},
473 {"format-dollarsign", &f77_format_dollarsigns,
474 "$ control code in FORMAT"},
475 {"format-edit-descr", &f77_format_extensions,
476 "Nonstandard edit descriptors"},
477 {"function-noparen", &f77_function_noparen,
478 "FUNCTION defined without parens"},
479 {"implicit-none", &f77_implicit_none,
480 "IMPLICIT NONE statement"},
481 {"include", &f77_include,
482 "INCLUDE statement"},
483 {"initializer", &f77_initializers,
484 "Variable initializer in declaration"},
485 {"inline-comment", &f77_inline_comment,
486 "Inline comments starting with !"},
487 {"internal-list-io", &f77_internal_list_io,
488 "List-directed I/O to internal file"},
489 {"intrinsic", &f77_intrinsics,
490 "Nonstandard intrinsic functions"},
491 {"io-keywords", &f77_io_keywords,
492 "Nonstandard I/O keywords"},
493 {"long-line", &f77_overlength,
494 "Statements with code past 72 columns"},
495 {"long-name", &f77_long_names,
496 "Identifiers over 6 chars"},
497 {"mixed-common", &f77_mixed_common,
498 "Mixed char and nonchar data in common"},
499 {"mixed-expr", &f77_mixed_expr,
500 "Incompatible type combinations in exprs"},
501 {"name-dollarsign", &f77_dollarsigns,
502 "$ or other nonalnum (except _) in identifiers"},
503 {"name-underscore", &f77_underscores,
504 "Underscores in identifiers"},
505 {"namelist", &f77_namelist,
506 "NAMELIST statement"},
507 {"param-implicit-type",&f77_param_implicit_type,
508 "implicit typing of PARAMETERs"},
509 {"param-intrinsic", &f77_param_intrinsic,
510 "Intrinsics and **real in PARAMETER defns"},
511 {"param-noparen", &f77_param_noparen,
512 "PARAMETER statement without parens"},
513 {"pointer", &f77_pointers,
514 "Fortran 90 pointer syntax"},
515 {"quad-constant", &f77_quad_constants,
516 "Quad precision constants like 1.23Q4"},
517 {"quotemark", &f77_quotemarks,
518 "Strings delimited by \"quote marks\""},
519 {"relops", &f77_relops,
520 "Relational operators < <= == /= > >="},
521 {"semicolon", &f77_semicolon,
522 "Semicolon as statement separator"},
523 {"statement-order", &f77_stmt_order,
524 "Statement out of order"},
525 {"typeless-constant", &f77_typeless_constants,
526 "Typeless constants like Z'19AF'"},
527 {"type-size", &f77_typesize,
528 "Sized type declarations like REAL*8"},
529 {"variable-format", &f77_variable_format,
530 "Variable format repeat spec or field size"},
531 {"vms-io", &f77_io_keywords, /* same as "io-keywords" */
532 "Nonstandard I/O keywords"},
533 {(char *)NULL, (int *)NULL, (char *)NULL},
534 };
535
536
537 PRIVATE char *f90_warn_list=(char *)NULL; /* Non F90 extensions to warn about */
538
539 PRIVATE WarnOptionList
540 f90_warn_option[]={
541 {
542 #if F90_ALL
543 "all" /* used by -help */
544 #else
545 "none"
546 #endif
547 , (int *)NULL, "Fortran 90 Violation Warning"},/* Title for list */
548 {"accept-type", &f90_accept_type,
549 "ACCEPT and TYPE I/O statements"},
550 {"backslash", &f90_unix_backslash,
551 "Unix backslash escape in strings"},
552 {"byte", &f90_byte,
553 "BYTE data type"},
554 {"continuation", &f90_continue,
555 "Too many or empty continuation lines"},
556 {"cpp", &f90_unix_cpp,
557 "Unix C preprocessor directives"},
558 {"cray-pointer", &f90_cray_pointers,
559 "Cray pointer syntax"},
560 {"d-comment", &f90_d_comment,
561 "Debug comments starting with D"},
562 {"dec-tab" , &f90_dec_tabs,
563 "DEC Fortran tab-formatted source"},
564 {"double-complex", &f90_double_complex,
565 "Double complex datatype"},
566 {"format-dollarsign", &f90_format_dollarsigns,
567 "$ control code in FORMAT"},
568 {"format-edit-descr", &f90_format_extensions,
569 "Nonstandard edit descriptors"},
570 /* Note: f90_freeform_space == misc_warn, not controlled here */
571 {"function-noparen", &f90_function_noparen,
572 "FUNCTION defined without parens"},
573 {"initializer", &f90_initializers,
574 "Variable initializer using / / in declaration"},
575 {"intrinsic", &f90_intrinsics,
576 "Nonstandard intrinsic functions"},
577 {"io-keywords", &f90_io_keywords,
578 "Nonstandard I/O keywords"},
579 {"long-line", &f90_overlength,
580 "Statements with code past max columns"},
581 {"mixed-expr", &f90_mixed_expr,
582 "Incompatible type combinations in exprs"},
583 {"name-dollarsign", &f90_dollarsigns,
584 "$ in identifiers"},
585 {"param-implicit-type",&f90_param_implicit_type,
586 "implicit typing of PARAMETERs"},
587 {"param-noparen", &f90_param_noparen,
588 "PARAMETER statement without parens"},
589 {"quad-constant", &f90_quad_constants,
590 "Quad precision constants like 1.23Q4"},
591 {"statement-order", &f90_stmt_order,
592 "Statement out of order"},
593 {"type-size", &f90_typesize,
594 "Sized type declarations like REAL*8"},
595 {"typeless-constant", &f90_typeless_constants,
596 "Nonstandard constants like X'19AF'"},
597 {"variable-format", &f90_variable_format,
598 "Variable format repeat spec or field size"},
599 {"vms-io", &f90_io_keywords, /* same as "io-keywords" */
600 "Nonstandard I/O keywords"},
601 {(char *)NULL, (int *)NULL, (char *)NULL},
602 };
603
604
605 PRIVATE char *f95_warn_list=(char *)NULL; /* Non F95 old syntax to warn about */
606
607 PRIVATE WarnOptionList
608 f95_warn_option[]={
609 {
610 #if F95_ALL
611 "all" /* used by -help */
612 #else
613 "none"
614 #endif
615 , (int *)NULL, "Fortran 95 Violation Warning"},/* Title for list */
616 {"real-do", &f95_real_do,
617 "real DO variable"},
618 {"pause", &f95_pause,
619 "PAUSE stmt"},
620 {"assign", &f95_assign,
621 "ASSIGN stmt, assigned GOTO, assigned format"},
622 {"h-edit", &f95_Hedit,
623 "H edit descriptor"},
624 {(char *)NULL, (int *)NULL, (char *)NULL},
625 };
626
627 #ifndef STANDARD_INTRINSICS
628 PRIVATE char *intrinsic_option_list=(char *)NULL; /* intrinsic fcn options */
629
630 PRIVATE WarnOptionList
631 intrinsic_option[]={
632 {
633 /* Define -help message. This is not done right... */
634 #if (DEF_INTRINSIC_SET & 2)
635 "unix"
636 #else
637 #if (DEF_INTRINSIC_SET & 4)
638 "vms"
639 #else
640 #if (DEF_INTRINSIC_SET & 1)
641 "common"
642 #else
643 "none"
644 #endif
645 #endif
646 #endif
647
648 , (int *)NULL, "Intrinsic Function"}, /* Title for list */
649 {"extra", &intrinsic_set_extra,
650 "recognize commonly supported nonstandard intrinsics"},
651 {"iargc-no-argument", &intrinsic_iargc_no_argument,
652 "iargc takes no arguments"},
653 {"iargc-one-argument",&intrinsic_iargc_one_argument,
654 "iargc takes one argument"},
655 {"rand-no-argument", &intrinsic_rand_no_argument,
656 "rand takes no arguments"},
657 {"rand-one-argument", &intrinsic_rand_one_argument,
658 "rand takes one argument"},
659 {"unix", &intrinsic_set_unix,
660 "recognize some unix intrinsics"},
661 {"vms", &intrinsic_set_vms,
662 "recognize some vms intrinsics"},
663 {(char *)NULL, (int *)NULL, (char *)NULL},
664 };
665 #endif /* not STANDARD_INTRINSICS */
666
667
668
669 /* makedcls is not really a warning list,
670 but it uses the same style of control. */
671
672 PRIVATE char *makedcl_warn_list=(char *)NULL; /* Make-declarations options */
673
674 PRIVATE WarnOptionList
675 makedcl_warn_option[]={
676 {"none" /* used by -help */
677 , (int *)NULL, "Make Type-Declarations"}, /* Title for list */
678
679 {"asterisk-comment", &dcl_asterisk_comment_character,
680 "use asterisk as comment character"},
681 {"comment-char-lowercase",&dcl_lowercase_comment_character,
682 "use lowercase c as comment character"},
683 {"compact", &dcl_compact,
684 "compact output format"},
685 {"declarations", &dcl_declarations,
686 "produce file of declarations"},
687 {"exclude-sftran3", &dcl_excl_sftran3_internal_vars,
688 "omit SFTRAN3 internal variables"},
689 {"free-form", &dcl_free_form,
690 "produce declarations in free form"},
691 {"keywords-lowercase",&dcl_keywords_lowercase,
692 "output keywords in lowercase"},
693 {"suppress-array-dimensions",&dcl_no_array_dimensions,
694 "do not declare array dimensions"},
695 {"undeclared-only", &dcl_only_undeclared,
696 "declare only undeclared things"},
697 {"use-continuation-lines",&dcl_use_continuations,
698 " use continuation lines"},
699 {"vars-and-consts-lowercase",&dcl_vars_and_consts_lowercase,
700 "output variables and constants in lowercase"},
701 {(char *)NULL, (int *)NULL, (char *)NULL},
702 };
703
704
705
706 /* makehtmls is not really a warning list,
707 but it uses the same style of control. */
708
709 PRIVATE char *mkhtml_warn_list=(char *)NULL; /* Make-declarations options */
710
711 PRIVATE WarnOptionList
712 mkhtml_warn_option[]={
713 {"none" /* used by -help */
714 , (int *)NULL, "Make HTML Documents"}, /* Title for list */
715
716 {"compact", &html_compact,
717 "compact output format"},
718 {"documents", &html_documents,
719 "produce html documents"},
720 {"exclude-sftran3", &html_excl_sftran3_internal_vars,
721 "omit SFTRAN3 internal variables"},
722 {"free-form", &html_free_form,
723 "produce declarations in free form"},
724 {"keywords-lowercase",&html_keywords_lowercase,
725 "output keywords in lowercase"},
726 {"suppress-array-dimensions",&html_no_array_dimensions,
727 "do not declare array dimensions"},
728 #if 0
729 {"undeclared-only", &html_only_undeclared,
730 "declare only undeclared things"},
731 #endif
732 {"use-continuation-lines",&html_use_continuations,
733 " use continuation lines"},
734 {"vars-and-consts-lowercase",&html_vars_and_consts_lowercase,
735 "output variables and constants in lowercase"},
736 {(char *)NULL, (int *)NULL, (char *)NULL},
737 };
738
739
740 PRIVATE char *port_warn_list=(char *)NULL; /* Nonportable things to warn about */
741
742 PRIVATE WarnOptionList
743 port_warn_option[]={
744 {
745 #if PORT_ALL
746 "all" /* used by -help */
747 #else
748 "none"
749 #endif
750 , (int *)NULL, "Portability Warning"}, /* Title for list */
751 {"backslash", &port_backslash,
752 "Backslash in standard-conforming strings"},
753 {"common-alignment", &port_common_alignment,
754 "COMMON not in descending size order"},
755 {"hollerith", &port_hollerith,
756 "Hollerith constants (except in FORMAT)"},
757 {"long-string", &port_long_string,
758 "Strings over 255 chars long"},
759 {"mixed-equivalence", &port_mixed_equiv,
760 "Different data types equivalenced"},
761 {"mixed-size", &port_mixed_size,
762 "Default and explicit size types mixed"},
763 {"real-do", &port_real_do,
764 "Non-integer DO loops"},
765 {"param-implicit-type",&port_param_implicit_type,
766 "Implicit type of PARAMETER differs from default type"},
767 {"tab", &port_tabs,
768 "Tabs in source code"},
769 {(char *)NULL, (int *)NULL, (char *)NULL},
770 };
771
772
773 PRIVATE char *pretty_warn_list=(char *)NULL; /* Misleading things to warn about */
774
775 PRIVATE WarnOptionList
776 pretty_warn_option[]={
777 {
778 #if PRETTY_ALL
779 "all" /* used by -help */
780 #else
781 "none"
782 #endif
783 , (int *)NULL, "Appearance Warning"}, /* Title for list */
784 {"alternate-return", &pretty_alt_return,
785 "Alternate return out of range"},
786 {"embedded-space", &pretty_extra_space,
787 "Space in variable names or operators"},
788 {"continuation", &pretty_contin,
789 "Continuation mark following comment line"},
790 {"long-line", &pretty_overlength,
791 "Lines over 72 columns"},
792 {"missing-space", &pretty_no_space,
793 "Missing space between variable & keyword"},
794 {"multiple-common", &pretty_multiple_common,
795 "COMMON declared in multiple stmts"},
796 {"multiple-namelist", &pretty_multiple_namelist,
797 "NAMELIST declared in multiple stmts"},
798 {"parentheses", &pretty_parens,
799 "Parentheses around a variable"},
800 {(char *)NULL, (int *)NULL, (char *)NULL},
801
802 };
803
804 /* Project file is not really a warning list,
805 but it uses the same style of control. */
806
807 PRIVATE char *project_warn_list=(char *)NULL; /* Project file options */
808
809 PRIVATE WarnOptionList
810 project_warn_option[]={
811 {"none" , (int *)NULL, "Project File"}, /* Title for list */
812
813 {"create", &make_project_file,
814 "Create project file"},
815 {"trim-calls", &proj_trim_calls,
816 "Keep minimum information about subprogram calls"},
817 {"trim-common", &proj_trim_common,
818 "Keep minimum information about common blocks"},
819 {(char *)NULL, (int *)NULL, (char *)NULL},
820
821 };
822
823 /* Source format is not really a warning list,
824 but it uses the same style of control. */
825
826 PRIVATE char *source_form_list=(char *)NULL; /* Source format options */
827
828 PRIVATE WarnOptionList
829 source_form_option[]={
830 {
831 #if VMS_INCLUDE
832 "vms-include" /* For -help. This ignores the unlikely possibility
833 that other options may also be turned on by default. */
834 #else
835 "none"
836 #endif
837 , (int *)NULL, "Source Format"}, /* Title for list */
838 {"dec-param-standard-type",&source_dec_param_std_type,
839 "DEC Fortran PARAMETERs typed as if standard"},
840 {"dec-tab", &source_dec_tab,
841 "DEC Fortran tab-format"},
842 {"fixed", &source_fixed_form,
843 "force fixed source form"},
844 {"free", &source_free_form,
845 "force free source form"},
846 {"param-implicit-type",&source_param_implicit,
847 "implicit typing of PARAMETERs by value"},
848 {"unix-backslash", &source_unix_backslash,
849 "UNIX-style backslash escape char"},
850 {"vms-include", &source_vms_include,
851 "VMS-style INCLUDE statement"},
852 {(char *)NULL, (int *)NULL, (char *)NULL},
853
854 };
855
856
857 PRIVATE char *stylecheck_warn_list=(char *)NULL; /* block structure style warnings */
858
859 PRIVATE WarnOptionList
860 stylecheck_warn_option[]={
861 {
862 #if STYLECHECK_ALL
863 "all" /* used by -help */
864 #else
865 "none"
866 #endif
867 , (int *)NULL,"Picky Warnings About Block Structures"},/* Title for list */
868 {"block-if", &style_req_block_if,
869 "require block IF or logical IF"},
870 {"construct-name", &style_req_construct_name,
871 "require named block constructs"},
872 {"distinct-do", &style_shared_do_terminator,
873 "DO loops not to share terminator"},
874 {"do-construct", &style_req_do_construct,
875 "require ENDDO or CONTINUE as terminator of DO"},
876 {"do-enddo", &style_req_enddo,
877 "require ENDDO as terminator of DO"},
878 {"end-name", &style_req_end_name,
879 "require subprogram name on structured END statements"},
880 {"format-stmt", &style_labeled_format,
881 "object to FORMAT statements"},
882 {"goto", &style_goto,
883 "object to GOTO statements"},
884 {"labeled-stmt", &style_labeled_exec,
885 "object to labeled statements except FORMAT"},
886 {"program-stmt", &style_req_prog_stmt,
887 "require PROGRAM statement at head of program"},
888 {"structured-end", &style_req_structured_end,
889 "require END PROGRAM et al, not plain END"},
890 {(char *)NULL, (int *)NULL, (char *)NULL},
891 };
892
893
894 PRIVATE char *trunc_warn_list=(char *)NULL; /* Truncation pitfalls to warn about */
895
896 PRIVATE WarnOptionList
897 trunc_warn_option[]={
898 {
899 #if TRUNC_ALL
900 "all" /* used by -help */
901 #else
902 "none"
903 #endif
904 , (int *)NULL, "Truncation Warning"}, /* Title for list */
905 {"int-div-exponent", &trunc_int_div_exponent,
906 "int/int used as exponent"},
907 {"int-div-real", &trunc_int_div_real,
908 "int/int converted to real"},
909 {"int-div-zero", &trunc_int_div_zero,
910 "int/int = constant 0 "},
911 {"int-neg-power", &trunc_int_neg_power,
912 "int**(-int), usually equals 0"},
913 {"promotion", &trunc_promotion,
914 "lower precision promoted to higher"},
915 {"real-do-index", &trunc_real_do_index,
916 "real DO index with int bounds"},
917 {"real-subscript", &trunc_real_subscript,
918 "real array subscript"},
919 {"significant-figures",&trunc_sigfigs,
920 "single precision const overspecified"},
921 {"size-demotion", &trunc_size_demotion,
922 "higher precision truncated to lower, same type"},
923 {"type-demotion", &trunc_type_demotion,
924 "higher precision truncated to lower, different type"},
925 {(char *)NULL, (int *)NULL, (char *)NULL},
926
927 };
928
929
930 PRIVATE char *usage_warn_list=(char *)NULL; /* Variable usages to warn about */
931
932 PRIVATE WarnOptionList
933 usage_warn_option[]={
934 {
935 #if USAGE_ALL
936 "all" /* used by -help */
937 #else
938 "none"
939 #endif
940 , (int *)NULL, "Usage Warning"}, /* Title for list */
941 {"arg-alias", &usage_arg_alias_modified,
942 "scalar argument same as another is modified"},
943 {"arg-array-alias", &usage_array_alias_modified,
944 "argument in same array as another is modified"},
945 {"arg-common-alias", &usage_arg_common_modified,
946 "scalar argument same as common variable, either is modified"},
947 {"arg-common-array-alias", &usage_array_common_modified,
948 "array argument same as common variable, either is modified"},
949 {"arg-const-modified", &usage_arg_modified,
950 "constant or expression argument is modified"},
951 {"arg-unused", &usage_arg_unused,
952 "dummy argument declared but not used"},
953 {"com-block-unused", &usage_com_block_unused,
954 "whole common block declared but not used"},
955 {"com-block-volatile", &usage_com_block_volatile,
956 "common block may lose definition if volatile"},
957 {"com-var-set-unused", &usage_com_var_set_unused,
958 "common variable set but not used"},
959 {"com-var-uninitialized", &usage_com_var_uninitialized,
960 "common variable used but not set"},
961 {"com-var-unused", &usage_com_var_unused,
962 "common variable declared but not used"},
963 {"do-index-modified", &usage_do_var_modified,
964 "active DO index variable modified"},
965 {"ext-multiply-defined", &usage_ext_multiply_defined,
966 "external multiply defined"},
967 {"ext-declared-only", &usage_ext_declared_only,
968 "name declared EXTERNAL but not defined or used"},
969 {"ext-undefined", &usage_ext_undefined, /* Also touched by -extern */
970 "external declared or used but not defined (= -external)"},
971 {"ext-unused", &usage_ext_unused,
972 "external defined but not used"},
973 {"label-undefined", &usage_label_undefined,
974 "label used but undefined"},
975 {"label-unused", &usage_label_unused,
976 "label defined but unused"},
977 {"var-set-unused", &usage_var_set_unused,
978 "local variable set but not used"},
979 {"var-uninitialized", &usage_var_uninitialized,
980 "local variable used before set"},
981 {"var-unused", &usage_var_unused,
982 "local variable declared but not used"},
983 {(char *)NULL, (int *)NULL, (char *)NULL},
984 };
985
986 /* List of strsettings is defined here. Each entry
987 gives the name of the corresponding string
988 variable, value to set if "=str" omitted, and brief
989 explanation. See set_option() for processing. */
990
991 /*** (struct was declared above: repeated in comment here for reference)
992 StrsettingList {
993 char *name;
994 char **strvalue;
995 char *turnon, *turnoff;
996 isacheck_t isacheck;
997 WarnOptionList *option_list;
998 PROTO(void (*numeric_form_handler),(int num, char *setting_name));
999 char *explanation;
1000 };***/
1001
1002 PRIVATE StrsettingList strsetting[]={
1003 {"arguments", &argcheck_warn_list, "all", "none", IS_A_CHECK,
1004 argcheck_warn_option, argcheck_numeric_option,
1005 "check subprogram argument agreement"},
1006 {"array", &arraycheck_warn_list, "all", "none", IS_A_CHECK,
1007 arraycheck_warn_option, arraycheck_numeric_option,
1008 "check subprogram argument arrayness agreement"},
1009 {"calltree", &calltree_opt_list, "tree", "none", NOT_A_CHECK,
1010 calltree_option, calltree_numeric_option,
1011 "subprogram call graph options"},
1012 {"common", &comcheck_warn_list, "all", "none", IS_A_CHECK,
1013 comcheck_warn_option, comcheck_numeric_option,
1014 "check for common block mismatches"},
1015 {"crossref", &crossref_opt_list, "all", "none", NOT_A_CHECK,
1016 crossref_option, NULL,
1017 "cross-ref printing options"},
1018 {"f77", &f77_warn_list, "all", "none", IS_A_CHECK,
1019 f77_warn_option, NULL,
1020 "warn about non-F77 extensions"},
1021 {"f90", &f90_warn_list, "all", "none", IS_A_CHECK,
1022 f90_warn_option, NULL,
1023 "warn about non-F90 syntax"},
1024 {"f95", &f95_warn_list, "all", "none", IS_A_CHECK,
1025 f95_warn_option, NULL,
1026 "warn about non-F95 syntax"},
1027 {"identifier-chars", &idletter_list, DEF_IDLETTER_LIST, "", NOT_A_CHECK,
1028 (WarnOptionList *)NULL, NULL,
1029 "non-alphabetic chars allowed in identifiers"},
1030 #ifdef ALLOW_INCLUDE
1031 {"include", &include_path, (char *)NULL, (char *)NULL, NOT_A_CHECK,
1032 (WarnOptionList *)NULL, NULL,
1033 "include-file directory"},
1034 #endif
1035 #ifndef STANDARD_INTRINSICS
1036 {"intrinsic", &intrinsic_option_list, "all", "none", NOT_A_CHECK,
1037 intrinsic_option, intrinsic_numeric_option,
1038 "specify intrinsic function options"},
1039 #endif
1040 /* makedcls: turnon="declarations" instead of "all" */
1041 {"makedcls", &makedcl_warn_list, "declarations", "none", NOT_A_CHECK,
1042 makedcl_warn_option, makedcl_numeric_option,
1043 "make type declaration statements"},
1044 /* mkhtml similar to makedcls */
1045 {"mkhtml", &mkhtml_warn_list, "documents","none",NOT_A_CHECK,
1046 mkhtml_warn_option, mkhtml_numeric_option,
1047 "create html documents"},
1048 {"output", &out_fname, (char *)NULL, (char *)NULL, NOT_A_CHECK,
1049 (WarnOptionList *)NULL, NULL,
1050 "output file name"},
1051 {"portability",&port_warn_list,"all", "none", IS_A_CHECK,
1052 port_warn_option, NULL,
1053 "warn about portability problems"},
1054 {"pretty", &pretty_warn_list,"all", "none", IS_A_CHECK,
1055 pretty_warn_option, NULL,
1056 "warn about deceiving appearances"},
1057 {"project", &project_warn_list,"all", "none", NOT_A_CHECK,
1058 project_warn_option, NULL,
1059 "create project file"},
1060 {"source", &source_form_list,"all", "none", NOT_A_CHECK,
1061 source_form_option, source_numeric_option,
1062 "select source format options"},
1063 {"style", &stylecheck_warn_list, "all", "none", IS_A_CHECK,
1064 stylecheck_warn_option, NULL,
1065 "catch violations of structured style"},
1066 {"truncation",&trunc_warn_list,"all", "none", IS_A_CHECK,
1067 trunc_warn_option, NULL,
1068 "check for truncation pitfalls"},
1069 {"usage", &usage_warn_list,"all", "none", IS_A_CHECK,
1070 usage_warn_option, usage_numeric_option,
1071 "warn about variable and common block usage problems"},
1072 };
1073
1074 /* get_env_options picks up any options defined in the
1075 environment. A switch or setting is defined according to
1076 the value of an environment variable whose name is the switch
1077 or setting name (uppercased), prefixed by the string
1078 ENV_PREFIX (e.g. FTNCHEK_). For settings and strsettings,
1079 the value of the environment variable gives the value to be
1080 used. For switches, the environment variable is set to "0" or
1081 "NO" to turn the switch off, or to any other value (including
1082 null) to turn it on.
1083 */
1084
1085 void
get_env_options(VOID)1086 get_env_options(VOID)
1087 {
1088 /* Size of env_option_name must be at least 1 +
1089 strlen(ENV_PREFIX) + max over i of strlen of
1090 switchopt[i].name, setting[i].name,
1091 strsetting[i].name.
1092 */
1093 #define ENV_OPTION_NAME_LEN 32
1094 char env_option_name[ENV_OPTION_NAME_LEN];
1095 char *value;
1096 unsigned i, checklen;
1097
1098 /* The following code checks size of
1099 ENV_OPTION_NAME_LEN, which may become too small
1100 as option names are added. This could be
1101 commented out in released code, but it's a
1102 minor overhead for insurance.
1103 */
1104 checklen = 0;
1105 for(i=0; i<NUM_SWITCHES; i++) {
1106 checklen = MAX(checklen,strlen(switchopt[i].name));
1107 }
1108 for(i=0; i<NUM_SETTINGS; i++) {
1109 checklen = MAX(checklen,strlen(setting[i].name));
1110 }
1111 for(i=0; i<NUM_STRSETTINGS; i++) {
1112 checklen = MAX(checklen,strlen(strsetting[i].name));
1113 }
1114 checklen += sizeof(ENV_PREFIX)+1;
1115 if(ENV_OPTION_NAME_LEN < checklen) {
1116 fprintf(stderr,"\nOops -- ENV_OPTION_NAME_LEN=%d too small: make it %d\n",
1117 ENV_OPTION_NAME_LEN, checklen);
1118 exit(1);
1119 }
1120
1121
1122 /* OK, now we get down to it. */
1123
1124 for(i=0; i<NUM_SWITCHES; i++) {
1125 /* Construct the env variable name for switch i */
1126 make_env_name( env_option_name, switchopt[i].name);
1127
1128 /* See if it is defined */
1129 if( (value = getenv(env_option_name)) != (char *)NULL) {
1130 *(switchopt[i].switchflag) =
1131 !(strcmp(value,"0")==0 || strcmp(value,"NO")==0 );
1132 }
1133
1134 }
1135
1136 for(i=0; i<NUM_SETTINGS; i++) {
1137 /* Construct the env variable name for setting i */
1138 make_env_name( env_option_name, setting[i].name);
1139 /* See if it is defined */
1140 if( (value = getenv(env_option_name)) != (char *)NULL) {
1141 if(read_setting(value, setting[i].setvalue, setting[i].name,
1142 setting[i].minlimit, setting[i].maxlimit,
1143 setting[i].turnon,
1144 setting[i].turnoff,
1145 setting[i].min_default_value,
1146 setting[i].max_default_value) != 0) {
1147 (void)fflush(list_fd);
1148 (void)fprintf(stderr,"Env setting garbled: %s=%s: ignored\n",
1149 env_option_name,value);
1150 }
1151 }
1152 }
1153
1154
1155 for(i=0; i<NUM_STRSETTINGS; i++) {
1156 /* Construct the env variable name for setting i */
1157 make_env_name( env_option_name, strsetting[i].name);
1158 /* See if it is defined */
1159 if( (value = getenv(env_option_name)) != (char *)NULL) {
1160
1161 /* setenv nothing or "1" or "YES" --> turnon*/
1162 if(value[0] == '\0'
1163 || strncasecmp(value,"1",strlen(value)) == 0
1164 || strncasecmp(value,"yes",strlen(value)) == 0
1165 ) {
1166 *(strsetting[i].strvalue) = strsetting[i].turnon;
1167 }
1168 else if(strncasecmp(value,"no",strlen(value)) == 0) {
1169 *(strsetting[i].strvalue) = strsetting[i].turnoff;
1170 }
1171 else { /* Otherwise use the given value */
1172 *(strsetting[i].strvalue) = value;
1173 }
1174
1175 if( *(strsetting[i].strvalue) == (char *)NULL ) {
1176 (void)fflush(list_fd);
1177 (void)fprintf(stderr,
1178 "Environment variable %s needs string value: ignored\n",
1179 env_option_name);
1180 }
1181 else {
1182 update_str_options(&strsetting[i]);
1183 }
1184 }
1185 }
1186 }
1187
1188 /* Routine to concatenate ENV_PREFIX onto option name
1189 and uppercase the result.
1190 */
1191 PRIVATE void
1192 #if HAVE_STDC
make_env_name(char * env_name,char * option_name)1193 make_env_name(char *env_name, char *option_name)
1194 #else /* K&R style */
1195 make_env_name( env_name, option_name)
1196 char *env_name, *option_name;
1197 #endif /* HAVE_STDC */
1198 {
1199 int i,c;
1200
1201 (void)strcat(strcpy(env_name,ENV_PREFIX),option_name);
1202 for(i=sizeof(ENV_PREFIX)-1; (c=env_name[i]) != '\0'; i++) {
1203 if( islower(c) )
1204 env_name[i] = toupper(c);
1205 }
1206 }
1207
1208 /* get_rc_options picks up options from an "rc" file.
1209 */
1210 void
get_rc_options(VOID)1211 get_rc_options(VOID)
1212 {
1213 FILE *rc_fp;
1214 char rc_option_string[MAX_RC_LINE];
1215 int i;
1216
1217 rc_option_string[0] = '-';
1218
1219 if( (rc_fp = find_rc()) != (FILE *)NULL ) {
1220 for(;;) {
1221 if( fgets(rc_option_string+1,sizeof(rc_option_string)-1,rc_fp)
1222 == (char *)NULL)
1223 break;
1224 /* Terminate line at start of comment.
1225 This also changes final \n to \0. */
1226 for(i=1; rc_option_string[i] != '\0'; i++) {
1227 if(rc_option_string[i] == RC_COMMENT_CHAR ||
1228 isspace(rc_option_string[i])) {
1229 rc_option_string[i] = '\0';
1230 break;
1231 }
1232 }
1233 if(i==1) /* Skip blank line */
1234 continue;
1235
1236 set_option(rc_option_string,"startup file");
1237 }
1238 }
1239 }
1240
1241 /* find_rc locates the "rc" file. */
1242 PRIVATE FILE *
find_rc(VOID)1243 find_rc(VOID)
1244 {
1245 FILE *fp;
1246 char *fname;
1247 char *homedir=getenv("HOME");
1248
1249 /* Allocate enough space to hold rc file name.
1250 Now you see why so many apps have buffer-overrun
1251 bugs. */
1252 if( (fname = (char *)malloc(MAX(sizeof(UNIX_RC_FILE),sizeof(NONUNIX_RC_FILE)) +
1253 (homedir!=NULL?strlen(homedir):
1254 #ifdef SPECIAL_HOMEDIR
1255 strlen(SPECIAL_HOMEDIR)
1256 #else
1257 0
1258 #endif
1259 )
1260 #ifdef UNIX
1261 +1 /* for the "/" */
1262 #endif
1263 )) == (char *)NULL ) {
1264 (void)fflush(list_fd);
1265 (void)fprintf(stderr,"\nCannot allocate memory for init file path");
1266 return (FILE *)NULL;
1267 }
1268
1269 /* Look first for file in local directory */
1270 (void)strcpy(fname,UNIX_RC_FILE);
1271 if( (fp=fopen(fname,"r")) == (FILE *)NULL) {
1272
1273 /* Look for alternate name in local directory */
1274 (void)strcpy(fname,NONUNIX_RC_FILE);
1275 if( (fp=fopen(fname,"r")) == (FILE *)NULL) {
1276
1277
1278 /* Allow local option of special home directory
1279 for non-unix (usually VMS) systems. */
1280 #ifdef SPECIAL_HOMEDIR
1281 if(homedir == (char *)NULL) {
1282 homedir = SPECIAL_HOMEDIR;
1283 }
1284 #endif
1285 /* If not found, look in home directory */
1286 if(homedir != (char *)NULL) {
1287 (void)strcpy(fname,homedir);
1288 #ifdef UNIX
1289 (void)strcat(fname,"/");
1290 #endif
1291 (void)strcat(fname,UNIX_RC_FILE);
1292
1293 if( (fp=fopen(fname,"r")) == (FILE *)NULL) {
1294
1295
1296 /* If look for alternate name in home directory */
1297 (void)strcpy(fname,homedir);
1298 #ifdef UNIX
1299 (void)strcat(fname,"/");
1300 #endif
1301 (void)strcat(fname,NONUNIX_RC_FILE);
1302 if( (fp=fopen(fname,"r")) == (FILE *)NULL) {
1303 /* no more alternatives */
1304 }
1305 }
1306 }/* end if homedir != NULL */
1307 }
1308 }
1309
1310 free(fname);
1311 return fp;
1312 }
1313
1314
1315 /* set_option processes an option from command line. Argument
1316 s is the option string. First look if s starts with "no" or
1317 "no-", and if so, check if the rest matches a boolean switch name
1318 from list in switchopt[]. If it matches, corresponding
1319 flag is set to FALSE. If no match, then s is compared to
1320 the same switch names without the "no", and if match is
1321 found, corresponding flag is set to TRUE. Finally, special
1322 flags are handled. If still no match, an error message is
1323 generated. */
1324
1325 void
1326 #if HAVE_STDC
set_option(char * s,const char * where)1327 set_option(char *s, const char *where)
1328 /* Option to interpret, including initial - */
1329 /* String to identify cmd line vs rc file */
1330 #else /* K&R style */
1331 set_option(s,where)
1332 char *s, /* Option to interpret, including initial - */
1333 *where; /* String to identify cmd line vs rc file */
1334 #endif /* HAVE_STDC */
1335 {
1336 unsigned i;
1337 int offset, orig_offset;
1338 int prefix_no=FALSE;
1339
1340 /* look for noswitch flags first since otherwise
1341 an option starting with no might take precedence.
1342 */
1343 offset=1; /* offset is no. of chars from s[0] to switch name */
1344
1345 /* Allow either "-" or "--" prefix */
1346 if(
1347 #ifdef OPTION_PREFIX_SLASH
1348 s[0] == '-' && /* if / allowed, make sure this is -- not /- */
1349 #endif
1350 s[1] == '-' ) {
1351 ++offset;
1352 }
1353 orig_offset = offset;
1354 if( strncmp(s+offset,"no",2) == 0 ) {
1355 prefix_no = TRUE;
1356 offset += 2;
1357 if( s[offset] == '-' ) /* Allow "no" or "no-" */
1358 offset += 1;
1359 }
1360
1361 if( prefix_no ) { /* "no" found */
1362 for(i=0; i<NUM_SWITCHES; i++) {
1363 if( strncmp(s+offset,switchopt[i].name,OPT_MATCH_LEN) == 0) {
1364 *(switchopt[i].switchflag) = FALSE;
1365 return;
1366 }
1367 }
1368
1369 /* -noswitch not found: look for -nosetting flag */
1370 for(i=0; i<NUM_SETTINGS; i++) {
1371 if( strncmp(s+offset,setting[i].name,OPT_MATCH_LEN) == 0) {
1372 *(setting[i].setvalue) = setting[i].turnoff;
1373 return;
1374 }
1375 }
1376 }
1377
1378 /* Next look for switches without "no" */
1379 for(i=0; i<NUM_SWITCHES; i++) {
1380 if( strncmp(s+orig_offset,switchopt[i].name,OPT_MATCH_LEN) == 0) {
1381 *(switchopt[i].switchflag) = TRUE;
1382 return;
1383 }
1384 }
1385
1386 /* Handle settings of form "-opt=number" */
1387 for(i=0; i<NUM_SETTINGS; i++) {
1388 if( strncmp(s+orig_offset,setting[i].name,OPT_MATCH_LEN) == 0) {
1389 char *numstr;
1390
1391
1392 for( numstr = s + offset + OPT_MATCH_LEN;
1393 ! END_OF_OPT(*numstr); numstr++ )
1394 {
1395 if((*numstr == '=') || (*numstr == ':'))
1396 { /* Find the assignment operator */
1397 numstr++;
1398 break;
1399 }
1400 }
1401 if(read_setting(numstr, setting[i].setvalue, setting[i].name,
1402 setting[i].minlimit, setting[i].maxlimit,
1403 setting[i].turnoff,
1404 setting[i].turnon,
1405 setting[i].min_default_value,
1406 setting[i].max_default_value) != 0) {
1407 (void)fflush(list_fd);
1408 (void)fprintf(stderr,"Setting garbled: %s: ignored\n",s);
1409 }
1410 return;
1411 }
1412 }
1413
1414
1415 /* Handle settings of form "-opt=string" */
1416 for(i=0; i<NUM_STRSETTINGS; i++) {
1417 int is_a_turnoff;
1418 char *strstart;
1419
1420 /* First look for setting prefixed by "no"
1421 if it allows turnon/turnoff. */
1422 if( strsetting[i].turnoff != (char *)NULL &&
1423 prefix_no &&
1424 strncmp(s+offset,strsetting[i].name,OPT_MATCH_LEN) == 0) {
1425 is_a_turnoff = TRUE;
1426 strstart = s + offset + OPT_MATCH_LEN;
1427 }
1428 else if( strncmp(s+orig_offset,strsetting[i].name,OPT_MATCH_LEN) == 0) {
1429 is_a_turnoff = FALSE;
1430 strstart = s + orig_offset + OPT_MATCH_LEN;
1431 }
1432 else {
1433 continue; /* Doesn't match -nooption or -option: skip */
1434 }
1435 {
1436 int numchars;
1437
1438 while( *strstart != '=' && *strstart != ':'
1439 && ! END_OF_OPT(*strstart) )
1440 strstart++; /* Find the = sign */
1441 if( END_OF_OPT(*strstart) ) {
1442 /* no = sign: use turnon/turnoff */
1443 if(is_a_turnoff)
1444 *(strsetting[i].strvalue) = strsetting[i].turnoff;
1445 else
1446 *(strsetting[i].strvalue) = strsetting[i].turnon;
1447 }
1448 else { /* = sign found: use it but forbid -no form */
1449 if(is_a_turnoff) {
1450 (void)fflush(list_fd);
1451 (void)fprintf(stderr,
1452 "No string setting allowed for %s: ignored\n",s);
1453 return;
1454 }
1455 ++strstart; /* skip past the "=" */
1456 /* In VMS,MSDOS worlds, user might not leave
1457 blank space between options. If string
1458 is followed by '/', must make a properly
1459 terminated copy. In any case, make a
1460 copy in case this option comes from
1461 the rc file. */
1462 for(numchars=0;!END_OF_OPT(strstart[numchars]);numchars++)
1463 continue;
1464
1465 *(strsetting[i].strvalue) = (char *)malloc(numchars+1);
1466 (void)strncpy( *(strsetting[i].strvalue),
1467 strstart,numchars);
1468 (*(strsetting[i].strvalue))[numchars] = '\0';
1469 }
1470
1471 /* Handle actions needed after new strsetting
1472 is read. If it was a turn-on where turnon is
1473 NULL, give a warning. */
1474 if( *(strsetting[i].strvalue) == (char *)NULL ) {
1475 (void)fflush(list_fd);
1476 (void)fprintf(stderr,
1477 "String setting missing: %s: ignored\n",s);
1478 }
1479 else {
1480 update_str_options(&strsetting[i]);
1481 }
1482
1483 return;
1484 }
1485
1486 }
1487 /* No match found: issue error message */
1488
1489 (void)fflush(list_fd);
1490 (void)fprintf(stderr,"\nUnknown %s switch: %s\n",where,s);
1491 }
1492
1493
1494 /* Routine to read integer setting from string s and check if valid */
1495
1496 PRIVATE int
1497 #if HAVE_STDC
read_setting(char * s,int * setvalue,char * name,int minlimit,int maxlimit,int turnoff,int turnon,int min_default_value,int max_default_value)1498 read_setting(char *s, int *setvalue, char *name, int minlimit, int maxlimit, int turnoff, int turnon, int min_default_value, int max_default_value)
1499 #else /* K&R style */
1500 read_setting(s, setvalue, name, minlimit, maxlimit, turnoff, turnon,
1501 min_default_value,
1502 max_default_value)
1503 char *s;
1504 int *setvalue;
1505 char *name;
1506 int minlimit, maxlimit,
1507 turnon, turnoff,
1508 min_default_value, max_default_value;
1509 #endif /* HAVE_STDC */
1510 {
1511 int given_val;
1512
1513 if(strcmp(s,"NO")==0) { /* -setting=no */
1514 *(setvalue) = turnoff;
1515 }
1516 else if(END_OF_OPT(*s)) { /* -setting */
1517 *(setvalue) = turnon;
1518 }
1519 else if(sscanf(s,"%d", &given_val) == 0) {
1520 return -1; /* error return: garbled setting */
1521 }
1522 else { /* If outside limits, set to default */
1523 int Ok=TRUE;
1524 if(given_val < minlimit) {
1525 given_val = min_default_value;
1526 Ok = FALSE;
1527 }
1528 else if(given_val > maxlimit) {
1529 given_val = max_default_value;
1530 Ok = FALSE;
1531 }
1532
1533 if(! Ok ) {
1534 (void)fflush(list_fd);
1535 (void)fprintf(stderr,"\nSetting: %s",name);
1536 (void)fprintf(stderr," outside limits %d to %d",
1537 minlimit,maxlimit);
1538 (void)fprintf(stderr,": set to default %d\n",given_val);
1539 }
1540
1541 *(setvalue) = given_val;
1542 }
1543 return 0;
1544 }
1545
1546 /* Handle actions needed to update things after
1547 getting a non-null strsetting option.
1548 */
1549 PRIVATE void
1550 #if HAVE_STDC
update_str_options(StrsettingList * strset)1551 update_str_options(StrsettingList *strset)
1552 #else /* K&R style */
1553 update_str_options(strset)
1554 StrsettingList *strset;
1555 #endif /* HAVE_STDC */
1556 {
1557
1558 /* Handle necessary action for -out=listfile */
1559 if(strset->strvalue == &out_fname)
1560 must_open_outfile = TRUE;
1561
1562 /* Update include path */
1563 #ifdef ALLOW_INCLUDE
1564 if(strset->strvalue == &include_path) {
1565 append_include_path(include_path);
1566 }
1567 #endif
1568
1569 /* Handle warnings like -f77=list */
1570 if(strset->option_list != (WarnOptionList *)NULL) {
1571 char *s = *(strset->strvalue);
1572 int numvalue;
1573 /* Allow old-fashioned -flag=num for some */
1574 if( strset->numeric_form_handler != NULL &&
1575 (numvalue = str_to_num(s)) >= 0 ) {
1576 (*(strset->numeric_form_handler))(numvalue,strset->name);
1577 }
1578 else {
1579 process_warn_string(s, strset);
1580 }
1581 }
1582 }
1583
1584 /* Routine to return -1 if string is not all
1585 digits and not null; otherwise returns
1586 integer value of string. */
1587 PRIVATE int
1588 #if HAVE_STDC
str_to_num(char * s)1589 str_to_num(char *s)
1590 #else
1591 str_to_num(s)
1592 char *s;
1593 #endif
1594 {
1595 int value=0;
1596
1597 if( s == NULL || *s == '\0' )
1598 return -1;
1599
1600 while( *s != '\0' ) {
1601 if(! isdigit(*s) )
1602 return -1;
1603 else
1604 value = value*10 + ((*s)-'0');
1605 s++;
1606 }
1607 return value;
1608 }
1609
1610 /* Process list of warn options. */
1611 PRIVATE void
1612 #if HAVE_STDC
process_warn_string(char * warn_string,StrsettingList * s)1613 process_warn_string(char *warn_string, StrsettingList *s)
1614 #else /* K&R style */
1615 process_warn_string( warn_string, s )
1616 char *warn_string; /* Names of options to set */
1617 StrsettingList *s; /* Warning-list option */
1618 #endif /* HAVE_STDC */
1619 {
1620 int i,c;
1621 char opt_buf[MAX_OPT_LEN+1];
1622
1623 WarnOptionList *warn_option = s->option_list;
1624
1625 if(strcmp(warn_string,"help") == 0) { /* Print warning help screen */
1626 list_warn_options(s);
1627 return;
1628 }
1629 else {
1630 /* Loop on warn options in string */
1631 while(!END_OF_OPT(*warn_string)) {
1632 /* Copy next warn option into buffer */
1633 for(i=0; !END_OF_OPT(*warn_string); ) {
1634 c = *warn_string++;
1635 if(c == ',' || c == ':') /* quit when reach next warn option */
1636 break;
1637 if(i<MAX_OPT_LEN)
1638 opt_buf[i++] = c;
1639 }
1640 opt_buf[i] = '\0';
1641
1642 set_warn_option(opt_buf, warn_option );
1643 }
1644 }
1645 return;
1646 }
1647
1648 /* Routine to print list of warning options */
1649 PRIVATE void
1650 #if HAVE_STDC
list_warn_options(StrsettingList * s)1651 list_warn_options(StrsettingList *s)
1652 #else /* K&R style */
1653 list_warn_options(s)
1654 StrsettingList *s; /* warning list item */
1655 #endif /* HAVE_STDC */
1656 {
1657 int i;
1658 WarnOptionList *warn_option = s->option_list;
1659
1660 ++actioncount; /* Treat as an action so if no files, quit */
1661
1662 (void)fprintf(list_fd,"\n%s Options:",warn_option[0].explanation);
1663 for(i=1; warn_option[i].name != (char *)NULL; i++) {
1664 (void)fprintf(list_fd,"\n %s [%s]: %s",
1665 warn_option[i].name,
1666 *(warn_option[i].flag)? "yes" : "no",
1667 warn_option[i].explanation);
1668 }
1669 (void)fprintf(list_fd,"\nPrefix option name with no- to turn off option");
1670 if(s->turnon != (char *)NULL) {
1671 (void)fprintf(list_fd,"\nIf no options given, equivalent to %c%s=%s",
1672 OPT_PREFIX, s->name, s->turnon);
1673 }
1674 (void)fprintf(list_fd,"\nSpecial keywords:");
1675 (void)fprintf(list_fd,"\n %s: %s","help","Print this list");
1676 (void)fprintf(list_fd,"\n %s: %s","all","Set all options");
1677 (void)fprintf(list_fd,"\n %s: %s","none","Clear all options");
1678 (void)fprintf(list_fd,"\n");
1679 }
1680
1681 /* Routine to set warning options to given values */
1682 PRIVATE void
1683 #if HAVE_STDC
set_warn_option(char * s,WarnOptionList * warn_option)1684 set_warn_option(char *s, WarnOptionList *warn_option)
1685 #else /* K&R style */
1686 set_warn_option(s, warn_option )
1687 char *s;
1688 WarnOptionList *warn_option;
1689 #endif /* HAVE_STDC */
1690 {
1691 int i, matchlen, offset;
1692 int value;
1693
1694 if(s == NULL) /* This happens when -nocheck handles -intrinsic */
1695 return;
1696
1697 /* Special keyword "all": set all options on */
1698 if(strcmp(s,"all") == 0) {
1699 for(i=1; warn_option[i].name != (char *)NULL; i++)
1700 set_warn_option_value(warn_option[i].flag,TRUE);
1701 return;
1702 }
1703 /* Special keyword "none": set all options off */
1704 else if(strcmp(s,"none") == 0 ) {
1705 for(i=1; warn_option[i].name != (char *)NULL; i++)
1706 set_warn_option_value(warn_option[i].flag,FALSE);
1707 return;
1708 }
1709 else {
1710 /* Look for "no-" prefix on option name */
1711 if(strncmp(s,"no-",strlen("no-")) == 0) {
1712 offset = strlen("no-");
1713 value = FALSE;
1714 }
1715 else {
1716 offset = 0;
1717 value = TRUE;
1718 }
1719 /* See if the given option has a wildcard */
1720 if( strchr(s,'*') == NULL ) {
1721
1722 /* No wildcard: go thru list to find a
1723 match at minimum nonambiguous length.
1724 */
1725 for(i=1,matchlen=1; warn_option[i].name != (char *)NULL; i++) {
1726 /* Look for a match at current matchlen, then
1727 if found see if unique. List must have names
1728 with matching prefixes adjacent. */
1729 while(strncmp(s+offset,warn_option[i].name,matchlen) == 0) {
1730 if(warn_option[i+1].name == (char *)NULL ||
1731 strncmp(s+offset,warn_option[i+1].name,matchlen) != 0) {
1732 set_warn_option_value(warn_option[i].flag,value);
1733 return;
1734 }
1735 else {
1736 if( s[offset+matchlen] == '\0'
1737 || warn_option[i].name[matchlen] == '\0') {
1738 (void)fflush(list_fd);
1739 (void)fprintf(stderr,
1740 "\nAmbiguous %s Option: %s: ignored\n",
1741 warn_option[0].explanation,s);
1742 return;
1743 }
1744 ++matchlen;
1745 }
1746 }
1747 }
1748 }
1749 else {
1750 /* Wildcard in pattern: find all matches. */
1751 int matches=0;
1752 for(i=1; warn_option[i].name != (char *)NULL; i++) {
1753 if( wildcard_match(s+offset,warn_option[i].name) == 0 ) {
1754 ++matches;
1755 set_warn_option_value(warn_option[i].flag,value);
1756 }
1757 }
1758 /* If nothing matched, drop out for warning */
1759 if(matches > 0 ) {
1760 return;
1761 }
1762 }
1763 }
1764 (void)fflush(list_fd);
1765 (void)fprintf(stderr,"\nNo Such %s Option: %s: ignored\n",
1766 warn_option[0].explanation,s);
1767 return;
1768 }
1769
1770
1771 /* set_warn_option_value sets values of warnlist-style flags,
1772 and also handles special cases of mutually exclusive
1773 flags and suchlike.
1774 */
1775 PRIVATE void
1776 #if HAVE_STDC
set_warn_option_value(int * flag,int value)1777 set_warn_option_value(int *flag, int value)
1778 #else /* K&R style */
1779 set_warn_option_value(flag, value )
1780 int *flag;
1781 int value;
1782 #endif /* HAVE_STDC */
1783 {
1784 /* handle mutual exclusions here */
1785
1786 if( value ) {
1787 if ( flag == &print_call_tree
1788 || flag == &print_ref_list
1789 #ifdef VCG_SUPPORT
1790 || flag == &print_vcg_list
1791 #endif
1792 ) {
1793
1794 /* Can select only one of -call=tree,ref,vcg */
1795 static int *calltree_mutual_exc_flags[]={
1796 &print_call_tree,
1797 &print_ref_list,
1798 #ifdef VCG_SUPPORT
1799 &print_vcg_list,
1800 #endif
1801 (int *)NULL
1802 };
1803
1804 mutual_exclude(calltree_option,"calltree",
1805 flag, calltree_mutual_exc_flags);
1806 }
1807 else {
1808 if( flag == &source_fixed_form
1809 || flag == &source_free_form ) {
1810
1811 /* Cannot set -source=fixed,free */
1812 static int *source_form_mutual_exc_flags[]={
1813 &source_fixed_form,
1814 &source_free_form,
1815 (int *)NULL
1816 };
1817 mutual_exclude(source_form_option,"source",
1818 flag,source_form_mutual_exc_flags);
1819 }
1820
1821 if( flag == &source_free_form
1822 || flag == &source_dec_tab ) {
1823
1824 /* Cannot have -source=dec-tabs with -source=free */
1825 static int *dec_tab_mutual_exc_flags[]={
1826 &source_dec_tab,
1827 &source_free_form,
1828 (int *)NULL
1829 };
1830
1831 mutual_exclude(source_form_option,"source",
1832 flag,dec_tab_mutual_exc_flags);
1833 }
1834 }
1835 }
1836 /* Here we actually set the value. */
1837 *flag = value;
1838 }
1839
1840 PRIVATE void
1841 #if HAVE_STDC
mutual_exclude(WarnOptionList wList[],const char * opt_name,int * thisflag,int * otherflags[])1842 mutual_exclude( WarnOptionList wList[], const char *opt_name,
1843 int *thisflag, int *otherflags[] )
1844 #else
1845 mutual_exclude( wList, opt_name,
1846 thisflag, otherflags )
1847 WarnOptionList wList[];
1848 char *opt_name;
1849 int *thisflag;
1850 int *otherflags[];
1851 #endif
1852 {
1853 int i,j, thisflag_index= -1;
1854 /* Find thisflag in the list */
1855 for(i=0; wList[i].name != NULL; i++) {
1856 if(wList[i].flag == thisflag) {
1857 thisflag_index = i;
1858 break;
1859 }
1860 }
1861 if( thisflag_index < 0 ) {
1862 oops_message(OOPS_FATAL,NO_LINE_NUM,NO_COL_NUM,"mutual_exclude routine");
1863 }
1864 else {
1865 for(j=0; otherflags[j] != NULL; j++) {
1866
1867 if( otherflags[j] == thisflag ) /* thisflag cannot conflict with self */
1868 continue;
1869
1870 if( *(otherflags[j]) ) { /* exclusion conflict found: trace it */
1871 for(i=0; wList[i].name != NULL; i++) {
1872 if(wList[i].flag == otherflags[j]) {
1873 (void)fprintf(stderr,
1874 "\nWarning: %c%s option %s overrides previous option %s\n",
1875 #ifdef OPTION_PREFIX_SLASH
1876 '/',
1877 #else
1878 '-',
1879 #endif
1880 opt_name,
1881 wList[thisflag_index].name,wList[i].name);
1882 break;
1883 }
1884 }
1885 *(otherflags[j]) = FALSE; /* turn off the conflicting option */
1886 }
1887 }
1888 }
1889 }
1890
1891
1892 /* The next few routines implement the
1893 "grandfathering" of those settings that
1894 were changed from numeric to warning-option
1895 string form, so the numeric form will still
1896 be acceptable.
1897 */
1898
1899 PRIVATE void
1900 #if HAVE_STDC
argcheck_numeric_option(int value,char * setting_name)1901 argcheck_numeric_option( int value, char *setting_name )
1902 #else
1903 argcheck_numeric_option( value, setting_name )
1904 int value;
1905 char *setting_name;
1906 #endif
1907 {
1908 if( value < 0 || value > 3) {
1909 numeric_option_error(setting_name,0,3);
1910 return;
1911 }
1912 argcheck_argnumber = ((value & 01) != 0);
1913 argcheck_arrayness = argcheck_argtype = argcheck_functype = ((value & 02) != 0);
1914 }
1915
1916 PRIVATE void
1917 #if HAVE_STDC
arraycheck_numeric_option(int value,char * setting_name)1918 arraycheck_numeric_option( int value, char *setting_name )
1919 #else
1920 arraycheck_numeric_option( value, setting_name )
1921 int value;
1922 char *setting_name;
1923 #endif
1924 {
1925 if( value < 0 || value > 3) {
1926 numeric_option_error(setting_name,0,3);
1927 return;
1928 }
1929 arraycheck_dims = ((value & 01) != 0);
1930 arraycheck_size = ((value & 02) != 0);
1931 }
1932
1933 PRIVATE void
1934 #if HAVE_STDC
calltree_numeric_option(int value,char * setting_name)1935 calltree_numeric_option( int value, char *setting_name )
1936 #else
1937 calltree_numeric_option( value, setting_name )
1938 int value;
1939 char *setting_name;
1940 #endif
1941 {
1942 int format;
1943 if( value < 0 || value > 15) {
1944 numeric_option_error(setting_name,0,15);
1945 return;
1946 }
1947
1948 format = (value & 0x3); /* Low-order two bits => output format */
1949 /* if no format specified, tree is default
1950 provided number is nonzero. */
1951 print_call_tree = (format == 1) || (format == 0 && value != 0);
1952 print_ref_list = (format == 2);
1953 #ifdef VCG_SUPPORT
1954 print_vcg_list = (format == 3);
1955 #endif
1956
1957 call_tree_prune = ((value & 0x4) == 0); /* Include 4 for no-prune */
1958 call_tree_sort = ((value & 0x8) == 0); /* Include 8 for no-sort */
1959 }
1960
1961 PRIVATE void
1962 #if HAVE_STDC
comcheck_numeric_option(int value,char * setting_name)1963 comcheck_numeric_option( int value, char *setting_name )
1964 #else
1965 comcheck_numeric_option( value, setting_name )
1966 int value;
1967 char *setting_name;
1968 #endif
1969 {
1970 if( value < 0 || value > 3) {
1971 numeric_option_error(setting_name,0,3);
1972 return;
1973 }
1974 comcheck_type = (value >= 1);
1975 comcheck_length = (value >= 2);
1976 comcheck_dims = comcheck_by_name = (value == 3);
1977 /*comcheck_volatile was controlled by -volatile flag, not here. */
1978 }
1979
1980
1981 PRIVATE void
1982 #if HAVE_STDC
intrinsic_numeric_option(int value,char * setting_name)1983 intrinsic_numeric_option( int value, char *setting_name )
1984 #else
1985 intrinsic_numeric_option( value, setting_name )
1986 int value;
1987 char *setting_name;
1988 #endif
1989 {
1990
1991 int intrins_set = value % 10;
1992 int rand_form = (value/10) % 10;
1993 int iargc_form = (value/100) % 10;
1994
1995 if( value < 0 || intrins_set > 3 || rand_form > 2 || iargc_form > 2) {
1996 numeric_option_error(setting_name,0,223);
1997 return;
1998 }
1999
2000 intrinsic_set_extra = (intrins_set != 0);
2001
2002 intrinsic_set_unix = (intrins_set == 2);
2003
2004 intrinsic_set_vms = (intrins_set == 3);
2005
2006 intrinsic_rand_no_argument = (rand_form == 0 || rand_form == 2);
2007
2008 intrinsic_rand_one_argument = (rand_form == 1 || rand_form == 2);
2009
2010 intrinsic_iargc_no_argument = (iargc_form == 0 || iargc_form == 2);
2011
2012 intrinsic_iargc_one_argument = (iargc_form == 1 || iargc_form == 2);
2013
2014 }
2015
2016 PRIVATE void
2017 #if HAVE_STDC
makedcl_numeric_option(int value,char * setting_name)2018 makedcl_numeric_option( int value, char *setting_name )
2019 #else
2020 makedcl_numeric_option( value, setting_name )
2021 int value;
2022 char *setting_name;
2023 #endif
2024 {
2025 /* makedcls options, old style = sum of numbers as spelled out below */
2026 if( value < 0 || value > 0x7ff ) {
2027 numeric_option_error(setting_name,0,0x7ff);
2028 return;
2029 }
2030
2031 dcl_declarations = (value != 0);
2032 dcl_only_undeclared = ((value & 0x0002) != 0);
2033 dcl_compact = ((value & 0x0004) != 0);
2034 dcl_use_continuations = ((value & 0x0008) != 0);
2035 dcl_keywords_lowercase = ((value & 0x0010) != 0);
2036 dcl_vars_and_consts_lowercase = ((value & 0x0020) != 0);
2037 dcl_excl_sftran3_internal_vars = ((value & 0x0040) != 0);
2038 dcl_asterisk_comment_character = ((value & 0x0080) != 0);
2039 dcl_lowercase_comment_character = ((value & 0x0100) != 0);
2040 dcl_no_array_dimensions = ((value & 0x0200) != 0);
2041 dcl_free_form = ((value & 0x0400) != 0);
2042 }
2043
2044 PRIVATE void
2045 #if HAVE_STDC
mkhtml_numeric_option(int value,char * setting_name)2046 mkhtml_numeric_option( int value, char *setting_name )
2047 #else
2048 mkhtml_numeric_option( value, setting_name )
2049 int value;
2050 char *setting_name;
2051 #endif
2052 {
2053 /* mkhtml options, old style = sum of numbers as spelled out below */
2054 if( value < 0 || value > 0x7ff ) {
2055 numeric_option_error(setting_name,0,0x7ff);
2056 return;
2057 }
2058
2059 html_documents = (value != 0);
2060 html_only_undeclared = ((value & 0x0002) != 0);
2061 html_compact = ((value & 0x0004) != 0);
2062 html_use_continuations = ((value & 0x0008) != 0);
2063 html_keywords_lowercase = ((value & 0x0010) != 0);
2064 html_vars_and_consts_lowercase = ((value & 0x0020) != 0);
2065 html_excl_sftran3_internal_vars = ((value & 0x0040) != 0);
2066 html_no_array_dimensions = ((value & 0x0200) != 0);
2067 html_free_form = ((value & 0x0400) != 0);
2068 }
2069
2070 PRIVATE void
2071 #if HAVE_STDC
source_numeric_option(int value,char * setting_name)2072 source_numeric_option( int value, char *setting_name )
2073 #else
2074 source_numeric_option( value, setting_name )
2075 int value;
2076 char *setting_name;
2077 #endif
2078 {
2079 /* source format options, old style = sum of:
2080 1=DEC Fortran tab-format
2081 2=VMS-style INCLUDE statement
2082 4=UNIX-style backslash escape char
2083 8=implicit typing of standard-form PARAMETERs
2084 16=standard typing of DEC-Fortran-form PARAMETERs
2085 */
2086
2087 if( value < 0 || value > 15 ) {
2088 numeric_option_error(setting_name,0,15);
2089 return;
2090 }
2091 source_dec_tab = ((value & 1) != 0);
2092 source_vms_include = ((value & 2) != 0);
2093 source_unix_backslash = ((value & 4) != 0);
2094 source_param_implicit = ((value & 8) != 0);
2095 source_dec_param_std_type = ((value & 0x10) != 0);
2096 }
2097
2098
2099 PRIVATE void
2100 #if HAVE_STDC
usage_numeric_option(int value,char * setting_name)2101 usage_numeric_option( int value, char *setting_name )
2102 #else
2103 usage_numeric_option( value, setting_name )
2104 int value;
2105 char *setting_name;
2106 #endif
2107 {
2108
2109 int var_usage = value % 10;
2110 int com_usage = (value/10) % 10;
2111 int ext_usage = (value/100) % 10;
2112
2113 if( value < 0 || var_usage > 3 || com_usage > 3 || ext_usage > 3 ) {
2114 numeric_option_error(setting_name,0,333);
2115 return;
2116 }
2117 /* Set flag variables according to the old rules:
2118 ones digit = vars, tens = com, hundreds = ext
2119 1 = used-not-defined, 2 = unused, 3 = all
2120
2121 Note: the variable com-block-volatile is not
2122 touched here.
2123 */
2124
2125 usage_var_uninitialized = usage_arg_modified =
2126 usage_arg_alias_modified = usage_array_alias_modified =
2127 usage_arg_common_modified = usage_array_common_modified = ((var_usage & 0x1)!=0);
2128
2129 usage_var_set_unused = usage_var_unused = usage_arg_unused = ((var_usage & 0x2)!=0);
2130
2131 usage_com_var_uninitialized = ((com_usage & 0x1)!=0);
2132
2133 usage_com_var_set_unused = usage_com_block_unused =
2134 usage_com_var_unused = ((com_usage & 0x2)!=0);
2135
2136 usage_ext_multiply_defined = usage_ext_declared_only =
2137 usage_ext_undefined = ((ext_usage & 0x1)!=0);
2138
2139 usage_ext_unused = ((ext_usage & 0x2)!=0);
2140
2141 }
2142
2143 PRIVATE void
2144 #if HAVE_STDC
numeric_option_error(char * setting_name,int minlimit,int maxlimit)2145 numeric_option_error( char *setting_name, int minlimit, int maxlimit )
2146 #else
2147 numeric_option_error( setting_name, minlimit, maxlimit )
2148 char *setting_name;
2149 int minlimit;
2150 int maxlimit;
2151 #endif
2152 {
2153 (void)fflush(list_fd);
2154 (void)fprintf(stderr,"\nSetting: %s outside limits %d to %d",
2155 setting_name,minlimit,maxlimit);
2156 (void)fprintf(stderr,": setting ignored\n");
2157 }
2158
2159
2160 /* Routine to turn off all switches and numeric settings except
2161 -word and -wrap. The effect is as if -no had been given
2162 for each switch and setting. Useful when other features
2163 like calltree are being used and checking is not needed.
2164 */
turn_off_checks(VOID)2165 void turn_off_checks(VOID)
2166 {
2167 unsigned i;
2168
2169 /* Put all switches to FALSE */
2170 for(i=0; i<NUM_SWITCHES; i++) {
2171 if(switchopt[i].isacheck == IS_A_CHECK)
2172 *(switchopt[i].switchflag) = FALSE;
2173 }
2174
2175 /* Put all settings to turnoff value */
2176 for(i=0; i<NUM_SETTINGS; i++) {
2177 if(setting[i].isacheck == IS_A_CHECK)
2178 *(setting[i].setvalue) = setting[i].turnoff;
2179 }
2180
2181 /* Turn off warn lists */
2182 for(i=0; i<NUM_STRSETTINGS; i++) {
2183 if( strsetting[i].isacheck == IS_A_CHECK
2184 && strsetting[i].option_list != (WarnOptionList *)NULL ) {
2185 set_warn_option( strsetting[i].turnoff,
2186 strsetting[i].option_list);
2187 /* Set strvalue so -help reports correctly */
2188 *(strsetting[i].strvalue) = strsetting[i].turnoff;
2189 }
2190 }
2191 /* Turn off checks without own options */
2192 misc_warn = FALSE;
2193
2194 }
2195
2196 /* Routine to compare a string str against
2197 a pattern pat, which can contain '*' to
2198 match any character string. Returns 0
2199 (like strcmp) if match, 1 if not.
2200 */
2201 PRIVATE int
2202 #if HAVE_STDC
wildcard_match(char * pat,char * str)2203 wildcard_match(char *pat, char *str)
2204 #else /* K&R style */
2205 wildcard_match(pat, str)
2206 char *pat;
2207 char *str;
2208 #endif /* HAVE_STDC */
2209 {
2210 register char *s, *p; /* pointers that run thru each */
2211 register int sc, pc; /* current str char and pat char */
2212 s = str;
2213 p = pat;
2214 for( pc = *p++, sc = *s++; pc != '\0'; pc = *p++, sc = *s++ ) {
2215 if( pc != '*' ) {
2216 if(sc != pc) {
2217 return 1; /* mismatch found */
2218 }
2219 }
2220 else { /* wildcard found */
2221 do {
2222 pc = *p++;
2223 } while( pc == '*' ); /* skip past the wildcard */
2224
2225 if(pc == '\0') {
2226 return 0; /* pattern ends with '*' => match */
2227 }
2228 else {
2229 /* Try to match rest of patt with str starting
2230 at some point from here to end. We do a
2231 small optimization to avoid the recursive
2232 call in many cases. */
2233 while(sc != '\0') {
2234 if( sc == pc && wildcard_match(p,s) == 0 )
2235 return 0;
2236 sc = *s++;
2237 }
2238 return 1; /* No match found */
2239 }
2240 }
2241 }
2242 return (sc != '\0'); /* End of pattern: OK if end of string */
2243 }
2244
2245
2246 void
2247 #if HAVE_STDC
list_options(FILE * fd)2248 list_options(FILE *fd)/* List all commandline options, strsettings, and settings */
2249 #else /* K&R style */
2250 list_options(fd)/* List all commandline options, strsettings, and settings */
2251 FILE *fd;
2252 #endif /* HAVE_STDC */
2253 {
2254 unsigned i;
2255
2256 /* Print the copyright notice */
2257 (void)fprintf(fd,"\n%s",COPYRIGHT_DATE);
2258 (void)fprintf(fd,"\n%s\n",COPYRIGHT_NOTICE);
2259
2260 /* Note: Headings say "default" but to be accurate they
2261 should say "current value". This would be confusing. */
2262 (void)fprintf(fd,"\nCommandline options [default]:");
2263 for(i=0; i<NUM_SWITCHES; i++) {
2264
2265 if( !debug_latest &&
2266 strncmp(switchopt[i].explanation,"debug",5) == 0)
2267 continue; /* skip debug switches unless debug mode */
2268
2269 (void)fprintf(fd,"\n %c[no]%s",OPT_PREFIX,switchopt[i].name);
2270 (void)fprintf(fd," [%s]",*(switchopt[i].switchflag)? "yes": "no");
2271 (void)fprintf(fd,": %s",switchopt[i].explanation);
2272 }
2273 /* String settings follow switches w/o their own heading */
2274 for(i=0; i<NUM_STRSETTINGS; i++) {
2275 if( !debug_latest &&
2276 strncmp(strsetting[i].explanation,"debug",5) == 0)
2277 continue; /* skip debug settings unless debug mode */
2278
2279 (void)fprintf(fd,"\n %c%s=str ",OPT_PREFIX,strsetting[i].name);
2280 /* If strvalue has been given, list it. Otherwise,
2281 if this has an optionlist, the default value is
2282 given as 'name' of option 0, which is the title
2283 entry of the list.
2284 */
2285 (void)fprintf(fd,"[%s]",
2286 *(strsetting[i].strvalue)?
2287 *(strsetting[i].strvalue):
2288 strsetting[i].option_list != (WarnOptionList *)NULL?
2289 strsetting[i].option_list[0].name:
2290 "NONE");
2291 (void)fprintf(fd,": %s",strsetting[i].explanation);
2292 if( strsetting[i].option_list != (WarnOptionList *)NULL )
2293 (void)fprintf(fd,"\n Use %c%s=help for list of options",
2294 #ifdef OPTION_PREFIX_SLASH
2295 '/',
2296 #else
2297 '-',
2298 #endif
2299 strsetting[i].name);
2300 }
2301
2302 (void)fprintf(fd,"\nSettings (legal range) [default]:");
2303 for(i=0; i<NUM_SETTINGS; i++) {
2304
2305 if( !debug_latest &&
2306 strncmp(setting[i].explanation,"debug",5) == 0)
2307 continue; /* skip debug settings unless debug mode */
2308
2309 (void)fprintf(fd,"\n %c%s=dd ",OPT_PREFIX,setting[i].name);
2310 (void)fprintf(fd,"(%d to %d) ",setting[i].minlimit,
2311 setting[i].maxlimit);
2312 (void)fprintf(fd,"[%d]",*(setting[i].setvalue));
2313 (void)fprintf(fd,": %s",setting[i].explanation);
2314 }
2315
2316 (void)fprintf(fd,
2317 "\n(First %d chars of option name significant)\n",OPT_MATCH_LEN);
2318 }
2319
2320 /* Add an include directory path to list of paths */
2321 #ifdef ALLOW_INCLUDE
2322 PRIVATE void
2323 #if HAVE_STDC
append_include_path(char * new_path)2324 append_include_path(char *new_path)
2325 #else /* K&R style */
2326 append_include_path(new_path)
2327 char *new_path;
2328 #endif /* HAVE_STDC */
2329 {
2330 IncludePathNode *new_path_node, *p;
2331 if((new_path_node=(IncludePathNode *)malloc(sizeof(IncludePathNode)))
2332 ==(IncludePathNode *)NULL) {
2333 (void)fflush(list_fd);
2334 (void)fprintf(stderr,"\nmalloc error getting path list");
2335 }
2336 else {
2337 new_path_node->link = (IncludePathNode *)NULL;
2338 new_path_node->include_path = new_path;
2339 /* Append the new node at end of list */
2340 if((p=include_path_list) == (IncludePathNode *)NULL)
2341 include_path_list = new_path_node;
2342 else {
2343 while(p->link != (IncludePathNode *)NULL)
2344 p = p->link;
2345 p->link = new_path_node;
2346 }
2347 }
2348 #ifdef DEBUG_INCLUDE_PATH /* Print path as it grows */
2349 if(getenv("DEBUG")) {
2350 (void)fprintf(list_fd,"\nINCLUDE path=");
2351 for(p=include_path_list; p != (IncludePathNode *)NULL; p=p->link) {
2352 (void)fprintf(list_fd,"%s ",p->include_path);
2353 }
2354 (void)fprintf(list_fd,"\n");
2355 }
2356 #endif
2357 }
2358 #endif/*ALLOW_INCLUDE*/
2359