gcc/f/top.c

   1 /* top.c -- Implementation File (module.c template V1.0)
   2    Copyright (C) 1995-1997 Free Software Foundation, Inc.
   3    Contributed by James Craig Burley (burley@gnu.org).
   4
   5 This file is part of GNU Fortran.
   6
   7 GNU Fortran is free software; you can redistribute it and/or modify
   8 it under the terms of the GNU General Public License as published by
   9 the Free Software Foundation; either version 2, or (at your option)
  10 any later version.
  11
  12 GNU Fortran is distributed in the hope that it will be useful,
  13 but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 GNU General Public License for more details.
  16
  17 You should have received a copy of the GNU General Public License
  18 along with GNU Fortran; see the file COPYING.  If not, write to
  19 the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
  20 02111-1307, USA.
  21
  22    Related Modules:
  23       None.
  24
  25    Description:
  26       The GNU Fortran Front End.
  27
  28    Modifications:
  29 */
  30
  31 /* Include files. */
  32
  33 #include <ctype.h>
  34 #include "proj.h"
  35 #include "top.h"
  36 #include "bad.h"
  37 #include "bit.h"
  38 #include "bld.h"
  39 #include "com.h"
  40 #include "data.h"
  41 #include "equiv.h"
  42 #include "expr.h"
  43 #include "global.h"
  44 #include "implic.h"
  45 #include "info.h"
  46 #include "intrin.h"
  47 #include "lab.h"
  48 #include "lex.h"
  49 #include "malloc.h"
  50 #include "name.h"
  51 #include "src.h"
  52 #include "st.h"
  53 #include "storag.h"
  54 #include "symbol.h"
  55 #include "target.h"
  56 #include "where.h"
  57 #if FFECOM_targetCURRENT == FFECOM_targetGCC
  58 #include "flags.j"
  59 #endif
  60
  61 /* Externals defined here. */
  62
  63 int flag_traditional;           /* Shouldn't need this (C front end only)! */
  64 bool ffe_is_do_internal_checks_ = TRUE;
  65 bool ffe_is_90_ = FFETARGET_defaultIS_90;
  66 bool ffe_is_automatic_ = FFETARGET_defaultIS_AUTOMATIC;
  67 bool ffe_is_backslash_ = FFETARGET_defaultIS_BACKSLASH;
  68 bool ffe_is_emulate_complex_ = TRUE;
  69 bool ffe_is_underscoring_ = FFETARGET_defaultEXTERNAL_UNDERSCORED
  70   || FFETARGET_defaultUNDERSCORED_EXTERNAL_UNDERSCORED;
  71 bool ffe_is_second_underscore_ = FFETARGET_defaultUNDERSCORED_EXTERNAL_UNDERSCORED;
  72 bool ffe_is_debug_kludge_ = FALSE;
  73 bool ffe_is_dollar_ok_ = FFETARGET_defaultIS_DOLLAR_OK;
  74 bool ffe_is_f2c_ = FFETARGET_defaultIS_F2C;
  75 bool ffe_is_f2c_library_ = FFETARGET_defaultIS_F2C_LIBRARY;
  76 bool ffe_is_ffedebug_ = FALSE;
  77 bool ffe_is_free_form_ = FFETARGET_defaultIS_FREE_FORM;
  78 bool ffe_is_globals_ = TRUE;
  79 bool ffe_is_ident_ = TRUE;
  80 bool ffe_is_init_local_zero_ = FFETARGET_defaultIS_INIT_LOCAL_ZERO;
  81 bool ffe_is_mainprog_;          /* TRUE if current prog unit known to be
  82                                    main. */
  83 bool ffe_is_onetrip_ = FALSE;
  84 bool ffe_is_silent_ = TRUE;
  85 bool ffe_is_typeless_boz_ = FALSE;
  86 bool ffe_is_pedantic_ = FFETARGET_defaultIS_PEDANTIC;
  87 bool ffe_is_saveall_;           /* TRUE if mainprog or SAVE (no args) seen. */
  88 bool ffe_is_ugly_args_ = TRUE;
  89 bool ffe_is_ugly_assign_ = FALSE;       /* Try and store pointer to ASSIGN labels in INTEGER vars. */
  90 bool ffe_is_ugly_assumed_ = FALSE;      /* DIMENSION X([...,]1) => DIMENSION X([...,]*) */
  91 bool ffe_is_ugly_comma_ = FALSE;
  92 bool ffe_is_ugly_complex_ = FALSE;
  93 bool ffe_is_ugly_init_ = TRUE;
  94 bool ffe_is_ugly_logint_ = FALSE;
  95 bool ffe_is_version_ = FALSE;
  96 bool ffe_is_vxt_ = FALSE;
  97 bool ffe_is_warn_globals_ = TRUE;
  98 bool ffe_is_warn_implicit_ = FALSE;
  99 bool ffe_is_warn_surprising_ = FALSE;
 100 bool ffe_is_zeros_ = FALSE;
 101 ffeCase ffe_case_intrin_ = FFETARGET_defaultCASE_INTRIN;
 102 ffeCase ffe_case_match_ = FFETARGET_defaultCASE_MATCH;
 103 ffeCase ffe_case_source_ = FFETARGET_defaultCASE_SOURCE;
 104 ffeCase ffe_case_symbol_ = FFETARGET_defaultCASE_SYMBOL;
 105 ffeIntrinsicState ffe_intrinsic_state_badu77_ = FFE_intrinsicstateENABLED;
 106 ffeIntrinsicState ffe_intrinsic_state_gnu_ = FFE_intrinsicstateENABLED;
 107 ffeIntrinsicState ffe_intrinsic_state_f2c_ = FFE_intrinsicstateENABLED;
 108 ffeIntrinsicState ffe_intrinsic_state_f90_ = FFE_intrinsicstateENABLED;
 109 ffeIntrinsicState ffe_intrinsic_state_mil_ = FFE_intrinsicstateENABLED;
 110 ffeIntrinsicState ffe_intrinsic_state_unix_ = FFE_intrinsicstateENABLED;
 111 ffeIntrinsicState ffe_intrinsic_state_vxt_ = FFE_intrinsicstateENABLED;
 112 int ffe_fixed_line_length_ = FFETARGET_defaultFIXED_LINE_LENGTH;
 113 mallocPool ffe_file_pool_ = NULL;
 114 mallocPool ffe_any_unit_pool_ = NULL;
 115 mallocPool ffe_program_unit_pool_ = NULL;
 116 ffeCounter ffe_count_0 = 0;
 117 ffeCounter ffe_count_1 = 0;
 118 ffeCounter ffe_count_2 = 0;
 119 ffeCounter ffe_count_3 = 0;
 120 ffeCounter ffe_count_4 = 0;
 121 bool ffe_in_0 = FALSE;
 122 bool ffe_in_1 = FALSE;
 123 bool ffe_in_2 = FALSE;
 124 bool ffe_in_3 = FALSE;
 125 bool ffe_in_4 = FALSE;
 126
 127 /* Simple definitions and enumerations. */
 128
 129
 130 /* Internal typedefs. */
 131
 132
 133 /* Private include files. */
 134
 135
 136 /* Internal structure definitions. */
 137
 138
 139 /* Static objects accessed by functions in this module. */
 140
 141
 142 /* Static functions (internal). */
 143
 144 static bool ffe_is_digit_string_ (char *s);
 145
 146 /* Internal macros. */
 147 \f
 148 static bool
 149 ffe_is_digit_string_ (char *s)
 150 {
 151   char *p;
 152
 153   for (p = s; isdigit (*p); ++p)
 154     ;
 155
 156   return (p != s) && (*p == '\0');
 157 }
 158
 159 /* Handle command-line options.  Returns 0 if unrecognized, 1 if
 160    recognized and handled.  */
 161
 162 int
 163 ffe_decode_option (char *opt)
 164 {
 165   if (opt[0] != '-')
 166     return 0;
 167   if (opt[1] == 'f')
 168     {
 169       if (strcmp (&opt[2], "version") == 0)
 170         ffe_set_is_version (TRUE);
 171       else if (strcmp (&opt[2], "null-version") == 0)
 172         ;                       /* Someday generate program to print version
 173                                    info.  */
 174       else if (strcmp (&opt[2], "set-g77-defaults") == 0)
 175         {
 176           ffe_is_do_internal_checks_ = 0;
 177 #if BUILT_FOR_270       /* User must have applied patch (circa 2.7.2 and beyond). */
 178 #if 0
 179           flag_rerun_loop_opt = 1;
 180 #endif
 181           flag_move_all_movables = 1;
 182           flag_reduce_all_givs = 1;
 183           flag_argument_noalias = 2;
 184 #endif
 185         }
 186       else if (strcmp (&opt[2], "ident") == 0)
 187         ffe_set_is_ident (TRUE);
 188       else if (strcmp (&opt[2], "no-ident") == 0)
 189         ffe_set_is_ident (FALSE);
 190       else if (strcmp (&opt[2], "f66") == 0)
 191         {
 192           ffe_set_is_onetrip (TRUE);
 193           ffe_set_is_ugly_assumed (TRUE);
 194         }
 195       else if (strcmp (&opt[2], "no-f66") == 0)
 196         {
 197           ffe_set_is_onetrip (FALSE);
 198           ffe_set_is_ugly_assumed (FALSE);
 199         }
 200       else if (strcmp (&opt[2], "f77") == 0)
 201         {
 202           ffe_set_is_backslash (TRUE);
 203           ffe_set_is_typeless_boz (FALSE);
 204         }
 205       else if (strcmp (&opt[2], "no-f77") == 0)
 206         {
 207           ffe_set_is_backslash (FALSE);
 208         }
 209       else if (strcmp (&opt[2], "f90") == 0)
 210         ffe_set_is_90 (TRUE);
 211       else if (strcmp (&opt[2], "no-f90") == 0)
 212         ffe_set_is_90 (FALSE);
 213       else if (strcmp (&opt[2], "automatic") == 0)
 214         ffe_set_is_automatic (TRUE);
 215       else if (strcmp (&opt[2], "no-automatic") == 0)
 216         ffe_set_is_automatic (FALSE);
 217       else if (strcmp (&opt[2], "dollar-ok") == 0)
 218         ffe_set_is_dollar_ok (TRUE);
 219       else if (strcmp (&opt[2], "no-dollar-ok") == 0)
 220         ffe_set_is_dollar_ok (FALSE);
 221       else if (strcmp (&opt[2], "f2c") == 0)
 222         ffe_set_is_f2c (TRUE);
 223       else if (strcmp (&opt[2], "no-f2c") == 0)
 224         ffe_set_is_f2c (FALSE);
 225       else if (strcmp (&opt[2], "f2c-library") == 0)
 226         ffe_set_is_f2c_library (TRUE);
 227       else if (strcmp (&opt[2], "no-f2c-library") == 0)
 228         ffe_set_is_f2c_library (FALSE);
 229       else if (strcmp (&opt[2], "free-form") == 0)
 230         ffe_set_is_free_form (TRUE);
 231       else if (strcmp (&opt[2], "no-free-form") == 0)
 232         ffe_set_is_free_form (FALSE);
 233       else if (strcmp (&opt[2], "fixed-form") == 0)
 234         ffe_set_is_free_form (FALSE);
 235       else if (strcmp (&opt[2], "no-fixed-form") == 0)
 236         ffe_set_is_free_form (TRUE);
 237       else if (strcmp (&opt[2], "pedantic") == 0)
 238         ffe_set_is_pedantic (TRUE);
 239       else if (strcmp (&opt[2], "no-pedantic") == 0)
 240         ffe_set_is_pedantic (FALSE);
 241       else if (strcmp (&opt[2], "vxt") == 0)
 242         ffe_set_is_vxt (TRUE);
 243       else if (strcmp (&opt[2], "not-vxt") == 0)
 244         ffe_set_is_vxt (FALSE);
 245       else if (strcmp (&opt[2], "vxt-not-f90") == 0)
 246         warning ("%s no longer supported -- try -fvxt", opt);
 247       else if (strcmp (&opt[2], "f90-not-vxt") == 0)
 248         warning ("%s no longer supported -- try -fno-vxt -ff90", opt);
 249       else if (strcmp (&opt[2], "ugly") == 0)
 250         {
 251           warning ("%s is overloaded with meanings and likely to be removed;", opt);
 252           warning ("use only the specific -fugly-* options you need");
 253           ffe_set_is_ugly_args (TRUE);
 254           ffe_set_is_ugly_assign (TRUE);
 255           ffe_set_is_ugly_assumed (TRUE);
 256           ffe_set_is_ugly_comma (TRUE);
 257           ffe_set_is_ugly_complex (TRUE);
 258           ffe_set_is_ugly_init (TRUE);
 259           ffe_set_is_ugly_logint (TRUE);
 260         }
 261       else if (strcmp (&opt[2], "no-ugly") == 0)
 262         {
 263           ffe_set_is_ugly_args (FALSE);
 264           ffe_set_is_ugly_assign (FALSE);
 265           ffe_set_is_ugly_assumed (FALSE);
 266           ffe_set_is_ugly_comma (FALSE);
 267           ffe_set_is_ugly_complex (FALSE);
 268           ffe_set_is_ugly_init (FALSE);
 269           ffe_set_is_ugly_logint (FALSE);
 270         }
 271       else if (strcmp (&opt[2], "ugly-args") == 0)
 272         ffe_set_is_ugly_args (TRUE);
 273       else if (strcmp (&opt[2], "no-ugly-args") == 0)
 274         ffe_set_is_ugly_args (FALSE);
 275       else if (strcmp (&opt[2], "ugly-assign") == 0)
 276         ffe_set_is_ugly_assign (TRUE);
 277       else if (strcmp (&opt[2], "no-ugly-assign") == 0)
 278         ffe_set_is_ugly_assign (FALSE);
 279       else if (strcmp (&opt[2], "ugly-assumed") == 0)
 280         ffe_set_is_ugly_assumed (TRUE);
 281       else if (strcmp (&opt[2], "no-ugly-assumed") == 0)
 282         ffe_set_is_ugly_assumed (FALSE);
 283       else if (strcmp (&opt[2], "ugly-comma") == 0)
 284         ffe_set_is_ugly_comma (TRUE);
 285       else if (strcmp (&opt[2], "no-ugly-comma") == 0)
 286         ffe_set_is_ugly_comma (FALSE);
 287       else if (strcmp (&opt[2], "ugly-complex") == 0)
 288         ffe_set_is_ugly_complex (TRUE);
 289       else if (strcmp (&opt[2], "no-ugly-complex") == 0)
 290         ffe_set_is_ugly_complex (FALSE);
 291       else if (strcmp (&opt[2], "ugly-init") == 0)
 292         ffe_set_is_ugly_init (TRUE);
 293       else if (strcmp (&opt[2], "no-ugly-init") == 0)
 294         ffe_set_is_ugly_init (FALSE);
 295       else if (strcmp (&opt[2], "ugly-logint") == 0)
 296         ffe_set_is_ugly_logint (TRUE);
 297       else if (strcmp (&opt[2], "no-ugly-logint") == 0)
 298         ffe_set_is_ugly_logint (FALSE);
 299       else if (strcmp (&opt[2], "xyzzy") == 0)
 300         ffe_set_is_ffedebug (TRUE);
 301       else if (strcmp (&opt[2], "no-xyzzy") == 0)
 302         ffe_set_is_ffedebug (FALSE);
 303       else if (strcmp (&opt[2], "init-local-zero") == 0)
 304         ffe_set_is_init_local_zero (TRUE);
 305       else if (strcmp (&opt[2], "no-init-local-zero") == 0)
 306         ffe_set_is_init_local_zero (FALSE);
 307       else if (strcmp (&opt[2], "emulate-complex") == 0)
 308         ffe_set_is_emulate_complex (TRUE);
 309       else if (strcmp (&opt[2], "no-emulate-complex") == 0)
 310         ffe_set_is_emulate_complex (FALSE);
 311       else if (strcmp (&opt[2], "backslash") == 0)
 312         ffe_set_is_backslash (TRUE);
 313       else if (strcmp (&opt[2], "no-backslash") == 0)
 314         ffe_set_is_backslash (FALSE);
 315       else if (strcmp (&opt[2], "underscoring") == 0)
 316         ffe_set_is_underscoring (TRUE);
 317       else if (strcmp (&opt[2], "no-underscoring") == 0)
 318         ffe_set_is_underscoring (FALSE);
 319       else if (strcmp (&opt[2], "second-underscore") == 0)
 320         ffe_set_is_second_underscore (TRUE);
 321       else if (strcmp (&opt[2], "no-second-underscore") == 0)
 322         ffe_set_is_second_underscore (FALSE);
 323       else if (strcmp (&opt[2], "zeros") == 0)
 324         ffe_set_is_zeros (TRUE);
 325       else if (strcmp (&opt[2], "no-zeros") == 0)
 326         ffe_set_is_zeros (FALSE);
 327       else if (strcmp (&opt[2], "debug-kludge") == 0)
 328         ffe_set_is_debug_kludge (TRUE);
 329       else if (strcmp (&opt[2], "no-debug-kludge") == 0)
 330         ffe_set_is_debug_kludge (FALSE);
 331       else if (strcmp (&opt[2], "onetrip") == 0)
 332         ffe_set_is_onetrip (TRUE);
 333       else if (strcmp (&opt[2], "no-onetrip") == 0)
 334         ffe_set_is_onetrip (FALSE);
 335       else if (strcmp (&opt[2], "silent") == 0)
 336         ffe_set_is_silent (TRUE);
 337       else if (strcmp (&opt[2], "no-silent") == 0)
 338         ffe_set_is_silent (FALSE);
 339       else if (strcmp (&opt[2], "globals") == 0)
 340         ffe_set_is_globals (TRUE);
 341       else if (strcmp (&opt[2], "no-globals") == 0)
 342         ffe_set_is_globals (FALSE);
 343       else if (strcmp (&opt[2], "typeless-boz") == 0)
 344         ffe_set_is_typeless_boz (TRUE);
 345       else if (strcmp (&opt[2], "no-typeless-boz") == 0)
 346         ffe_set_is_typeless_boz (FALSE);
 347       else if (strcmp (&opt[2], "intrin-case-initcap") == 0)
 348         ffe_set_case_intrin (FFE_caseINITCAP);
 349       else if (strcmp (&opt[2], "intrin-case-upper") == 0)
 350         ffe_set_case_intrin (FFE_caseUPPER);
 351       else if (strcmp (&opt[2], "intrin-case-lower") == 0)
 352         ffe_set_case_intrin (FFE_caseLOWER);
 353       else if (strcmp (&opt[2], "intrin-case-any") == 0)
 354         ffe_set_case_intrin (FFE_caseNONE);
 355       else if (strcmp (&opt[2], "match-case-initcap") == 0)
 356         ffe_set_case_match (FFE_caseINITCAP);
 357       else if (strcmp (&opt[2], "match-case-upper") == 0)
 358         ffe_set_case_match (FFE_caseUPPER);
 359       else if (strcmp (&opt[2], "match-case-lower") == 0)
 360         ffe_set_case_match (FFE_caseLOWER);
 361       else if (strcmp (&opt[2], "match-case-any") == 0)
 362         ffe_set_case_match (FFE_caseNONE);
 363       else if (strcmp (&opt[2], "source-case-upper") == 0)
 364         ffe_set_case_source (FFE_caseUPPER);
 365       else if (strcmp (&opt[2], "source-case-lower") == 0)
 366         ffe_set_case_source (FFE_caseLOWER);
 367       else if (strcmp (&opt[2], "source-case-preserve") == 0)
 368         ffe_set_case_source (FFE_caseNONE);
 369       else if (strcmp (&opt[2], "symbol-case-initcap") == 0)
 370         ffe_set_case_symbol (FFE_caseINITCAP);
 371       else if (strcmp (&opt[2], "symbol-case-upper") == 0)
 372         ffe_set_case_symbol (FFE_caseUPPER);
 373       else if (strcmp (&opt[2], "symbol-case-lower") == 0)
 374         ffe_set_case_symbol (FFE_caseLOWER);
 375       else if (strcmp (&opt[2], "symbol-case-any") == 0)
 376         ffe_set_case_symbol (FFE_caseNONE);
 377       else if (strcmp (&opt[2], "case-strict-upper") == 0)
 378         {
 379           ffe_set_case_intrin (FFE_caseUPPER);
 380           ffe_set_case_match (FFE_caseUPPER);
 381           ffe_set_case_source (FFE_caseNONE);
 382           ffe_set_case_symbol (FFE_caseUPPER);
 383         }
 384       else if (strcmp (&opt[2], "case-strict-lower") == 0)
 385         {
 386           ffe_set_case_intrin (FFE_caseLOWER);
 387           ffe_set_case_match (FFE_caseLOWER);
 388           ffe_set_case_source (FFE_caseNONE);
 389           ffe_set_case_symbol (FFE_caseLOWER);
 390         }
 391       else if (strcmp (&opt[2], "case-initcap") == 0)
 392         {
 393           ffe_set_case_intrin (FFE_caseINITCAP);
 394           ffe_set_case_match (FFE_caseINITCAP);
 395           ffe_set_case_source (FFE_caseNONE);
 396           ffe_set_case_symbol (FFE_caseINITCAP);
 397         }
 398       else if (strcmp (&opt[2], "case-upper") == 0)
 399         {
 400           ffe_set_case_intrin (FFE_caseNONE);
 401           ffe_set_case_match (FFE_caseNONE);
 402           ffe_set_case_source (FFE_caseUPPER);
 403           ffe_set_case_symbol (FFE_caseNONE);
 404         }
 405       else if (strcmp (&opt[2], "case-lower") == 0)
 406         {
 407           ffe_set_case_intrin (FFE_caseNONE);
 408           ffe_set_case_match (FFE_caseNONE);
 409           ffe_set_case_source (FFE_caseLOWER);
 410           ffe_set_case_symbol (FFE_caseNONE);
 411         }
 412       else if (strcmp (&opt[2], "case-preserve") == 0)
 413         {
 414           ffe_set_case_intrin (FFE_caseNONE);
 415           ffe_set_case_match (FFE_caseNONE);
 416           ffe_set_case_source (FFE_caseNONE);
 417           ffe_set_case_symbol (FFE_caseNONE);
 418         }
 419       else if (strcmp (&opt[2], "badu77-intrinsics-delete") == 0)
 420         ffe_set_intrinsic_state_badu77 (FFE_intrinsicstateDELETED);
 421       else if (strcmp (&opt[2], "badu77-intrinsics-hide") == 0)
 422         ffe_set_intrinsic_state_badu77 (FFE_intrinsicstateHIDDEN);
 423       else if (strcmp (&opt[2], "badu77-intrinsics-disable") == 0)
 424         ffe_set_intrinsic_state_badu77 (FFE_intrinsicstateDISABLED);
 425       else if (strcmp (&opt[2], "badu77-intrinsics-enable") == 0)
 426         ffe_set_intrinsic_state_badu77 (FFE_intrinsicstateENABLED);
 427       else if (strcmp (&opt[2], "gnu-intrinsics-delete") == 0)
 428         ffe_set_intrinsic_state_gnu (FFE_intrinsicstateDELETED);
 429       else if (strcmp (&opt[2], "gnu-intrinsics-hide") == 0)
 430         ffe_set_intrinsic_state_gnu (FFE_intrinsicstateHIDDEN);
 431       else if (strcmp (&opt[2], "gnu-intrinsics-disable") == 0)
 432         ffe_set_intrinsic_state_gnu (FFE_intrinsicstateDISABLED);
 433       else if (strcmp (&opt[2], "gnu-intrinsics-enable") == 0)
 434         ffe_set_intrinsic_state_gnu (FFE_intrinsicstateENABLED);
 435       else if (strcmp (&opt[2], "f2c-intrinsics-delete") == 0)
 436         ffe_set_intrinsic_state_f2c (FFE_intrinsicstateDELETED);
 437       else if (strcmp (&opt[2], "f2c-intrinsics-hide") == 0)
 438         ffe_set_intrinsic_state_f2c (FFE_intrinsicstateHIDDEN);
 439       else if (strcmp (&opt[2], "f2c-intrinsics-disable") == 0)
 440         ffe_set_intrinsic_state_f2c (FFE_intrinsicstateDISABLED);
 441       else if (strcmp (&opt[2], "f2c-intrinsics-enable") == 0)
 442         ffe_set_intrinsic_state_f2c (FFE_intrinsicstateENABLED);
 443       else if (strcmp (&opt[2], "f90-intrinsics-delete") == 0)
 444         ffe_set_intrinsic_state_f90 (FFE_intrinsicstateDELETED);
 445       else if (strcmp (&opt[2], "f90-intrinsics-hide") == 0)
 446         ffe_set_intrinsic_state_f90 (FFE_intrinsicstateHIDDEN);
 447       else if (strcmp (&opt[2], "f90-intrinsics-disable") == 0)
 448         ffe_set_intrinsic_state_f90 (FFE_intrinsicstateDISABLED);
 449       else if (strcmp (&opt[2], "f90-intrinsics-enable") == 0)
 450         ffe_set_intrinsic_state_f90 (FFE_intrinsicstateENABLED);
 451       else if (strcmp (&opt[2], "mil-intrinsics-delete") == 0)
 452         ffe_set_intrinsic_state_mil (FFE_intrinsicstateDELETED);
 453       else if (strcmp (&opt[2], "mil-intrinsics-hide") == 0)
 454         ffe_set_intrinsic_state_mil (FFE_intrinsicstateHIDDEN);
 455       else if (strcmp (&opt[2], "mil-intrinsics-disable") == 0)
 456         ffe_set_intrinsic_state_mil (FFE_intrinsicstateDISABLED);
 457       else if (strcmp (&opt[2], "mil-intrinsics-enable") == 0)
 458         ffe_set_intrinsic_state_mil (FFE_intrinsicstateENABLED);
 459       else if (strcmp (&opt[2], "unix-intrinsics-delete") == 0)
 460         ffe_set_intrinsic_state_unix (FFE_intrinsicstateDELETED);
 461       else if (strcmp (&opt[2], "unix-intrinsics-hide") == 0)
 462         ffe_set_intrinsic_state_unix (FFE_intrinsicstateHIDDEN);
 463       else if (strcmp (&opt[2], "unix-intrinsics-disable") == 0)
 464         ffe_set_intrinsic_state_unix (FFE_intrinsicstateDISABLED);
 465       else if (strcmp (&opt[2], "unix-intrinsics-enable") == 0)
 466         ffe_set_intrinsic_state_unix (FFE_intrinsicstateENABLED);
 467       else if (strcmp (&opt[2], "vxt-intrinsics-delete") == 0)
 468         ffe_set_intrinsic_state_vxt (FFE_intrinsicstateDELETED);
 469       else if (strcmp (&opt[2], "vxt-intrinsics-hide") == 0)
 470         ffe_set_intrinsic_state_vxt (FFE_intrinsicstateHIDDEN);
 471       else if (strcmp (&opt[2], "vxt-intrinsics-disable") == 0)
 472         ffe_set_intrinsic_state_vxt (FFE_intrinsicstateDISABLED);
 473       else if (strcmp (&opt[2], "vxt-intrinsics-enable") == 0)
 474         ffe_set_intrinsic_state_vxt (FFE_intrinsicstateENABLED);
 475       else if (strncmp (&opt[2], "fixed-line-length-",
 476                         strlen ("fixed-line-length-")) == 0)
 477         {
 478           char *len = &opt[2] + strlen ("fixed-line-length-");
 479
 480           if (strcmp (len, "none") == 0)
 481             ffe_set_fixed_line_length (0);
 482           else if (ffe_is_digit_string_ (len))
 483             ffe_set_fixed_line_length (atol (len));
 484           else
 485             return 0;
 486         }
 487       else
 488         return 0;
 489     }
 490   else if (opt[1] == 'W')
 491     {
 492       if (!strcmp (&opt[2], "comment"))
 493         ; /* cpp handles this one.  */
 494       else if (!strcmp (&opt[2], "no-comment"))
 495         ; /* cpp handles this one.  */
 496       else if (!strcmp (&opt[2], "comments"))
 497         ; /* cpp handles this one.  */
 498       else if (!strcmp (&opt[2], "no-comments"))
 499         ; /* cpp handles this one.  */
 500       else if (!strcmp (&opt[2], "trigraphs"))
 501         ; /* cpp handles this one.  */
 502       else if (!strcmp (&opt[2], "no-trigraphs"))
 503         ; /* cpp handles this one.  */
 504       else if (!strcmp (&opt[2], "import"))
 505         ; /* cpp handles this one.  */
 506       else if (!strcmp (&opt[2], "no-import"))
 507         ; /* cpp handles this one.  */
 508       else if (!strcmp (&opt[2], "globals"))
 509         ffe_set_is_warn_globals (TRUE);
 510       else if (!strcmp (&opt[2], "no-globals"))
 511         ffe_set_is_warn_globals (FALSE);
 512       else if (!strcmp (&opt[2], "implicit"))
 513         ffe_set_is_warn_implicit (TRUE);
 514       else if (!strcmp (&opt[2], "no-implicit"))
 515         ffe_set_is_warn_implicit (FALSE);
 516       else if (!strcmp (&opt[2], "surprising"))
 517         ffe_set_is_warn_surprising (TRUE);
 518       else if (!strcmp (&opt[2], "no-surprising"))
 519         ffe_set_is_warn_surprising (FALSE);
 520       else if (!strcmp (&opt[2], "all"))
 521         {
 522           /* We save the value of warn_uninitialized, since if they put
 523              -Wuninitialized on the command line, we need to generate a
 524              warning about not using it without also specifying -O.  */
 525           if (warn_uninitialized != 1)
 526             warn_uninitialized = 2;
 527           warn_unused = 1;
 528         }
 529       else
 530         return 0;
 531     }
 532   else if (opt[1] == 'I')
 533     return ffecom_decode_include_option (&opt[2]);
 534   else
 535     return 0;
 536
 537   return 1;
 538 }
 539
 540 /* Run the FFE on a source file (not an INCLUDEd file).
 541
 542    Runs the whole shebang.
 543
 544    Prepare and invoke the appropriate lexer.  */
 545
 546 void
 547 ffe_file (ffewhereFile wf, FILE *f)
 548 {
 549   ffe_init_1 ();
 550   ffelex_set_handler ((ffelexHandler) ffest_first);
 551   ffewhere_file_set (wf, TRUE, 0);
 552   if (ffe_is_free_form_)
 553     ffelex_file_free (wf, f);
 554   else
 555     ffelex_file_fixed (wf, f);
 556   ffest_eof ();
 557   ffe_terminate_1 ();
 558 }
 559
 560 /* ffe_init_0 -- Initialize the FFE per image invocation
 561
 562    ffe_init_0();
 563
 564    Performs per-image invocation.  */
 565
 566 void
 567 ffe_init_0 ()
 568 {
 569   ++ffe_count_0;
 570   ffe_in_0 = TRUE;
 571
 572   ffebad_init_0 ();
 573   ffebit_init_0 ();
 574   ffebld_init_0 ();
 575   ffecom_init_0 ();
 576   ffedata_init_0 ();
 577   ffeequiv_init_0 ();
 578   ffeexpr_init_0 ();
 579   ffeglobal_init_0 ();
 580   ffeimplic_init_0 ();
 581   ffeinfo_init_0 ();
 582   ffeintrin_init_0 ();
 583   ffelab_init_0 ();
 584   ffelex_init_0 ();
 585   ffename_init_0 ();
 586   ffesrc_init_0 ();
 587   ffest_init_0 ();
 588   ffestorag_init_0 ();
 589   ffesymbol_init_0 ();
 590   ffetarget_init_0 ();
 591   ffetype_init_0 ();
 592   ffewhere_init_0 ();
 593 }
 594
 595 /* ffe_init_1 -- Initialize the FFE per source file
 596
 597    ffe_init_1();
 598
 599    Performs per-source-file invocation (not including INCLUDEd files).  */
 600
 601 void
 602 ffe_init_1 ()
 603 {
 604   ++ffe_count_1;
 605   ffe_in_1 = TRUE;
 606
 607   assert (ffe_file_pool_ == NULL);
 608   ffe_file_pool_ = malloc_pool_new ("File", malloc_pool_image (), 1024);
 609
 610   ffebad_init_1 ();
 611   ffebit_init_1 ();
 612   ffebld_init_1 ();
 613   ffecom_init_1 ();
 614   ffedata_init_1 ();
 615   ffeequiv_init_1 ();
 616   ffeexpr_init_1 ();
 617   ffeglobal_init_1 ();
 618   ffeimplic_init_1 ();
 619   ffeinfo_init_1 ();
 620   ffeintrin_init_1 ();
 621   ffelab_init_1 ();
 622   ffelex_init_1 ();
 623   ffename_init_1 ();
 624   ffesrc_init_1 ();
 625   ffest_init_1 ();
 626   ffestorag_init_1 ();
 627   ffesymbol_init_1 ();
 628   ffetarget_init_1 ();
 629   ffetype_init_1 ();
 630   ffewhere_init_1 ();
 631
 632   ffe_init_2 ();
 633 }
 634
 635 /* ffe_init_2 -- Initialize the FFE per outer program unit
 636
 637    ffe_init_2();
 638
 639    Performs per-program-unit invocation.  */
 640
 641 void
 642 ffe_init_2 ()
 643 {
 644   ++ffe_count_2;
 645   ffe_in_2 = TRUE;
 646
 647   assert (ffe_program_unit_pool_ == NULL);
 648   ffe_program_unit_pool_ = malloc_pool_new ("Program unit", ffe_file_pool_, 1024);
 649   ffe_is_mainprog_ = FALSE;
 650   ffe_is_saveall_ = !ffe_is_automatic_;
 651
 652   ffebad_init_2 ();
 653   ffebit_init_2 ();
 654   ffebld_init_2 ();
 655   ffecom_init_2 ();
 656   ffedata_init_2 ();
 657   ffeequiv_init_2 ();
 658   ffeexpr_init_2 ();
 659   ffeglobal_init_2 ();
 660   ffeimplic_init_2 ();
 661   ffeinfo_init_2 ();
 662   ffeintrin_init_2 ();
 663   ffelab_init_2 ();
 664   ffelex_init_2 ();
 665   ffename_init_2 ();
 666   ffesrc_init_2 ();
 667   ffest_init_2 ();
 668   ffestorag_init_2 ();
 669   ffesymbol_init_2 ();
 670   ffetarget_init_2 ();
 671   ffetype_init_2 ();
 672   ffewhere_init_2 ();
 673
 674   ffe_init_3 ();
 675 }
 676
 677 /* ffe_init_3 -- Initialize the FFE per any program unit
 678
 679    ffe_init_3();
 680
 681    Performs per-any-unit initialization; does NOT do
 682    per-statement-function-definition initialization (i.e. the chain
 683    of inits, from 0-3, breaks here; level 4 must be invoked independently).  */
 684
 685 void
 686 ffe_init_3 ()
 687 {
 688   ++ffe_count_3;
 689   ffe_in_3 = TRUE;
 690
 691   assert (ffe_any_unit_pool_ == NULL);
 692   ffe_any_unit_pool_ = malloc_pool_new ("Any unit", ffe_program_unit_pool_, 1024);
 693
 694   ffebad_init_3 ();
 695   ffebit_init_3 ();
 696   ffebld_init_3 ();
 697   ffecom_init_3 ();
 698   ffedata_init_3 ();
 699   ffeequiv_init_3 ();
 700   ffeexpr_init_3 ();
 701   ffeglobal_init_3 ();
 702   ffeimplic_init_3 ();
 703   ffeinfo_init_3 ();
 704   ffeintrin_init_3 ();
 705   ffelab_init_3 ();
 706   ffelex_init_3 ();
 707   ffename_init_3 ();
 708   ffesrc_init_3 ();
 709   ffest_init_3 ();
 710   ffestorag_init_3 ();
 711   ffesymbol_init_3 ();
 712   ffetarget_init_3 ();
 713   ffetype_init_3 ();
 714   ffewhere_init_3 ();
 715 }
 716
 717 /* ffe_init_4 -- Initialize the FFE per statement function definition
 718
 719    ffe_init_4();  */
 720
 721 void
 722 ffe_init_4 ()
 723 {
 724   ++ffe_count_4;
 725   ffe_in_4 = TRUE;
 726
 727   ffebad_init_4 ();
 728   ffebit_init_4 ();
 729   ffebld_init_4 ();
 730   ffecom_init_4 ();
 731   ffedata_init_4 ();
 732   ffeequiv_init_4 ();
 733   ffeexpr_init_4 ();
 734   ffeglobal_init_4 ();
 735   ffeimplic_init_4 ();
 736   ffeinfo_init_4 ();
 737   ffeintrin_init_4 ();
 738   ffelab_init_4 ();
 739   ffelex_init_4 ();
 740   ffename_init_4 ();
 741   ffesrc_init_4 ();
 742   ffest_init_4 ();
 743   ffestorag_init_4 ();
 744   ffesymbol_init_4 ();
 745   ffetarget_init_4 ();
 746   ffetype_init_4 ();
 747   ffewhere_init_4 ();
 748 }
 749
 750 /* ffe_terminate_0 -- Terminate the FFE prior to image termination
 751
 752    ffe_terminate_0();  */
 753
 754 void
 755 ffe_terminate_0 ()
 756 {
 757   ffe_count_1 = 0;
 758   ffe_in_0 = FALSE;
 759
 760   ffebad_terminate_0 ();
 761   ffebit_terminate_0 ();
 762   ffebld_terminate_0 ();
 763   ffecom_terminate_0 ();
 764   ffedata_terminate_0 ();
 765   ffeequiv_terminate_0 ();
 766   ffeexpr_terminate_0 ();
 767   ffeglobal_terminate_0 ();
 768   ffeimplic_terminate_0 ();
 769   ffeinfo_terminate_0 ();
 770   ffeintrin_terminate_0 ();
 771   ffelab_terminate_0 ();
 772   ffelex_terminate_0 ();
 773   ffename_terminate_0 ();
 774   ffesrc_terminate_0 ();
 775   ffest_terminate_0 ();
 776   ffestorag_terminate_0 ();
 777   ffesymbol_terminate_0 ();
 778   ffetarget_terminate_0 ();
 779   ffetype_terminate_0 ();
 780   ffewhere_terminate_0 ();
 781 }
 782
 783 /* ffe_terminate_1 -- Terminate the FFE after seeing source file EOF
 784
 785    ffe_terminate_1();  */
 786
 787 void
 788 ffe_terminate_1 ()
 789 {
 790   ffe_count_2 = 0;
 791   ffe_in_1 = FALSE;
 792
 793   ffe_terminate_2 ();
 794
 795   ffebad_terminate_1 ();
 796   ffebit_terminate_1 ();
 797   ffebld_terminate_1 ();
 798   ffecom_terminate_1 ();
 799   ffedata_terminate_1 ();
 800   ffeequiv_terminate_1 ();
 801   ffeexpr_terminate_1 ();
 802   ffeglobal_terminate_1 ();
 803   ffeimplic_terminate_1 ();
 804   ffeinfo_terminate_1 ();
 805   ffeintrin_terminate_1 ();
 806   ffelab_terminate_1 ();
 807   ffelex_terminate_1 ();
 808   ffename_terminate_1 ();
 809   ffesrc_terminate_1 ();
 810   ffest_terminate_1 ();
 811   ffestorag_terminate_1 ();
 812   ffesymbol_terminate_1 ();
 813   ffetarget_terminate_1 ();
 814   ffetype_terminate_1 ();
 815   ffewhere_terminate_1 ();
 816
 817   assert (ffe_file_pool_ != NULL);
 818   malloc_pool_kill (ffe_file_pool_);
 819   ffe_file_pool_ = NULL;
 820 }
 821
 822 /* ffe_terminate_2 -- Terminate the FFE after seeing outer program unit END
 823
 824    ffe_terminate_2();  */
 825
 826 void
 827 ffe_terminate_2 ()
 828 {
 829   ffe_count_3 = 0;
 830   ffe_in_2 = FALSE;
 831
 832   ffe_terminate_3 ();
 833
 834   ffebad_terminate_2 ();
 835   ffebit_terminate_2 ();
 836   ffebld_terminate_2 ();
 837   ffecom_terminate_2 ();
 838   ffedata_terminate_2 ();
 839   ffeequiv_terminate_2 ();
 840   ffeexpr_terminate_2 ();
 841   ffeglobal_terminate_2 ();
 842   ffeimplic_terminate_2 ();
 843   ffeinfo_terminate_2 ();
 844   ffeintrin_terminate_2 ();
 845   ffelab_terminate_2 ();
 846   ffelex_terminate_2 ();
 847   ffename_terminate_2 ();
 848   ffesrc_terminate_2 ();
 849   ffest_terminate_2 ();
 850   ffestorag_terminate_2 ();
 851   ffesymbol_terminate_2 ();
 852   ffetarget_terminate_2 ();
 853   ffetype_terminate_2 ();
 854   ffewhere_terminate_2 ();
 855
 856   assert (ffe_program_unit_pool_ != NULL);
 857   malloc_pool_kill (ffe_program_unit_pool_);
 858   ffe_program_unit_pool_ = NULL;
 859 }
 860
 861 /* ffe_terminate_3 -- Terminate the FFE after seeing any program unit END
 862
 863    ffe_terminate_3();  */
 864
 865 void
 866 ffe_terminate_3 ()
 867 {
 868   ffe_count_4 = 0;
 869   ffe_in_3 = FALSE;
 870
 871   ffebad_terminate_3 ();
 872   ffebit_terminate_3 ();
 873   ffebld_terminate_3 ();
 874   ffecom_terminate_3 ();
 875   ffedata_terminate_3 ();
 876   ffeequiv_terminate_3 ();
 877   ffeexpr_terminate_3 ();
 878   ffeglobal_terminate_3 ();
 879   ffeimplic_terminate_3 ();
 880   ffeinfo_terminate_3 ();
 881   ffeintrin_terminate_3 ();
 882   ffelab_terminate_3 ();
 883   ffelex_terminate_3 ();
 884   ffename_terminate_3 ();
 885   ffesrc_terminate_3 ();
 886   ffest_terminate_3 ();
 887   ffestorag_terminate_3 ();
 888   ffesymbol_terminate_3 ();
 889   ffetarget_terminate_3 ();
 890   ffetype_terminate_3 ();
 891   ffewhere_terminate_3 ();
 892
 893   assert (ffe_any_unit_pool_ != NULL);
 894   malloc_pool_kill (ffe_any_unit_pool_);
 895   ffe_any_unit_pool_ = NULL;
 896 }
 897
 898 /* ffe_terminate_4 -- Terminate the FFE after seeing sfunc def expression
 899
 900    ffe_terminate_4();  */
 901
 902 void
 903 ffe_terminate_4 ()
 904 {
 905   ffe_in_4 = FALSE;
 906
 907   ffebad_terminate_4 ();
 908   ffebit_terminate_4 ();
 909   ffebld_terminate_4 ();
 910   ffecom_terminate_4 ();
 911   ffedata_terminate_4 ();
 912   ffeequiv_terminate_4 ();
 913   ffeexpr_terminate_4 ();
 914   ffeglobal_terminate_4 ();
 915   ffeimplic_terminate_4 ();
 916   ffeinfo_terminate_4 ();
 917   ffeintrin_terminate_4 ();
 918   ffelab_terminate_4 ();
 919   ffelex_terminate_4 ();
 920   ffename_terminate_4 ();
 921   ffesrc_terminate_4 ();
 922   ffest_terminate_4 ();
 923   ffestorag_terminate_4 ();
 924   ffesymbol_terminate_4 ();
 925   ffetarget_terminate_4 ();
 926   ffetype_terminate_4 ();
 927   ffewhere_terminate_4 ();
 928 }