top.c

gcc-2.95.3 Linux下最常用的C编译器

/* top.c -- Implementation File (module.c template V1.0)
   Copyright (C) 1995-1997 Free Software Foundation, Inc.
   Contributed by James Craig Burley.

This file is part of GNU Fortran.

GNU Fortran is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.

GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with GNU Fortran; see the file COPYING.  If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
02111-1307, USA.

   Related Modules:
      None.

   Description:
      The GNU Fortran Front End.

   Modifications:
*/

/* Include files. */

#include "proj.h"
#include "top.h"
#include "bad.h"
#include "bit.h"
#include "bld.h"
#include "com.h"
#include "data.h"
#include "equiv.h"
#include "expr.h"
#include "global.h"
#include "implic.h"
#include "info.h"
#include "intrin.h"
#include "lab.h"
#include "lex.h"
#include "malloc.h"
#include "name.h"
#include "src.h"
#include "st.h"
#include "storag.h"
#include "symbol.h"
#include "target.h"
#include "where.h"
#if FFECOM_targetCURRENT == FFECOM_targetGCC
#include "flags.j"
#include "toplev.j"
#endif

/* Externals defined here. */

int flag_traditional;		/* Shouldn't need this (C front end only)! */
bool ffe_is_do_internal_checks_ = FALSE;
bool ffe_is_90_ = FFETARGET_defaultIS_90;
bool ffe_is_automatic_ = FFETARGET_defaultIS_AUTOMATIC;
bool ffe_is_backslash_ = FFETARGET_defaultIS_BACKSLASH;
bool ffe_is_emulate_complex_ = FALSE;
bool ffe_is_underscoring_ = FFETARGET_defaultEXTERNAL_UNDERSCORED
  || FFETARGET_defaultUNDERSCORED_EXTERNAL_UNDERSCORED;
bool ffe_is_second_underscore_ = FFETARGET_defaultUNDERSCORED_EXTERNAL_UNDERSCORED;
bool ffe_is_debug_kludge_ = FALSE;
bool ffe_is_dollar_ok_ = FFETARGET_defaultIS_DOLLAR_OK;
bool ffe_is_f2c_ = FFETARGET_defaultIS_F2C;
bool ffe_is_f2c_library_ = FFETARGET_defaultIS_F2C_LIBRARY;
bool ffe_is_ffedebug_ = FALSE;
bool ffe_is_flatten_arrays_ = FALSE;
bool ffe_is_free_form_ = FFETARGET_defaultIS_FREE_FORM;
bool ffe_is_globals_ = TRUE;
bool ffe_is_init_local_zero_ = FFETARGET_defaultIS_INIT_LOCAL_ZERO;
bool ffe_is_mainprog_;		/* TRUE if current prog unit known to be
				   main. */
