diff options
Diffstat (limited to 'contrib/gcc/f/global.c')
| -rw-r--r-- | contrib/gcc/f/global.c | 1593 |
1 files changed, 0 insertions, 1593 deletions
diff --git a/contrib/gcc/f/global.c b/contrib/gcc/f/global.c deleted file mode 100644 index 85311f186017..000000000000 --- a/contrib/gcc/f/global.c +++ /dev/null @@ -1,1593 +0,0 @@ -/* global.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: - - Description: - Manages information kept across individual program units within a single - source file. This includes reporting errors when a name is defined - multiple times (for example, two program units named FOO) and when a - COMMON block is given initial data in more than one program unit. - - Modifications: -*/ - -/* Include files. */ - -#include "proj.h" -#include "global.h" -#include "info.h" -#include "lex.h" -#include "malloc.h" -#include "name.h" -#include "symbol.h" -#include "top.h" - -/* Externals defined here. */ - - -/* Simple definitions and enumerations. */ - - -/* Internal typedefs. */ - - -/* Private include files. */ - - -/* Internal structure definitions. */ - - -/* Static objects accessed by functions in this module. */ - -#if FFEGLOBAL_ENABLED -static ffenameSpace ffeglobal_filewide_ = NULL; -static const char *ffeglobal_type_string_[] = -{ - [FFEGLOBAL_typeNONE] "??", - [FFEGLOBAL_typeMAIN] "main program", - [FFEGLOBAL_typeEXT] "external", - [FFEGLOBAL_typeSUBR] "subroutine", - [FFEGLOBAL_typeFUNC] "function", - [FFEGLOBAL_typeBDATA] "block data", - [FFEGLOBAL_typeCOMMON] "common block", - [FFEGLOBAL_typeANY] "?any?" -}; -#endif - -/* Static functions (internal). */ - - -/* Internal macros. */ - - -/* Call given fn with all globals - - ffeglobal (*fn)(ffeglobal g); - ffeglobal_drive(fn); */ - -#if FFEGLOBAL_ENABLED -void -ffeglobal_drive (ffeglobal (*fn) (ffeglobal)) -{ - if (ffeglobal_filewide_ != NULL) - ffename_space_drive_global (ffeglobal_filewide_, fn); -} - -#endif -/* ffeglobal_new_ -- Make new global - - ffename n; - ffeglobal g; - g = ffeglobal_new_(n); */ - -#if FFEGLOBAL_ENABLED -static ffeglobal -ffeglobal_new_ (ffename n) -{ - ffeglobal g; - - assert (n != NULL); - - g = (ffeglobal) malloc_new_ks (malloc_pool_image (), "FFEGLOBAL", - sizeof (*g)); - g->n = n; -#ifdef FFECOM_globalHOOK - g->hook = FFECOM_globalNULL; -#endif - g->tick = 0; - - ffename_set_global (n, g); - - return g; -} - -#endif -/* ffeglobal_init_1 -- Initialize per file - - ffeglobal_init_1(); */ - -void -ffeglobal_init_1 () -{ -#if FFEGLOBAL_ENABLED - if (ffeglobal_filewide_ != NULL) - ffename_space_kill (ffeglobal_filewide_); - ffeglobal_filewide_ = ffename_space_new (malloc_pool_image ()); -#endif -} - -/* ffeglobal_init_common -- Initial value specified for common block - - ffesymbol s; // the ffesymbol for the common block - ffelexToken t; // the token with the point of initialization - ffeglobal_init_common(s,t); - - For back ends where file-wide global symbols are not maintained, does - nothing. Otherwise, makes sure this common block hasn't already been - initialized in a previous program unit, and flag that it's been - initialized in this one. */ - -void -ffeglobal_init_common (ffesymbol s, ffelexToken t) -{ -#if FFEGLOBAL_ENABLED - ffeglobal g; - - g = ffesymbol_global (s); - - if ((g == NULL) || (g->type != FFEGLOBAL_typeCOMMON)) - return; - if (g->type == FFEGLOBAL_typeANY) - return; - - if (g->tick == ffe_count_2) - return; - - if (g->tick != 0) - { - if (g->u.common.initt != NULL) - { - ffebad_start (FFEBAD_COMMON_ALREADY_INIT); - ffebad_string (ffesymbol_text (s)); - ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t)); - ffebad_here (1, ffelex_token_where_line (g->u.common.initt), - ffelex_token_where_column (g->u.common.initt)); - ffebad_finish (); - } - - /* Complain about just one attempt to reinit per program unit, but - continue referring back to the first such successful attempt. */ - } - else - { - if (g->u.common.blank) - { - /* Not supposed to initialize blank common, though it works. */ - ffebad_start (FFEBAD_COMMON_BLANK_INIT); - ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t)); - ffebad_finish (); - } - - g->u.common.initt = ffelex_token_use (t); - } - - g->tick = ffe_count_2; -#endif -} - -/* ffeglobal_new_common -- New common block - - ffesymbol s; // the ffesymbol for the new common block - ffelexToken t; // the token with the name of the common block - bool blank; // TRUE if blank common - ffeglobal_new_common(s,t,blank); - - For back ends where file-wide global symbols are not maintained, does - nothing. Otherwise, makes sure this symbol hasn't been seen before or - is known as a common block. */ - -void -ffeglobal_new_common (ffesymbol s, ffelexToken t, bool blank) -{ -#if FFEGLOBAL_ENABLED - ffename n; - ffeglobal g; - - if (ffesymbol_global (s) == NULL) - { - n = ffename_find (ffeglobal_filewide_, t); - g = ffename_global (n); - } - else - { - g = ffesymbol_global (s); - n = NULL; - } - - if ((g != NULL) && (g->type == FFEGLOBAL_typeANY)) - return; - - if ((g != NULL) && (g->type != FFEGLOBAL_typeNONE)) - { - if (g->type == FFEGLOBAL_typeCOMMON) - { - /* The names match, so the "blankness" should match too! */ - assert (g->u.common.blank == blank); - } - else - { - /* This global name has already been established, - but as something other than a common block. */ - if (ffe_is_globals () || ffe_is_warn_globals ()) - { - ffebad_start (ffe_is_globals () - ? FFEBAD_FILEWIDE_ALREADY_SEEN - : FFEBAD_FILEWIDE_ALREADY_SEEN_W); - ffebad_string (ffelex_token_text (t)); - ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t)); - ffebad_here (1, ffelex_token_where_line (g->t), - ffelex_token_where_column (g->t)); - ffebad_finish (); - } - g->type = FFEGLOBAL_typeANY; - } - } - else - { - if (g == NULL) - { - g = ffeglobal_new_ (n); - g->intrinsic = FALSE; - } - else if (g->intrinsic - && !g->explicit_intrinsic - && ffe_is_warn_globals ()) - { - /* Common name previously used as intrinsic. Though it works, - warn, because the intrinsic reference might have been intended - as a ref to an external procedure, but g77's vast list of - intrinsics happened to snarf the name. */ - ffebad_start (FFEBAD_INTRINSIC_GLOBAL); - ffebad_string (ffelex_token_text (t)); - ffebad_string ("common block"); - ffebad_string ("intrinsic"); - ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t)); - ffebad_here (1, ffelex_token_where_line (g->t), - ffelex_token_where_column (g->t)); - ffebad_finish (); - } - g->t = ffelex_token_use (t); - g->type = FFEGLOBAL_typeCOMMON; - g->u.common.have_pad = FALSE; - g->u.common.have_save = FALSE; - g->u.common.have_size = FALSE; - g->u.common.blank = blank; - } - - ffesymbol_set_global (s, g); -#endif -} - -/* ffeglobal_new_progunit_ -- New program unit - - ffesymbol s; // the ffesymbol for the new unit - ffelexToken t; // the token with the name of the unit - ffeglobalType type; // the type of the new unit - ffeglobal_new_progunit_(s,t,type); - - For back ends where file-wide global symbols are not maintained, does - nothing. Otherwise, makes sure this symbol hasn't been seen before. */ - -void -ffeglobal_new_progunit_ (ffesymbol s, ffelexToken t, ffeglobalType type) -{ -#if FFEGLOBAL_ENABLED - ffename n; - ffeglobal g; - - n = ffename_find (ffeglobal_filewide_, t); - g = ffename_global (n); - if ((g != NULL) && (g->type == FFEGLOBAL_typeANY)) - return; - - if ((g != NULL) - && ((g->type == FFEGLOBAL_typeMAIN) - || (g->type == FFEGLOBAL_typeSUBR) - || (g->type == FFEGLOBAL_typeFUNC) - || (g->type == FFEGLOBAL_typeBDATA)) - && g->u.proc.defined) - { - /* This program unit has already been defined. */ - if (ffe_is_globals () || ffe_is_warn_globals ()) - { - ffebad_start (ffe_is_globals () - ? FFEBAD_FILEWIDE_ALREADY_SEEN - : FFEBAD_FILEWIDE_ALREADY_SEEN_W); - ffebad_string (ffelex_token_text (t)); - ffebad_here (0, ffelex_token_where_line (t), - ffelex_token_where_column (t)); - ffebad_here (1, ffelex_token_where_line (g->t), - ffelex_token_where_column (g->t)); - ffebad_finish (); - } - g->type = FFEGLOBAL_typeANY; - } - else if ((g != NULL) - && (g->type != FFEGLOBAL_typeNONE) - && (g->type != FFEGLOBAL_typeEXT) - && (g->type != type)) - { - /* A reference to this program unit has been seen, but its - context disagrees about the new definition regarding - what kind of program unit it is. (E.g. `call foo' followed - by `function foo'.) But `external foo' alone doesn't mean - disagreement with either a function or subroutine, though - g77 normally interprets it as a request to force-load - a block data program unit by that name (to cope with libs). */ - if (ffe_is_globals () || ffe_is_warn_globals ()) - { - ffebad_start (ffe_is_globals () - ? FFEBAD_FILEWIDE_DISAGREEMENT - : FFEBAD_FILEWIDE_DISAGREEMENT_W); - ffebad_string (ffelex_token_text (t)); - ffebad_string (ffeglobal_type_string_[type]); - ffebad_string (ffeglobal_type_string_[g->type]); - ffebad_here (0, ffelex_token_where_line (t), - ffelex_token_where_column (t)); - ffebad_here (1, ffelex_token_where_line (g->t), - ffelex_token_where_column (g->t)); - ffebad_finish (); - } - g->type = FFEGLOBAL_typeANY; - } - else - { - if (g == NULL) - { - g = ffeglobal_new_ (n); - g->intrinsic = FALSE; - g->u.proc.n_args = -1; - g->u.proc.other_t = NULL; - } - else if ((ffesymbol_basictype (s) != FFEINFO_basictypeNONE) - && (g->type == FFEGLOBAL_typeFUNC) - && ((ffesymbol_basictype (s) != g->u.proc.bt) - || (ffesymbol_kindtype (s) != g->u.proc.kt) - || ((ffesymbol_size (s) != FFETARGET_charactersizeNONE) - && (ffesymbol_size (s) != g->u.proc.sz)))) - { - /* The previous reference and this new function definition - disagree about the type of the function. I (Burley) think - this rarely occurs, because when this code is reached, - the type info doesn't appear to be filled in yet. */ - if (ffe_is_globals () || ffe_is_warn_globals ()) - { - ffebad_start (ffe_is_globals () - ? FFEBAD_FILEWIDE_TYPE_MISMATCH - : FFEBAD_FILEWIDE_TYPE_MISMATCH_W); - ffebad_string (ffelex_token_text (t)); - ffebad_here (0, ffelex_token_where_line (t), - ffelex_token_where_column (t)); - ffebad_here (1, ffelex_token_where_line (g->t), - ffelex_token_where_column (g->t)); - ffebad_finish (); - } - g->type = FFEGLOBAL_typeANY; - return; - } - if (g->intrinsic - && !g->explicit_intrinsic - && ffe_is_warn_globals ()) - { - /* This name, previously used as an intrinsic, now is known - to also be a global procedure name. Warn, since the previous - use as an intrinsic might have been intended to refer to - this procedure. */ - ffebad_start (FFEBAD_INTRINSIC_GLOBAL); - ffebad_string (ffelex_token_text (t)); - ffebad_string ("global"); - ffebad_string ("intrinsic"); - ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t)); - ffebad_here (1, ffelex_token_where_line (g->t), - ffelex_token_where_column (g->t)); - ffebad_finish (); - } - g->t = ffelex_token_use (t); - if ((g->tick == 0) - || (g->u.proc.bt == FFEINFO_basictypeNONE) - || (g->u.proc.kt == FFEINFO_kindtypeNONE)) - { - g->u.proc.bt = ffesymbol_basictype (s); - g->u.proc.kt = ffesymbol_kindtype (s); - g->u.proc.sz = ffesymbol_size (s); - } - /* If there's a known disagreement about the kind of program - unit, then don't even bother tracking arglist argreement. */ - if ((g->tick != 0) - && (g->type != type)) - g->u.proc.n_args = -1; - g->tick = ffe_count_2; - g->type = type; - g->u.proc.defined = TRUE; - } - - ffesymbol_set_global (s, g); -#endif -} - -/* ffeglobal_pad_common -- Check initial padding of common area - - ffesymbol s; // the common area - ffetargetAlign pad; // the initial padding - ffeglobal_pad_common(s,pad,ffesymbol_where_line(s), - ffesymbol_where_column(s)); - - In global-enabled mode, make sure the padding agrees with any existing - padding established for the common area, otherwise complain. - In global-disabled mode, warn about nonzero padding. */ - -void -ffeglobal_pad_common (ffesymbol s, ffetargetAlign pad, ffewhereLine wl, - ffewhereColumn wc) -{ -#if FFEGLOBAL_ENABLED - ffeglobal g; - - g = ffesymbol_global (s); - if ((g == NULL) || (g->type != FFEGLOBAL_typeCOMMON)) - return; /* Let someone else catch this! */ - if (g->type == FFEGLOBAL_typeANY) - return; - - if (!g->u.common.have_pad) - { - g->u.common.have_pad = TRUE; - g->u.common.pad = pad; - g->u.common.pad_where_line = ffewhere_line_use (wl); - g->u.common.pad_where_col = ffewhere_column_use (wc); - - if (pad != 0) - { - char padding[20]; - - sprintf (&padding[0], "%" ffetargetAlign_f "u", pad); - ffebad_start (FFEBAD_COMMON_INIT_PAD); - ffebad_string (ffesymbol_text (s)); - ffebad_string (padding); - ffebad_string ((pad == 1) - ? FFECOM_SIZE_UNIT : FFECOM_SIZE_UNITS); - ffebad_here (0, wl, wc); - ffebad_finish (); - } - } - else - { - if (g->u.common.pad != pad) - { - char padding_1[20]; - char padding_2[20]; - - sprintf (&padding_1[0], "%" ffetargetAlign_f "u", pad); - sprintf (&padding_2[0], "%" ffetargetAlign_f "u", g->u.common.pad); - ffebad_start (FFEBAD_COMMON_DIFF_PAD); - ffebad_string (ffesymbol_text (s)); - ffebad_string (padding_1); - ffebad_here (0, wl, wc); - ffebad_string (padding_2); - ffebad_string ((pad == 1) - ? FFECOM_SIZE_UNIT : FFECOM_SIZE_UNITS); - ffebad_string ((g->u.common.pad == 1) - ? FFECOM_SIZE_UNIT : FFECOM_SIZE_UNITS); - ffebad_here (1, g->u.common.pad_where_line, g->u.common.pad_where_col); - ffebad_finish (); - } - - if (g->u.common.pad < pad) - { - g->u.common.pad = pad; - g->u.common.pad_where_line = ffewhere_line_use (wl); - g->u.common.pad_where_col = ffewhere_column_use (wc); - } - } -#endif -} - -/* Collect info for a global's argument. */ - -void -ffeglobal_proc_def_arg (ffesymbol s, int argno, const char *name, ffeglobalArgSummary as, - ffeinfoBasictype bt, ffeinfoKindtype kt, - bool array) -{ - ffeglobal g = ffesymbol_global (s); - ffeglobalArgInfo_ ai; - - assert (g != NULL); - - if (g->type == FFEGLOBAL_typeANY) - return; - - assert (g->u.proc.n_args >= 0); - - if (argno >= g->u.proc.n_args) - return; /* Already complained about this discrepancy. */ - - ai = &g->u.proc.arg_info[argno]; - - /* Maybe warn about previous references. */ - - if ((ai->t != NULL) - && ffe_is_warn_globals ()) - { - const char *refwhy = NULL; - const char *defwhy = NULL; - bool warn = FALSE; - - switch (as) - { - case FFEGLOBAL_argsummaryREF: - if ((ai->as != FFEGLOBAL_argsummaryREF) - && (ai->as != FFEGLOBAL_argsummaryNONE) - && ((ai->as != FFEGLOBAL_argsummaryDESCR) /* Choose better message. */ - || (ai->bt != FFEINFO_basictypeCHARACTER) - || (ai->bt == bt))) - { - warn = TRUE; - refwhy = "passed by reference"; - } - break; - - case FFEGLOBAL_argsummaryDESCR: - if ((ai->as != FFEGLOBAL_argsummaryDESCR) - && (ai->as != FFEGLOBAL_argsummaryNONE) - && ((ai->as != FFEGLOBAL_argsummaryREF) /* Choose better message. */ - || (bt != FFEINFO_basictypeCHARACTER) - || (ai->bt == bt))) - { - warn = TRUE; - refwhy = "passed by descriptor"; - } - break; - - case FFEGLOBAL_argsummaryPROC: - if ((ai->as != FFEGLOBAL_argsummaryPROC) - && (ai->as != FFEGLOBAL_argsummarySUBR) - && (ai->as != FFEGLOBAL_argsummaryFUNC) - && (ai->as != FFEGLOBAL_argsummaryNONE)) - { - warn = TRUE; - refwhy = "a procedure"; - } - break; - - case FFEGLOBAL_argsummarySUBR: - if ((ai->as != FFEGLOBAL_argsummaryPROC) - && (ai->as != FFEGLOBAL_argsummarySUBR) - && (ai->as != FFEGLOBAL_argsummaryNONE)) - { - warn = TRUE; - refwhy = "a subroutine"; - } - break; - - case FFEGLOBAL_argsummaryFUNC: - if ((ai->as != FFEGLOBAL_argsummaryPROC) - && (ai->as != FFEGLOBAL_argsummaryFUNC) - && (ai->as != FFEGLOBAL_argsummaryNONE)) - { - warn = TRUE; - refwhy = "a function"; - } - break; - - case FFEGLOBAL_argsummaryALTRTN: - if ((ai->as != FFEGLOBAL_argsummaryALTRTN) - && (ai->as != FFEGLOBAL_argsummaryNONE)) - { - warn = TRUE; - refwhy = "an alternate-return label"; - } - break; - - default: - break; - } - - if ((refwhy != NULL) && (defwhy == NULL)) - { - /* Fill in the def info. */ - - switch (ai->as) - { - case FFEGLOBAL_argsummaryNONE: - defwhy = "omitted"; - break; - - case FFEGLOBAL_argsummaryVAL: - defwhy = "passed by value"; - break; - - case FFEGLOBAL_argsummaryREF: - defwhy = "passed by reference"; - break; - - case FFEGLOBAL_argsummaryDESCR: - defwhy = "passed by descriptor"; - break; - - case FFEGLOBAL_argsummaryPROC: - defwhy = "a procedure"; - break; - - case FFEGLOBAL_argsummarySUBR: - defwhy = "a subroutine"; - break; - - case FFEGLOBAL_argsummaryFUNC: - defwhy = "a function"; - break; - - case FFEGLOBAL_argsummaryALTRTN: - defwhy = "an alternate-return label"; - break; - -#if 0 - case FFEGLOBAL_argsummaryPTR: - defwhy = "a pointer"; - break; -#endif - - default: - defwhy = "???"; - break; - } - } - - if (!warn - && (bt != FFEINFO_basictypeHOLLERITH) - && (bt != FFEINFO_basictypeTYPELESS) - && (bt != FFEINFO_basictypeNONE) - && (ai->bt != FFEINFO_basictypeHOLLERITH) - && (ai->bt != FFEINFO_basictypeTYPELESS) - && (ai->bt != FFEINFO_basictypeNONE)) - { - /* Check types. */ - - if ((bt != ai->bt) - && ((bt != FFEINFO_basictypeREAL) - || (ai->bt != FFEINFO_basictypeCOMPLEX)) - && ((bt != FFEINFO_basictypeCOMPLEX) - || (ai->bt != FFEINFO_basictypeREAL))) - { - warn = TRUE; /* We can cope with these differences. */ - refwhy = "one type"; - defwhy = "some other type"; - } - - if (!warn && (kt != ai->kt)) - { - warn = TRUE; - refwhy = "one precision"; - defwhy = "some other precision"; - } - } - - if (warn) - { - char num[60]; - - if (name == NULL) - sprintf (&num[0], "%d", argno + 1); - else - { - if (strlen (name) < 30) - sprintf (&num[0], "%d (named `%s')", argno + 1, name); - else - sprintf (&num[0], "%d (named `%.*s...')", argno + 1, 30, name); - } - ffebad_start (FFEBAD_FILEWIDE_ARG_W); - ffebad_string (ffesymbol_text (s)); - ffebad_string (num); - ffebad_string (refwhy); - ffebad_string (defwhy); - ffebad_here (0, ffelex_token_where_line (g->t), ffelex_token_where_column (g->t)); - ffebad_here (1, ffelex_token_where_line (ai->t), ffelex_token_where_column (ai->t)); - ffebad_finish (); - } - } - - /* Define this argument. */ - - if (ai->t != NULL) - ffelex_token_kill (ai->t); - if ((as != FFEGLOBAL_argsummaryPROC) - || (ai->t == NULL)) - ai->as = as; /* Otherwise leave SUBR/FUNC info intact. */ - ai->t = ffelex_token_use (g->t); - if (name == NULL) - ai->name = NULL; - else - { - ai->name = malloc_new_ks (malloc_pool_image (), - "ffeglobalArgInfo_ name", - strlen (name) + 1); - strcpy (ai->name, name); - } - ai->bt = bt; - ai->kt = kt; - ai->array = array; -} - -/* Collect info on #args a global accepts. */ - -void -ffeglobal_proc_def_nargs (ffesymbol s, int n_args) -{ - ffeglobal g = ffesymbol_global (s); - - assert (g != NULL); - - if (g->type == FFEGLOBAL_typeANY) - return; - - if (g->u.proc.n_args >= 0) - { - if (g->u.proc.n_args == n_args) - return; - - if (ffe_is_warn_globals ()) - { - ffebad_start (FFEBAD_FILEWIDE_NARGS_W); - ffebad_string (ffesymbol_text (s)); - if (g->u.proc.n_args > n_args) - ffebad_string ("few"); - else - ffebad_string ("many"); - ffebad_here (0, ffelex_token_where_line (g->u.proc.other_t), - ffelex_token_where_column (g->u.proc.other_t)); - ffebad_here (1, ffelex_token_where_line (g->t), - ffelex_token_where_column (g->t)); - ffebad_finish (); - } - } - - /* This is new info we can use in cross-checking future references - and a possible future definition. */ - - g->u.proc.n_args = n_args; - g->u.proc.other_t = NULL; /* No other reference yet. */ - - if (n_args == 0) - { - g->u.proc.arg_info = NULL; - return; - } - - g->u.proc.arg_info - = (ffeglobalArgInfo_) malloc_new_ks (malloc_pool_image (), - "ffeglobalArgInfo_", - n_args * sizeof (g->u.proc.arg_info[0])); - while (n_args-- > 0) - g->u.proc.arg_info[n_args].t = NULL; -} - -/* Verify that the info for a global's argument is valid. */ - -bool -ffeglobal_proc_ref_arg (ffesymbol s, int argno, ffeglobalArgSummary as, - ffeinfoBasictype bt, ffeinfoKindtype kt, - bool array, ffelexToken t) -{ - ffeglobal g = ffesymbol_global (s); - ffeglobalArgInfo_ ai; - - assert (g != NULL); - - if (g->type == FFEGLOBAL_typeANY) - return FALSE; - - assert (g->u.proc.n_args >= 0); - - if (argno >= g->u.proc.n_args) - return TRUE; /* Already complained about this discrepancy. */ - - ai = &g->u.proc.arg_info[argno]; - - /* Warn about previous references. */ - - if (ai->t != NULL) - { - const char *refwhy = NULL; - const char *defwhy = NULL; - bool fail = FALSE; - bool warn = FALSE; - - switch (as) - { - case FFEGLOBAL_argsummaryNONE: - if (g->u.proc.defined) - { - fail = TRUE; - refwhy = "omitted"; - defwhy = "not optional"; - } - break; - - case FFEGLOBAL_argsummaryVAL: - if (ai->as != FFEGLOBAL_argsummaryVAL) - { - fail = TRUE; - refwhy = "passed by value"; - } - break; - - case FFEGLOBAL_argsummaryREF: - if ((ai->as != FFEGLOBAL_argsummaryREF) - && (ai->as != FFEGLOBAL_argsummaryNONE) - && ((ai->as != FFEGLOBAL_argsummaryDESCR) /* Choose better message. */ - || (ai->bt != FFEINFO_basictypeCHARACTER) - || (ai->bt == bt))) - { - fail = TRUE; - refwhy = "passed by reference"; - } - break; - - case FFEGLOBAL_argsummaryDESCR: - if ((ai->as != FFEGLOBAL_argsummaryDESCR) - && (ai->as != FFEGLOBAL_argsummaryNONE) - && ((ai->as != FFEGLOBAL_argsummaryREF) /* Choose better message. */ - || (bt != FFEINFO_basictypeCHARACTER) - || (ai->bt == bt))) - { - fail = TRUE; - refwhy = "passed by descriptor"; - } - break; - - case FFEGLOBAL_argsummaryPROC: - if ((ai->as != FFEGLOBAL_argsummaryPROC) - && (ai->as != FFEGLOBAL_argsummarySUBR) - && (ai->as != FFEGLOBAL_argsummaryFUNC) - && (ai->as != FFEGLOBAL_argsummaryNONE)) - { - fail = TRUE; - refwhy = "a procedure"; - } - break; - - case FFEGLOBAL_argsummarySUBR: - if ((ai->as != FFEGLOBAL_argsummaryPROC) - && (ai->as != FFEGLOBAL_argsummarySUBR) - && (ai->as != FFEGLOBAL_argsummaryNONE)) - { - fail = TRUE; - refwhy = "a subroutine"; - } - break; - - case FFEGLOBAL_argsummaryFUNC: - if ((ai->as != FFEGLOBAL_argsummaryPROC) - && (ai->as != FFEGLOBAL_argsummaryFUNC) - && (ai->as != FFEGLOBAL_argsummaryNONE)) - { - fail = TRUE; - refwhy = "a function"; - } - break; - - case FFEGLOBAL_argsummaryALTRTN: - if ((ai->as != FFEGLOBAL_argsummaryALTRTN) - && (ai->as != FFEGLOBAL_argsummaryNONE)) - { - fail = TRUE; - refwhy = "an alternate-return label"; - } - break; - -#if 0 - case FFEGLOBAL_argsummaryPTR: - if ((ai->as != FFEGLOBAL_argsummaryPTR) - && (ai->as != FFEGLOBAL_argsummaryNONE)) - { - fail = TRUE; - refwhy = "a pointer"; - } - break; -#endif - - default: - break; - } - - if ((refwhy != NULL) && (defwhy == NULL)) - { - /* Fill in the def info. */ - - switch (ai->as) - { - case FFEGLOBAL_argsummaryNONE: - defwhy = "omitted"; - break; - - case FFEGLOBAL_argsummaryVAL: - defwhy = "passed by value"; - break; - - case FFEGLOBAL_argsummaryREF: - defwhy = "passed by reference"; - break; - - case FFEGLOBAL_argsummaryDESCR: - defwhy = "passed by descriptor"; - break; - - case FFEGLOBAL_argsummaryPROC: - defwhy = "a procedure"; - break; - - case FFEGLOBAL_argsummarySUBR: - defwhy = "a subroutine"; - break; - - case FFEGLOBAL_argsummaryFUNC: - defwhy = "a function"; - break; - - case FFEGLOBAL_argsummaryALTRTN: - defwhy = "an alternate-return label"; - break; - -#if 0 - case FFEGLOBAL_argsummaryPTR: - defwhy = "a pointer"; - break; -#endif - - default: - defwhy = "???"; - break; - } - } - - if (!fail && !warn - && (bt != FFEINFO_basictypeHOLLERITH) - && (bt != FFEINFO_basictypeTYPELESS) - && (bt != FFEINFO_basictypeNONE) - && (ai->bt != FFEINFO_basictypeHOLLERITH) - && (ai->bt != FFEINFO_basictypeNONE) - && (ai->bt != FFEINFO_basictypeTYPELESS)) - { - /* Check types. */ - - if ((bt != ai->bt) - && ((bt != FFEINFO_basictypeREAL) - || (ai->bt != FFEINFO_basictypeCOMPLEX)) - && ((bt != FFEINFO_basictypeCOMPLEX) - || (ai->bt != FFEINFO_basictypeREAL))) - { - if (((bt == FFEINFO_basictypeINTEGER) - && (ai->bt == FFEINFO_basictypeLOGICAL)) - || ((bt == FFEINFO_basictypeLOGICAL) - && (ai->bt == FFEINFO_basictypeINTEGER))) - warn = TRUE; /* We can cope with these differences. */ - else - fail = TRUE; - refwhy = "one type"; - defwhy = "some other type"; - } - - if (!fail && !warn && (kt != ai->kt)) - { - fail = TRUE; - refwhy = "one precision"; - defwhy = "some other precision"; - } - } - - if (fail && ! g->u.proc.defined) - { - /* No point failing if we're worried only about invocations. */ - fail = FALSE; - warn = TRUE; - } - - if (fail && ! ffe_is_globals ()) - { - warn = TRUE; - fail = FALSE; - } - - if (fail || (warn && ffe_is_warn_globals ())) - { - char num[60]; - - if (ai->name == NULL) - sprintf (&num[0], "%d", argno + 1); - else - { - if (strlen (ai->name) < 30) - sprintf (&num[0], "%d (named `%s')", argno + 1, ai->name); - else - sprintf (&num[0], "%d (named `%.*s...')", argno + 1, 30, ai->name); - } - ffebad_start (fail ? FFEBAD_FILEWIDE_ARG : FFEBAD_FILEWIDE_ARG_W); - ffebad_string (ffesymbol_text (s)); - ffebad_string (num); - ffebad_string (refwhy); - ffebad_string (defwhy); - ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t)); - ffebad_here (1, ffelex_token_where_line (ai->t), ffelex_token_where_column (ai->t)); - ffebad_finish (); - return (fail ? FALSE : TRUE); - } - - if (warn) - return TRUE; - } - - /* Define this argument. */ - - if (ai->t != NULL) - ffelex_token_kill (ai->t); - if ((as != FFEGLOBAL_argsummaryPROC) - || (ai->t == NULL)) - ai->as = as; - ai->t = ffelex_token_use (g->t); - ai->name = NULL; - ai->bt = bt; - ai->kt = kt; - ai->array = array; - return TRUE; -} - -bool -ffeglobal_proc_ref_nargs (ffesymbol s, int n_args, ffelexToken t) -{ - ffeglobal g = ffesymbol_global (s); - - assert (g != NULL); - - if (g->type == FFEGLOBAL_typeANY) - return FALSE; - - if (g->u.proc.n_args >= 0) - { - if (g->u.proc.n_args == n_args) - return TRUE; - - if (g->u.proc.defined && ffe_is_globals ()) - { - ffebad_start (FFEBAD_FILEWIDE_NARGS); - ffebad_string (ffesymbol_text (s)); - if (g->u.proc.n_args > n_args) - ffebad_string ("few"); - else - ffebad_string ("many"); - ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t)); - ffebad_here (1, ffelex_token_where_line (g->t), - ffelex_token_where_column (g->t)); - ffebad_finish (); - return FALSE; - } - - if (ffe_is_warn_globals ()) - { - ffebad_start (FFEBAD_FILEWIDE_NARGS_W); - ffebad_string (ffesymbol_text (s)); - if (g->u.proc.n_args > n_args) - ffebad_string ("few"); - else - ffebad_string ("many"); - ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t)); - ffebad_here (1, ffelex_token_where_line (g->t), - ffelex_token_where_column (g->t)); - ffebad_finish (); - } - - return TRUE; /* Don't replace the info we already have. */ - } - - /* This is new info we can use in cross-checking future references - and a possible future definition. */ - - g->u.proc.n_args = n_args; - g->u.proc.other_t = ffelex_token_use (t); - - /* Make this "the" place we found the global, since it has the most info. */ - - if (g->t != NULL) - ffelex_token_kill (g->t); - g->t = ffelex_token_use (t); - - if (n_args == 0) - { - g->u.proc.arg_info = NULL; - return TRUE; - } - - g->u.proc.arg_info - = (ffeglobalArgInfo_) malloc_new_ks (malloc_pool_image (), - "ffeglobalArgInfo_", - n_args * sizeof (g->u.proc.arg_info[0])); - while (n_args-- > 0) - g->u.proc.arg_info[n_args].t = NULL; - - return TRUE; -} - -/* Return a global for a promoted symbol (one that has heretofore - been assumed to be local, but since discovered to be global). */ - -ffeglobal -ffeglobal_promoted (ffesymbol s) -{ -#if FFEGLOBAL_ENABLED - ffename n; - ffeglobal g; - - assert (ffesymbol_global (s) == NULL); - - n = ffename_find (ffeglobal_filewide_, ffename_token (ffesymbol_name (s))); - g = ffename_global (n); - - return g; -#else - return NULL; -#endif -} - -/* Register a reference to an intrinsic. Such a reference is always - valid, though a warning might be in order if the same name has - already been used for a global. */ - -void -ffeglobal_ref_intrinsic (ffesymbol s, ffelexToken t, bool explicit) -{ -#if FFEGLOBAL_ENABLED - ffename n; - ffeglobal g; - - if (ffesymbol_global (s) == NULL) - { - n = ffename_find (ffeglobal_filewide_, t); - g = ffename_global (n); - } - else - { - g = ffesymbol_global (s); - n = NULL; - } - - if ((g != NULL) && (g->type == FFEGLOBAL_typeANY)) - return; - - if ((g != NULL) && (g->type != FFEGLOBAL_typeNONE)) - { - if (! explicit - && ! g->intrinsic - && ffe_is_warn_globals ()) - { - /* This name, previously used as a global, now is used - for an intrinsic. Warn, since this new use as an - intrinsic might have been intended to refer to - the global procedure. */ - ffebad_start (FFEBAD_INTRINSIC_GLOBAL); - ffebad_string (ffelex_token_text (t)); - ffebad_string ("intrinsic"); - ffebad_string ("global"); - ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t)); - ffebad_here (1, ffelex_token_where_line (g->t), - ffelex_token_where_column (g->t)); - ffebad_finish (); - } - } - else - { - if (g == NULL) - { - g = ffeglobal_new_ (n); - g->tick = ffe_count_2; - g->type = FFEGLOBAL_typeNONE; - g->intrinsic = TRUE; - g->explicit_intrinsic = explicit; - g->t = ffelex_token_use (t); - } - else if (g->intrinsic - && (explicit != g->explicit_intrinsic) - && (g->tick != ffe_count_2) - && ffe_is_warn_globals ()) - { - /* An earlier reference to this intrinsic disagrees with - this reference vis-a-vis explicit `intrinsic foo', - which suggests that the one relying on implicit - intrinsicacity might have actually intended to refer - to a global of the same name. */ - ffebad_start (FFEBAD_INTRINSIC_EXPIMP); - ffebad_string (ffelex_token_text (t)); - ffebad_string (explicit ? "explicit" : "implicit"); - ffebad_string (explicit ? "implicit" : "explicit"); - ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t)); - ffebad_here (1, ffelex_token_where_line (g->t), - ffelex_token_where_column (g->t)); - ffebad_finish (); - } - } - - g->intrinsic = TRUE; - if (explicit) - g->explicit_intrinsic = TRUE; - - ffesymbol_set_global (s, g); -#endif -} - -/* Register a reference to a global. Returns TRUE if the reference - is valid. */ - -bool -ffeglobal_ref_progunit_ (ffesymbol s, ffelexToken t, ffeglobalType type) -{ -#if FFEGLOBAL_ENABLED - ffename n = NULL; - ffeglobal g; - - /* It is never really _known_ that an EXTERNAL statement - names a BLOCK DATA by just looking at the program unit, - so override a different notion here. */ - if (type == FFEGLOBAL_typeBDATA) - type = FFEGLOBAL_typeEXT; - - g = ffesymbol_global (s); - if (g == NULL) - { - n = ffename_find (ffeglobal_filewide_, t); - g = ffename_global (n); - if (g != NULL) - ffesymbol_set_global (s, g); - } - - if ((g != NULL) && (g->type == FFEGLOBAL_typeANY)) - return TRUE; - - if ((g != NULL) - && (g->type != FFEGLOBAL_typeNONE) - && (g->type != FFEGLOBAL_typeEXT) - && (g->type != type) - && (type != FFEGLOBAL_typeEXT)) - { - /* Disagreement about (fully refined) class of program unit - (main, subroutine, function, block data). Treat EXTERNAL/ - COMMON disagreements distinctly. */ - if ((((type == FFEGLOBAL_typeBDATA) - && (g->type != FFEGLOBAL_typeCOMMON)) - || ((g->type == FFEGLOBAL_typeBDATA) - && (type != FFEGLOBAL_typeCOMMON) - && ! g->u.proc.defined))) - { -#if 0 /* This is likely to just annoy people. */ - if (ffe_is_warn_globals ()) - { - /* Warn about EXTERNAL of a COMMON name, though it works. */ - ffebad_start (FFEBAD_FILEWIDE_TIFF); - ffebad_string (ffelex_token_text (t)); - ffebad_string (ffeglobal_type_string_[type]); - ffebad_string (ffeglobal_type_string_[g->type]); - ffebad_here (0, ffelex_token_where_line (t), - ffelex_token_where_column (t)); - ffebad_here (1, ffelex_token_where_line (g->t), - ffelex_token_where_column (g->t)); - ffebad_finish (); - } -#endif - } - else if (ffe_is_globals () || ffe_is_warn_globals ()) - { - ffebad_start (ffe_is_globals () - ? FFEBAD_FILEWIDE_DISAGREEMENT - : FFEBAD_FILEWIDE_DISAGREEMENT_W); - ffebad_string (ffelex_token_text (t)); - ffebad_string (ffeglobal_type_string_[type]); - ffebad_string (ffeglobal_type_string_[g->type]); - ffebad_here (0, ffelex_token_where_line (t), - ffelex_token_where_column (t)); - ffebad_here (1, ffelex_token_where_line (g->t), - ffelex_token_where_column (g->t)); - ffebad_finish (); - g->type = FFEGLOBAL_typeANY; - return (! ffe_is_globals ()); - } - } - - if ((g != NULL) - && (type == FFEGLOBAL_typeFUNC)) - { - /* If just filling in this function's type, do so. */ - if ((g->tick == ffe_count_2) - && (ffesymbol_basictype (s) != FFEINFO_basictypeNONE) - && (ffesymbol_kindtype (s) != FFEINFO_kindtypeNONE)) - { - g->u.proc.bt = ffesymbol_basictype (s); - g->u.proc.kt = ffesymbol_kindtype (s); - g->u.proc.sz = ffesymbol_size (s); - } - /* Make sure there is type agreement. */ - if (g->type == FFEGLOBAL_typeFUNC - && g->u.proc.bt != FFEINFO_basictypeNONE - && ffesymbol_basictype (s) != FFEINFO_basictypeNONE - && (ffesymbol_basictype (s) != g->u.proc.bt - || ffesymbol_kindtype (s) != g->u.proc.kt - /* CHARACTER*n disagreements matter only once a - definition is involved, since the definition might - be CHARACTER*(*), which accepts all references. */ - || (g->u.proc.defined - && ffesymbol_size (s) != g->u.proc.sz - && ffesymbol_size (s) != FFETARGET_charactersizeNONE - && g->u.proc.sz != FFETARGET_charactersizeNONE))) - { - int error; - - /* Type mismatch between function reference/definition and - this subsequent reference (which might just be the filling-in - of type info for the definition, but we can't reach here - if that's the case and there was a previous definition). - - It's an error given a previous definition, since that - implies inlining can crash the compiler, unless the user - asked for no such inlining. */ - error = (g->tick != ffe_count_2 - && g->u.proc.defined - && ffe_is_globals ()); - if (error || ffe_is_warn_globals ()) - { - ffebad_start (error - ? FFEBAD_FILEWIDE_TYPE_MISMATCH - : FFEBAD_FILEWIDE_TYPE_MISMATCH_W); - ffebad_string (ffelex_token_text (t)); - if (g->tick == ffe_count_2) - { - /* Current reference fills in type info for definition. - The current token doesn't necessarily point to the actual - definition of the function, so use the definition pointer - and the pointer to the pre-definition type info. */ - ffebad_here (0, ffelex_token_where_line (g->t), - ffelex_token_where_column (g->t)); - ffebad_here (1, ffelex_token_where_line (g->u.proc.other_t), - ffelex_token_where_column (g->u.proc.other_t)); - } - else - { - /* Current reference is not a filling-in of a current - definition. The current token is fine, as is - the previous-mention token. */ - ffebad_here (0, ffelex_token_where_line (t), - ffelex_token_where_column (t)); - ffebad_here (1, ffelex_token_where_line (g->t), - ffelex_token_where_column (g->t)); - } - ffebad_finish (); - if (error) - g->type = FFEGLOBAL_typeANY; - return FALSE; - } - } - } - - if (g == NULL) - { - g = ffeglobal_new_ (n); - g->t = ffelex_token_use (t); - g->tick = ffe_count_2; - g->intrinsic = FALSE; - g->type = type; - g->u.proc.defined = FALSE; - g->u.proc.bt = ffesymbol_basictype (s); - g->u.proc.kt = ffesymbol_kindtype (s); - g->u.proc.sz = ffesymbol_size (s); - g->u.proc.n_args = -1; - ffesymbol_set_global (s, g); - } - else if (g->intrinsic - && !g->explicit_intrinsic - && (g->tick != ffe_count_2) - && ffe_is_warn_globals ()) - { - /* Now known as a global, this name previously was seen as an - intrinsic. Warn, in case the previous reference was intended - for the same global. */ - ffebad_start (FFEBAD_INTRINSIC_GLOBAL); - ffebad_string (ffelex_token_text (t)); - ffebad_string ("global"); - ffebad_string ("intrinsic"); - ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t)); - ffebad_here (1, ffelex_token_where_line (g->t), - ffelex_token_where_column (g->t)); - ffebad_finish (); - } - - if ((g->type != type) - && (type != FFEGLOBAL_typeEXT)) - { - /* We've learned more, so point to where we learned it. */ - g->t = ffelex_token_use (t); - g->type = type; -#ifdef FFECOM_globalHOOK - g->hook = FFECOM_globalNULL; /* Discard previous _DECL. */ -#endif - g->u.proc.n_args = -1; - } - - return TRUE; -#endif -} - -/* ffeglobal_save_common -- Check SAVE status of common area - - ffesymbol s; // the common area - bool save; // TRUE if SAVEd, FALSE otherwise - ffeglobal_save_common(s,save,ffesymbol_where_line(s), - ffesymbol_where_column(s)); - - In global-enabled mode, make sure the save info agrees with any existing - info established for the common area, otherwise complain. - In global-disabled mode, do nothing. */ - -void -ffeglobal_save_common (ffesymbol s, bool save, ffewhereLine wl, - ffewhereColumn wc) -{ -#if FFEGLOBAL_ENABLED - ffeglobal g; - - g = ffesymbol_global (s); - if ((g == NULL) || (g->type != FFEGLOBAL_typeCOMMON)) - return; /* Let someone else catch this! */ - if (g->type == FFEGLOBAL_typeANY) - return; - - if (!g->u.common.have_save) - { - g->u.common.have_save = TRUE; - g->u.common.save = save; - g->u.common.save_where_line = ffewhere_line_use (wl); - g->u.common.save_where_col = ffewhere_column_use (wc); - } - else - { - if ((g->u.common.save != save) && ffe_is_pedantic ()) - { - ffebad_start (FFEBAD_COMMON_DIFF_SAVE); - ffebad_string (ffesymbol_text (s)); - ffebad_here (save ? 0 : 1, wl, wc); - ffebad_here (save ? 1 : 0, g->u.common.pad_where_line, g->u.common.pad_where_col); - ffebad_finish (); - } - } -#endif -} - -/* ffeglobal_size_common -- Establish size of COMMON area - - ffesymbol s; // the common area - ffetargetOffset size; // size in units - if (ffeglobal_size_common(s,size)) // new size is largest seen - - In global-enabled mode, set the size if it current size isn't known or is - smaller than new size, and for non-blank common, complain if old size - is different from new. Return TRUE if the new size is the largest seen - for this COMMON area (or if no size was known for it previously). - In global-disabled mode, do nothing. */ - -#if FFEGLOBAL_ENABLED -bool -ffeglobal_size_common (ffesymbol s, ffetargetOffset size) -{ - ffeglobal g; - - g = ffesymbol_global (s); - if ((g == NULL) || (g->type != FFEGLOBAL_typeCOMMON)) - return FALSE; - if (g->type == FFEGLOBAL_typeANY) - return FALSE; - - if (!g->u.common.have_size) - { - g->u.common.have_size = TRUE; - g->u.common.size = size; - return TRUE; - } - - if ((g->tick > 0) && (g->tick < ffe_count_2) - && (g->u.common.size < size)) - { - char oldsize[40]; - char newsize[40]; - - /* Common block initialized in a previous program unit, which - effectively freezes its size, but now the program is trying - to enlarge it. */ - - sprintf (&oldsize[0], "%" ffetargetOffset_f "d", g->u.common.size); - sprintf (&newsize[0], "%" ffetargetOffset_f "d", size); - - ffebad_start (FFEBAD_COMMON_ENLARGED); - ffebad_string (ffesymbol_text (s)); - ffebad_string (oldsize); - ffebad_string (newsize); - ffebad_string ((g->u.common.size == 1) - ? FFECOM_SIZE_UNIT : FFECOM_SIZE_UNITS); - ffebad_string ((size == 1) - ? FFECOM_SIZE_UNIT : FFECOM_SIZE_UNITS); - ffebad_here (0, ffelex_token_where_line (g->u.common.initt), - ffelex_token_where_column (g->u.common.initt)); - ffebad_here (1, ffesymbol_where_line (s), - ffesymbol_where_column (s)); - ffebad_finish (); - } - else if ((g->u.common.size != size) && !g->u.common.blank) - { - char oldsize[40]; - char newsize[40]; - - /* Warn about this even if not -pedantic, because putting all - program units in a single source file is the only way to - detect this. Apparently UNIX-model linkers neither handle - nor report when they make a common unit smaller than - requested, such as when the smaller-declared version is - initialized and the larger-declared version is not. So - if people complain about strange overwriting, we can tell - them to put all their code in a single file and compile - that way. Warnings about differing sizes must therefore - always be issued. */ - - sprintf (&oldsize[0], "%" ffetargetOffset_f "d", g->u.common.size); - sprintf (&newsize[0], "%" ffetargetOffset_f "d", size); - - ffebad_start (FFEBAD_COMMON_DIFF_SIZE); - ffebad_string (ffesymbol_text (s)); - ffebad_string (oldsize); - ffebad_string (newsize); - ffebad_string ((g->u.common.size == 1) - ? FFECOM_SIZE_UNIT : FFECOM_SIZE_UNITS); - ffebad_string ((size == 1) - ? FFECOM_SIZE_UNIT : FFECOM_SIZE_UNITS); - ffebad_here (0, ffelex_token_where_line (g->t), - ffelex_token_where_column (g->t)); - ffebad_here (1, ffesymbol_where_line (s), - ffesymbol_where_column (s)); - ffebad_finish (); - } - - if (size > g->u.common.size) - { - g->u.common.size = size; - return TRUE; - } - - return FALSE; -} - -#endif -void -ffeglobal_terminate_1 () -{ -} |