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