bool ffe_is_null_version_ = FALSE;
bool ffe_is_onetrip_ = FALSE;
bool ffe_is_silent_ = TRUE;
bool ffe_is_subscript_check_ = FALSE;
bool ffe_is_typeless_boz_ = FALSE;
bool ffe_is_pedantic_ = FFETARGET_defaultIS_PEDANTIC;
bool ffe_is_saveall_;		/* TRUE if mainprog or SAVE (no args) seen. */
bool ffe_is_ugly_args_ = TRUE;
bool ffe_is_ugly_assign_ = FALSE;	/* Try and store pointer to ASSIGN labels in INTEGER vars. */
bool ffe_is_ugly_assumed_ = FALSE;	/* DIMENSION X([...,]1) => DIMENSION X([...,]*) */
bool ffe_is_ugly_comma_ = FALSE;
bool ffe_is_ugly_complex_ = FALSE;
bool ffe_is_ugly_init_ = TRUE;
bool ffe_is_ugly_logint_ = FALSE;
bool ffe_is_version_ = FALSE;
bool ffe_is_vxt_ = FALSE;
bool ffe_is_warn_globals_ = TRUE;
bool ffe_is_warn_implicit_ = FALSE;
bool ffe_is_warn_surprising_ = FALSE;
bool ffe_is_zeros_ = FALSE;
ffeCase ffe_case_intrin_ = FFETARGET_defaultCASE_INTRIN;
ffeCase ffe_case_match_ = FFETARGET_defaultCASE_MATCH;
ffeCase ffe_case_source_ = FFETARGET_defaultCASE_SOURCE;
ffeCase ffe_case_symbol_ = FFETARGET_defaultCASE_SYMBOL;
ffeIntrinsicState ffe_intrinsic_state_badu77_ = FFE_intrinsicstateENABLED;
ffeIntrinsicState ffe_intrinsic_state_gnu_ = FFE_intrinsicstateENABLED;
ffeIntrinsicState ffe_intrinsic_state_f2c_ = FFE_intrinsicstateENABLED;
ffeIntrinsicState ffe_intrinsic_state_f90_ = FFE_intrinsicstateENABLED;
ffeIntrinsicState ffe_intrinsic_state_mil_ = FFE_intrinsicstateENABLED;
ffeIntrinsicState ffe_intrinsic_state_unix_ = FFE_intrinsicstateENABLED;
ffeIntrinsicState ffe_intrinsic_state_vxt_ = FFE_intrinsicstateENABLED;
int ffe_fixed_line_length_ = FFETARGET_defaultFIXED_LINE_LENGTH;
mallocPool ffe_file_pool_ = NULL;
mallocPool ffe_any_unit_pool_ = NULL;
mallocPool ffe_program_unit_pool_ = NULL;
ffeCounter ffe_count_0 = 0;
ffeCounter ffe_count_1 = 0;
ffeCounter ffe_count_2 = 0;
ffeCounter ffe_count_3 = 0;
ffeCounter ffe_count_4 = 0;
bool ffe_in_0 = FALSE;
bool ffe_in_1 = FALSE;
bool ffe_in_2 = FALSE;
bool ffe_in_3 = FALSE;
bool ffe_in_4 = FALSE;

/* Simple definitions and enumerations. */


/* Internal typedefs. */


/* Private include files. */


/* Internal structure definitions. */


/* Static objects accessed by functions in this module. */


/* Static functions (internal). */

static bool ffe_is_digit_string_ (char *s);

/* Internal macros. */

static bool
ffe_is_digit_string_ (char *s)
{
  char *p;

  for (p = s; ISDIGIT (*p); ++p)
    ;

  return (p != s) && (*p == '\0');
}

/* Handle command-line options.	 Returns 0 if unrecognized, 1 if
   recognized and handled.  */

int
ffe_decode_option (argc, argv)
     int argc ATTRIBUTE_UNUSED;
     char **argv;
{
  char *opt = argv[0];
  if (opt[0] != '-')
    return 0;
  if (opt[1] == 'f')
    {
      if (strcmp (&opt[2], "version") == 0)
	{
	  ffe_set_is_version (TRUE);
	  ffe_set_is_do_internal_checks (TRUE);
	}
      else if (strcmp (&opt[2], "null-version") == 0)
	ffe_set_is_null_version (TRUE);
      else if (strcmp (&opt[2], "f66") == 0)
	{
	  ffe_set_is_onetrip (TRUE);
	  ffe_set_is_ugly_assumed (TRUE);
	}
      else if (strcmp (&opt[2], "no-f66") == 0)
	{
	  ffe_set_is_onetrip (FALSE);
	  ffe_set_is_ugly_assumed (FALSE);
	}
      else if (strcmp (&opt[2], "f77") == 0)
	{
	  ffe_set_is_backslash (TRUE);
	  ffe_set_is_typeless_boz (FALSE);
	}
      else if (strcmp (&opt[2], "no-f77") == 0)
	{
	  ffe_set_is_backslash (FALSE);
	}
      else if (strcmp (&opt[2], "f90") == 0)
	ffe_set_is_90 (TRUE);
      else if (strcmp (&opt[2], "no-f90") == 0)
	ffe_set_is_90 (FALSE);
      else if (strcmp (&opt[2], "automatic") == 0)
	ffe_set_is_automatic (TRUE);
      else if (strcmp (&opt[2], "no-automatic") == 0)
	ffe_set_is_automatic (FALSE);
      else if (strcmp (&opt[2], "dollar-ok") == 0)
	ffe_set_is_dollar_ok (TRUE);
      else if (strcmp (&opt[2], "no-dollar-ok") == 0)
	ffe_set_is_dollar_ok (FALSE);
      else if (strcmp (&opt[2], "f2c") == 0)
	ffe_set_is_f2c (TRUE);
      else if (strcmp (&opt[2], "no-f2c") == 0)
	ffe_set_is_f2c (FALSE);
      else if (strcmp (&opt[2], "f2c-library") == 0)
	ffe_set_is_f2c_library (TRUE);
      else if (strcmp (&opt[2], "no-f2c-library") == 0)
	ffe_set_is_f2c_library (FALSE);
      else if (strcmp (&opt[2], "flatten-arrays") == 0)
	ffe_set_is_flatten_arrays (TRUE);
      else if (strcmp (&opt[2], "no-flatten-arrays") == 0)
	ffe_set_is_flatten_arrays (FALSE);
      else if (strcmp (&opt[2], "free-form") == 0)
	ffe_set_is_free_form (TRUE);
      else if (strcmp (&opt[2], "no-free-form") == 0)
	ffe_set_is_free_form (FALSE);
      else if (strcmp (&opt[2], "fixed-form") == 0)
	ffe_set_is_free_form (FALSE);
      else if (strcmp (&opt[2], "no-fixed-form") == 0)
	ffe_set_is_free_form (TRUE);
      else if (strcmp (&opt[2], "pedantic") == 0)
	ffe_set_is_pedantic (TRUE);
      else if (strcmp (&opt[2], "no-pedantic") == 0)
	ffe_set_is_pedantic (FALSE);
      else if (strcmp (&opt[2], "vxt") == 0)
	ffe_set_is_vxt (TRUE);
      else if (strcmp (&opt[2], "not-vxt") == 0)
	ffe_set_is_vxt (FALSE);
      else if (strcmp (&opt[2], "vxt-not-f90") == 0)
	warning ("%s no longer supported -- try -fvxt", opt);
      else if (strcmp (&opt[2], "f90-not-vxt") == 0)
	warning ("%s no longer supported -- try -fno-vxt -ff90", opt);
      else if (strcmp (&opt[2], "no-ugly") == 0)
	{
	  ffe_set_is_ugly_args (FALSE);
	  ffe_set_is_ugly_assign (FALSE);
	  ffe_set_is_ugly_assumed (FALSE);
	  ffe_set_is_ugly_comma (FALSE);
	  ffe_set_is_ugly_complex (FALSE);
	  ffe_set_is_ugly_init (FALSE);
	  ffe_set_is_ugly_logint (FALSE);
	}
      else if (strcmp (&opt[2], "ugly-args") == 0)
	ffe_set_is_ugly_args (TRUE);
      else if (strcmp (&opt[2], "no-ugly-args") == 0)
	ffe_set_is_ugly_args (FALSE);
      else if (strcmp (&opt[2], "ugly-assign") == 0)
	ffe_set_is_ugly_assign (TRUE);
      else if (strcmp (&opt[2], "no-ugly-assign") == 0)
	ffe_set_is_ugly_assign (FALSE);
      else if (strcmp (&opt[2], "ugly-assumed") == 0)
	ffe_set_is_ugly_assumed (TRUE);
      else if (strcmp (&opt[2], "no-ugly-assumed") == 0)
	ffe_set_is_ugly_assumed (FALSE);
      else if (strcmp (&opt[2], "ugly-comma") == 0)
	ffe_set_is_ugly_comma (TRUE);
      else if (strcmp (&opt[2], "no-ugly-comma") == 0)
	ffe_set_is_ugly_comma (FALSE);
      else if (strcmp (&opt[2], "ugly-complex") == 0)
	ffe_set_is_ugly_complex (TRUE);
      else if (strcmp (&opt[2], "no-ugly-complex") == 0)
	ffe_set_is_ugly_complex (FALSE);
      else if (strcmp (&opt[2], "ugly-init") == 0)
	ffe_set_is_ugly_init (TRUE);
      else if (strcmp (&opt[2], "no-ugly-init") == 0)
	ffe_set_is_ugly_init (FALSE);
      else if (strcmp (&opt[2], "ugly-logint") == 0)
	ffe_set_is_ugly_logint (TRUE);
      else if (strcmp (&opt[2], "no-ugly-logint") == 0)
	ffe_set_is_ugly_logint (FALSE);
      else if (strcmp (&opt[2], "xyzzy") == 0)
	ffe_set_is_ffedebug (TRUE);
      else if (strcmp (&opt[2], "no-xyzzy") == 0)
	ffe_set_is_ffedebug (FALSE);
      else if (strcmp (&opt[2], "init-local-zero") == 0)
	ffe_set_is_init_local_zero (TRUE);
      else if (strcmp (&opt[2], "no-init-local-zero") == 0)
	ffe_set_is_init_local_zero (FALSE);
      else if (strcmp (&opt[2], "emulate-complex") == 0)
	ffe_set_is_emulate_complex (TRUE);
      else if (strcmp (&opt[2], "no-emulate-complex") == 0)
	ffe_set_is_emulate_complex (FALSE);
      else if (strcmp (&opt[2], "backslash") == 0)
	ffe_set_is_backslash (TRUE);
      else if (strcmp (&opt[2], "no-backslash") == 0)
	ffe_set_is_backslash (FALSE);
      else if (strcmp (&opt[2], "underscoring") == 0)
	ffe_set_is_underscoring (TRUE);
      else if (strcmp (&opt[2], "no-underscoring") == 0)
	ffe_set_is_underscoring (FALSE);
      else if (strcmp (&opt[2], "second-underscore") == 0)
	ffe_set_is_second_underscore (TRUE);
      else if (strcmp (&opt[2], "no-second-underscore") == 0)
	ffe_set_is_second_underscore (FALSE);
      else if (strcmp (&opt[2], "zeros") == 0)
	ffe_set_is_zeros (TRUE);
      else if (strcmp (&opt[2], "no-zeros") == 0)
	ffe_set_is_zeros (FALSE);
      else if (strcmp (&opt[2], "debug-kludge") == 0)
	ffe_set_is_debug_kludge (TRUE);
      else if (strcmp (&opt[2], "no-debug-kludge") == 0)
	ffe_set_is_debug_kludge (FALSE);
      else if (strcmp (&opt[2], "onetrip") == 0)
	ffe_set_is_onetrip (TRUE);
      else if (strcmp (&opt[2], "no-onetrip") == 0)
	ffe_set_is_onetrip (FALSE);
      else if (strcmp (&opt[2], "silent") == 0)
	ffe_set_is_silent (TRUE);
      else if (strcmp (&opt[2], "no-silent") == 0)
	ffe_set_is_silent (FALSE);
      else if (strcmp (&opt[2], "globals") == 0)
	ffe_set_is_globals (TRUE);
      else if (strcmp (&opt[2], "no-globals") == 0)
	ffe_set_is_globals (FALSE);
      else if (strcmp (&opt[2], "bounds-check") == 0)
	ffe_set_is_subscript_check (TRUE);
      else if (strcmp (&opt[2], "no-bounds-check") == 0)
	ffe_set_is_subscript_check (FALSE);
      else if (strcmp (&opt[2], "fortran-bounds-check") == 0)
	ffe_set_is_subscript_check (TRUE);
      else if (strcmp (&opt[2], "no-fortran-bounds-check") == 0)
	ffe_set_is_subscript_check (FALSE);
      else if (strcmp (&opt[2], "typeless-boz") == 0)
	ffe_set_is_typeless_boz (TRUE);
      else if (strcmp (&opt[2], "no-typeless-boz") == 0)
	ffe_set_is_typeless_boz (FALSE);
      else if (strcmp (&opt[2], "intrin-case-initcap") == 0)
	ffe_set_case_intrin (FFE_caseINITCAP);
      else if (strcmp (&opt[2], "intrin-case-upper") == 0)
	ffe_set_case_intrin (FFE_caseUPPER);
      else if (strcmp (&opt[2], "intrin-case-lower") == 0)
	ffe_set_case_intrin (FFE_caseLOWER);
      else if (strcmp (&opt[2], "intrin-case-any") == 0)
	ffe_set_case_intrin (FFE_caseNONE);
      else if (strcmp (&opt[2], "match-case-initcap") == 0)
	ffe_set_case_match (FFE_caseINITCAP);
      else if (strcmp (&opt[2], "match-case-upper") == 0)
	ffe_set_case_match (FFE_caseUPPER);
      else if (strcmp (&opt[2], "match-case-lower") == 0)
	ffe_set_case_match (FFE_caseLOWER);
      else if (strcmp (&opt[2], "match-case-any") == 0)
	ffe_set_case_match (FFE_caseNONE);
      else if (strcmp (&opt[2], "source-case-upper") == 0)
	ffe_set_case_source (FFE_caseUPPER);
      else if (strcmp (&opt[2], "source-case-lower") == 0)
	ffe_set_case_source (FFE_caseLOWER);
      else if (strcmp (&opt[2], "source-case-preserve") == 0)
	ffe_set_case_source (FFE_caseNONE);
      else if (strcmp (&opt[2], "symbol-case-initcap") == 0)
	ffe_set_case_symbol (FFE_caseINITCAP);
      else if (strcmp (&opt[2], "symbol-case-upper") == 0)
	ffe_set_case_symbol (FFE_caseUPPER);
      else if (strcmp (&opt[2], "symbol-case-lower") == 0)
	ffe_set_case_symbol (FFE_caseLOWER);
      else if (strcmp (&opt[2], "symbol-case-any") == 0)
	ffe_set_case_symbol (FFE_caseNONE);
      else if (strcmp (&opt[2], "case-strict-upper") == 0)
	{
	  ffe_set_case_intrin (FFE_caseUPPER);
	  ffe_set_case_match (FFE_caseUPPER);
	  ffe_set_case_source (FFE_caseNONE);
	  ffe_set_case_symbol (FFE_caseUPPER);
	}
      else if (strcmp (&opt[2], "case-strict-lower") == 0)
	{
	  ffe_set_case_intrin (FFE_caseLOWER);
	  ffe_set_case_match (FFE_caseLOWER);
	  ffe_set_case_source (FFE_caseNONE);
	  ffe_set_case_symbol (FFE_caseLOWER);
	}
      else if (strcmp (&opt[2], "case-initcap") == 0)
	{
	  ffe_set_case_intrin (FFE_caseINITCAP);
	  ffe_set_case_match (FFE_caseINITCAP);
	  ffe_set_case_source (FFE_caseNONE);
	  ffe_set_case_symbol (FFE_caseINITCAP);
	}
      else if (strcmp (&opt[2], "case-upper") == 0)
	{
	  ffe_set_case_intrin (FFE_caseNONE);
	  ffe_set_case_match (FFE_caseNONE);
	  ffe_set_case_source (FFE_caseUPPER);
	  ffe_set_case_symbol (FFE_caseNONE);
	}
      else if (strcmp (&opt[2], "case-lower") == 0)
	{
	  ffe_set_case_intrin (FFE_caseNONE);
	  ffe_set_case_match (FFE_caseNONE);
	  ffe_set_case_source (FFE_caseLOWER);
	  ffe_set_case_symbol (FFE_caseNONE);
	}
      else if (strcmp (&opt[2], "case-preserve") == 0)
	{
	  ffe_set_case_intrin (FFE_caseNONE);
	  ffe_set_case_match (FFE_caseNONE);
	  ffe_set_case_source (FFE_caseNONE);
	  ffe_set_case_symbol (FFE_caseNONE);
	}
      else if (strcmp (&opt[2], "badu77-intrinsics-delete") == 0)
	ffe_set_intrinsic_state_badu77 (FFE_intrinsicstateDELETED);
      else if (strcmp (&opt[2], "badu77-intrinsics-hide") == 0)
	ffe_set_intrinsic_state_badu77 (FFE_intrinsicstateHIDDEN);
      else if (strcmp (&opt[2], "badu77-intrinsics-disable") == 0)
	ffe_set_intrinsic_state_badu77 (FFE_intrinsicstateDISABLED);
      else if (strcmp (&opt[2], "badu77-intrinsics-enable") == 0)
	ffe_set_intrinsic_state_badu77 (FFE_intrinsicstateENABLED);
      else if (strcmp (&opt[2], "gnu-intrinsics-delete") == 0)
	ffe_set_intrinsic_state_gnu (FFE_intrinsicstateDELETED);
      else if (strcmp (&opt[2], "gnu-intrinsics-hide") == 0)
	ffe_set_intrinsic_state_gnu (FFE_intrinsicstateHIDDEN);
      else if (strcmp (&opt[2], "gnu-intrinsics-disable") == 0)
	ffe_set_intrinsic_state_gnu (FFE_intrinsicstateDISABLED);
      else if (strcmp (&opt[2], "gnu-intrinsics-enable") == 0)
	ffe_set_intrinsic_state_gnu (FFE_intrinsicstateENABLED);
      else if (strcmp (&opt[2], "f2c-intrinsics-delete") == 0)
	ffe_set_intrinsic_state_f2c (FFE_intrinsicstateDELETED);
      else if (strcmp (&opt[2], "f2c-intrinsics-hide") == 0)
	ffe_set_intrinsic_state_f2c (FFE_intrinsicstateHIDDEN);
      else if (strcmp (&opt[2], "f2c-intrinsics-disable") == 0)
	ffe_set_intrinsic_state_f2c (FFE_intrinsicstateDISABLED);
      else if (strcmp (&opt[2], "f2c-intrinsics-enable") == 0)
	ffe_set_intrinsic_state_f2c (FFE_intrinsicstateENABLED);
      else if (strcmp (&opt[2], "f90-intrinsics-delete") == 0)
	ffe_set_intrinsic_state_f90 (FFE_intrinsicstateDELETED);
      else if (strcmp (&opt[2], "f90-intrinsics-hide") == 0)
	ffe_set_intrinsic_state_f90 (FFE_intrinsicstateHIDDEN);
      else if (strcmp (&opt[2], "f90-intrinsics-disable") == 0)
	ffe_set_intrinsic_state_f90 (FFE_intrinsicstateDISABLED);
      else if (strcmp (&opt[2], "f90-intrinsics-enable") == 0)
	ffe_set_intrinsic_state_f90 (FFE_intrinsicstateENABLED);
      else if (strcmp (&opt[2], "mil-intrinsics-delete") == 0)
	ffe_set_intrinsic_state_mil (FFE_intrinsicstateDELETED);
      else if (strcmp (&opt[2], "mil-intrinsics-hide") == 0)
	ffe_set_intrinsic_state_mil (FFE_intrinsicstateHIDDEN);
      else if (strcmp (&opt[2], "mil-intrinsics-disable") == 0)
	ffe_set_intrinsic_state_mil (FFE_intrinsicstateDISABLED);
      else if (strcmp (&opt[2], "mil-intrinsics-enable") == 0)
	ffe_set_intrinsic_state_mil (FFE_intrinsicstateENABLED);
      else if (strcmp (&opt[2], "unix-intrinsics-delete") == 0)
	ffe_set_intrinsic_state_unix (FFE_intrinsicstateDELETED);
      else if (strcmp (&opt[2], "unix-intrinsics-hide") == 0)
	ffe_set_intrinsic_state_unix (FFE_intrinsicstateHIDDEN);
      else if (strcmp (&opt[2], "unix-intrinsics-disable") == 0)
	ffe_set_intrinsic_state_unix (FFE_intrinsicstateDISABLED);
      else if (strcmp (&opt[2], "unix-intrinsics-enable") == 0)
	ffe_set_intrinsic_state_unix (FFE_intrinsicstateENABLED);
      else if (strcmp (&opt[2], "vxt-intrinsics-delete") == 0)
	ffe_set_intrinsic_state_vxt (FFE_intrinsicstateDELETED);
      else if (strcmp (&opt[2], "vxt-intrinsics-hide") == 0)