+++ /dev/null
-/* equiv.c -- Implementation File (module.c template V1.0)
- Copyright (C) 1995, 1996, 1997, 1998 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:
- Handles the EQUIVALENCE relationships in a program unit.
-
- Modifications:
-*/
-
-#define FFEEQUIV_DEBUG 0
-
-/* Include files. */
-
-#include "proj.h"
-#include "equiv.h"
-#include "bad.h"
-#include "bld.h"
-#include "com.h"
-#include "data.h"
-#include "global.h"
-#include "lex.h"
-#include "malloc.h"
-#include "symbol.h"
-
-/* Externals defined here. */
-
-
-/* Simple definitions and enumerations. */
-
-
-/* Internal typedefs. */
-
-
-/* Private include files. */
-
-
-/* Internal structure definitions. */
-
-struct _ffeequiv_list_
- {
- ffeequiv first;
- ffeequiv last;
- };
-
-/* Static objects accessed by functions in this module. */
-
-static struct _ffeequiv_list_ ffeequiv_list_;
-
-/* Static functions (internal). */
-
-static void ffeequiv_destroy_ (ffeequiv eq);
-static void ffeequiv_layout_local_ (ffeequiv eq);
-static bool ffeequiv_offset_ (ffetargetOffset *offset, ffesymbol s,
- ffebld expr, bool subtract,
- ffetargetOffset adjust, bool no_precede);
-
-/* Internal macros. */
-\f
-
-static void
-ffeequiv_destroy_ (ffeequiv victim)
-{
- ffebld list;
- ffebld item;
- ffebld expr;
-
- for (list = victim->list; list != NULL; list = ffebld_trail (list))
- {
- for (item = ffebld_head (list); item != NULL; item = ffebld_trail (item))
- {
- ffesymbol sym;
-
- expr = ffebld_head (item);
- sym = ffeequiv_symbol (expr);
- if (sym == NULL)
- continue;
- if (ffesymbol_equiv (sym) != NULL)
- ffesymbol_set_equiv (sym, NULL);
- }
- }
- ffeequiv_kill (victim);
-}
-
-/* ffeequiv_layout_local_ -- Lay out storage for local equivalenced vars
-
- ffeequiv eq;
- ffeequiv_layout_local_(eq);
-
- Makes a single master ffestorag object that contains all the vars
- in the equivalence, and makes subordinate ffestorag objects for the
- vars with the correct offsets.
-
- The resulting var offsets are relative not necessarily to 0 -- the
- are relative to the offset of the master area, which might be 0 or
- negative, but should never be positive. */
-
-static void
-ffeequiv_layout_local_ (ffeequiv eq)
-{
- ffestorag st; /* Equivalence storage area. */
- ffebld list; /* List of list of equivalences. */
- ffebld item; /* List of equivalences. */
- ffebld root_exp; /* Expression for root sym. */
- ffestorag root_st; /* Storage for root. */
- ffesymbol root_sym; /* Root itself. */
- ffebld rooted_exp; /* Expression for rooted sym in an eqlist. */
- ffestorag rooted_st; /* Storage for rooted. */
- ffesymbol rooted_sym; /* Rooted symbol itself. */
- ffetargetOffset eqlist_offset;/* Offset for eqlist from rooted sym. */
- ffetargetAlign alignment;
- ffetargetAlign modulo;
- ffetargetAlign pad;
- ffetargetOffset size;
- ffetargetOffset num_elements;
- bool new_storage; /* Established new storage info. */
- bool need_storage; /* Have need for more storage info. */
- bool init;
-
- assert (eq != NULL);
-
- if (ffeequiv_common (eq) != NULL)
- { /* Put in common due to programmer error. */
- ffeequiv_destroy_ (eq);
- return;
- }
-
- /* Find the symbol for the first valid item in the list of lists, use that
- as the root symbol. Doesn't matter if it won't end up at the beginning
- of the list, though. */
-
-#if FFEEQUIV_DEBUG
- fprintf (stderr, "Equiv1:\n");
-#endif
-
- root_sym = NULL;
- root_exp = NULL;
-
- for (list = ffeequiv_list (eq);
- list != NULL;
- list = ffebld_trail (list))
- { /* For every equivalence list in the list of
- equivs */
- for (item = ffebld_head (list);
- item != NULL;
- item = ffebld_trail (item))
- { /* For every equivalence item in the list */
- ffetargetOffset ign; /* Ignored. */
-
- root_exp = ffebld_head (item);
- root_sym = ffeequiv_symbol (root_exp);
- if (root_sym == NULL)
- continue; /* Ignore me. */
-
- assert (ffesymbol_storage (root_sym) == NULL); /* No storage yet. */
-
- if (!ffeequiv_offset_ (&ign, root_sym, root_exp, FALSE, 0, FALSE))
- {
- /* We can't just eliminate this one symbol from the list
- of candidates, because it might be the only one that
- ties all these equivs together. So just destroy the
- whole list. */
-
- ffeequiv_destroy_ (eq);
- return;
- }
-
- break; /* Use first valid eqv expr for root exp/sym. */
- }
- if (root_sym != NULL)
- break;
- }
-
- if (root_sym == NULL)
- {
- ffeequiv_destroy_ (eq);
- return;
- }
-
-
-#if FFEEQUIV_DEBUG
- fprintf (stderr, " Root: `%s'\n", ffesymbol_text (root_sym));
-#endif
-
- /* We've got work to do, so make the LOCAL storage object that'll hold all
- the equivalenced vars inside it. */
-
- st = ffestorag_new (ffestorag_list_master ());
- ffestorag_set_parent (st, NULL); /* Initializations happen here. */
- ffestorag_set_init (st, NULL);
- ffestorag_set_accretion (st, NULL);
- ffestorag_set_offset (st, 0); /* Assume equiv will be at root offset 0 for now. */
- ffestorag_set_alignment (st, 1);
- ffestorag_set_modulo (st, 0);
- ffestorag_set_type (st, FFESTORAG_typeLOCAL);
- ffestorag_set_basictype (st, ffesymbol_basictype (root_sym));
- ffestorag_set_kindtype (st, ffesymbol_kindtype (root_sym));
- ffestorag_set_typesymbol (st, root_sym);
- ffestorag_set_is_save (st, ffeequiv_is_save (eq));
- if (ffesymbol_is_save (root_sym))
- ffestorag_update_save (st);
- ffestorag_set_is_init (st, ffeequiv_is_init (eq));
- if (ffesymbol_is_init (root_sym))
- ffestorag_update_init (st);
- ffestorag_set_symbol (st, root_sym); /* Assume this will be the root until
- we know better (used only to generate
- the internal name for the aggregate area,
- e.g. for debugging). */
-
- /* Make the EQUIV storage object for the root symbol. */
-
- if (ffesymbol_rank (root_sym) == 0)
- num_elements = 1;
- else
- num_elements = ffebld_constant_integerdefault (ffebld_conter
- (ffesymbol_arraysize (root_sym)));
- ffetarget_layout (ffesymbol_text (root_sym), &alignment, &modulo, &size,
- ffesymbol_basictype (root_sym), ffesymbol_kindtype (root_sym),
- ffesymbol_size (root_sym), num_elements);
- ffestorag_set_size (st, size); /* Set initial size of aggregate area. */
-
- pad = ffetarget_align (ffestorag_ptr_to_alignment (st),
- ffestorag_ptr_to_modulo (st), 0, alignment,
- modulo);
- assert (pad == 0);
-
- root_st = ffestorag_new (ffestorag_list_equivs (st));
- ffestorag_set_parent (root_st, st); /* Initializations happen there. */
- ffestorag_set_init (root_st, NULL);
- ffestorag_set_accretion (root_st, NULL);
- ffestorag_set_symbol (root_st, root_sym);
- ffestorag_set_size (root_st, size);
- ffestorag_set_offset (root_st, 0); /* Will not change; always 0 relative to itself! */
- ffestorag_set_alignment (root_st, alignment);
- ffestorag_set_modulo (root_st, modulo);
- ffestorag_set_type (root_st, FFESTORAG_typeEQUIV);
- ffestorag_set_basictype (root_st, ffesymbol_basictype (root_sym));
- ffestorag_set_kindtype (root_st, ffesymbol_kindtype (root_sym));
- ffestorag_set_typesymbol (root_st, root_sym);
- ffestorag_set_is_save (root_st, FALSE); /* Assume FALSE, then... */
- if (ffestorag_is_save (st)) /* ...update to TRUE if needed. */
- ffestorag_update_save (root_st);
- ffestorag_set_is_init (root_st, FALSE); /* Assume FALSE, then... */
- if (ffestorag_is_init (st)) /* ...update to TRUE if needed. */
- ffestorag_update_init (root_st);
- ffesymbol_set_storage (root_sym, root_st);
- ffesymbol_signal_unreported (root_sym);
- init = ffesymbol_is_init (root_sym);
-
- /* Now that we know the root (offset=0) symbol, revisit all the lists and
- do the actual storage allocation. Keep doing this until we've gone
- through them all without making any new storage objects. */
-
- do
- {
- new_storage = FALSE;
- need_storage = FALSE;
- for (list = ffeequiv_list (eq);
- list != NULL;
- list = ffebld_trail (list))
- { /* For every equivalence list in the list of
- equivs */
- /* Now find a "rooted" symbol in this list. That is, find the
- first item we can that is valid and whose symbol already
- has a storage area, because that means we know where it
- belongs in the equivalence area and can then allocate the
- rest of the items in the list accordingly. */
-
- rooted_sym = NULL;
- rooted_exp = NULL;
- eqlist_offset = 0;
-
- for (item = ffebld_head (list);
- item != NULL;
- item = ffebld_trail (item))
- { /* For every equivalence item in the list */
- rooted_exp = ffebld_head (item);
- rooted_sym = ffeequiv_symbol (rooted_exp);
- if ((rooted_sym == NULL)
- || ((rooted_st = ffesymbol_storage (rooted_sym)) == NULL))
- {
- rooted_sym = NULL;
- continue; /* Ignore me. */
- }
-
- need_storage = TRUE; /* Somebody is likely to need
- storage. */
-
-#if FFEEQUIV_DEBUG
- fprintf (stderr, " Rooted: `%s' at %" ffetargetOffset_f "d\n",
- ffesymbol_text (rooted_sym),
- ffestorag_offset (rooted_st));
-#endif
-
- /* The offset of this symbol from the equiv's root symbol
- is already known, and the size of this symbol is already
- incorporated in the size of the equiv's aggregate area.
- What we now determine is the offset of this equivalence
- _list_ from the equiv's root symbol.
-
- For example, if we know that A is at offset 16 from the
- root symbol, given EQUIVALENCE (B(24),A(2)), we're looking
- at A(2), meaning that the offset for this equivalence list
- is 20 (4 bytes beyond the beginning of A, assuming typical
- array types, dimensions, and type info). */
-
- if (!ffeequiv_offset_ (&eqlist_offset, rooted_sym, rooted_exp, FALSE,
- ffestorag_offset (rooted_st), FALSE))
-
- { /* Can't use this one. */
- ffesymbol_set_equiv (rooted_sym, NULL);/* Equiv area slated for
- death. */
- rooted_sym = NULL;
- continue; /* Something's wrong with eqv expr, try another. */
- }
-
-#if FFEEQUIV_DEBUG
- fprintf (stderr, " Eqlist offset: %" ffetargetOffset_f "d\n",
- eqlist_offset);
-#endif
-
- break;
- }
-
- /* If no rooted symbol, it means this list has no roots -- yet.
- So, forget this list this time around, but we'll get back
- to it after the outer loop iterates at least one more time,
- and, ultimately, it will have a root. */
-
- if (rooted_sym == NULL)
- {
-#if FFEEQUIV_DEBUG
- fprintf (stderr, "No roots.\n");
-#endif
- continue;
- }
-
- /* We now have a rooted symbol/expr and the offset of this equivalence
- list from the root symbol. The other expressions in this
- list all identify an initial storage unit that must have the
- same offset. */
-
- for (item = ffebld_head (list);
- item != NULL;
- item = ffebld_trail (item))
- { /* For every equivalence item in the list */
- ffebld item_exp; /* Expression for equivalence. */
- ffestorag item_st; /* Storage for var. */
- ffesymbol item_sym; /* Var itself. */
- ffetargetOffset item_offset; /* Offset for var from root. */
- ffetargetOffset new_size;
-
- item_exp = ffebld_head (item);
- item_sym = ffeequiv_symbol (item_exp);
- if ((item_sym == NULL)
- || (ffesymbol_equiv (item_sym) == NULL))
- continue; /* Ignore me. */
-
- if (item_sym == rooted_sym)
- continue; /* Rooted sym already set up. */
-
- if (!ffeequiv_offset_ (&item_offset, item_sym, item_exp, TRUE,
- eqlist_offset, FALSE))
- {
- ffesymbol_set_equiv (item_sym, NULL); /* Don't bother with me anymore. */
- continue;
- }
-
-#if FFEEQUIV_DEBUG
- fprintf (stderr, " Item `%s' at %" ffetargetOffset_f "d",
- ffesymbol_text (item_sym), item_offset);
-#endif
-
- if (ffesymbol_rank (item_sym) == 0)
- num_elements = 1;
- else
- num_elements = ffebld_constant_integerdefault (ffebld_conter
- (ffesymbol_arraysize (item_sym)));
- ffetarget_layout (ffesymbol_text (item_sym), &alignment, &modulo,
- &size, ffesymbol_basictype (item_sym),
- ffesymbol_kindtype (item_sym), ffesymbol_size (item_sym),
- num_elements);
- pad = ffetarget_align (ffestorag_ptr_to_alignment (st),
- ffestorag_ptr_to_modulo (st),
- item_offset, alignment, modulo);
- if (pad != 0)
- {
- ffebad_start (FFEBAD_EQUIV_ALIGN);
- ffebad_string (ffesymbol_text (item_sym));
- ffebad_finish ();
- ffesymbol_set_equiv (item_sym, NULL); /* Don't bother with me anymore. */
- continue;
- }
-
- /* If the variable's offset is less than the offset for the
- aggregate storage area, it means it has to expand backwards
- -- i.e. the new known starting point of the area precedes the
- old one. This can't happen with COMMON areas (the standard,
- and common sense, disallow it), but it is normal for local
- EQUIVALENCE areas.
-
- Also handle choosing the "documented" rooted symbol for this
- area here. It's the symbol at the bottom (lowest offset)
- of the aggregate area, with ties going to the name that would
- sort to the top of the list of ties. */
-
- if (item_offset == ffestorag_offset (st))
- {
- if ((item_sym != ffestorag_symbol (st))
- && (strcmp (ffesymbol_text (item_sym),
- ffesymbol_text (ffestorag_symbol (st)))
- < 0))
- ffestorag_set_symbol (st, item_sym);
- }
- else if (item_offset < ffestorag_offset (st))
- {
- /* Increase size of equiv area to start for lower offset
- relative to root symbol. */
- if (! ffetarget_offset_add (&new_size,
- ffestorag_offset (st)
- - item_offset,
- ffestorag_size (st)))
- ffetarget_offset_overflow (ffesymbol_text (s));
- else
- ffestorag_set_size (st, new_size);
-
- ffestorag_set_symbol (st, item_sym);
- ffestorag_set_offset (st, item_offset);
-
-#if FFEEQUIV_DEBUG
- fprintf (stderr, " [eq offset=%" ffetargetOffset_f
- "d, size=%" ffetargetOffset_f "d]",
- item_offset, new_size);
-#endif
- }
-
- if ((item_st = ffesymbol_storage (item_sym)) == NULL)
- { /* Create new ffestorag object, extend equiv
- area. */
-#if FFEEQUIV_DEBUG
- fprintf (stderr, ".\n");
-#endif
- new_storage = TRUE;
- item_st = ffestorag_new (ffestorag_list_equivs (st));
- ffestorag_set_parent (item_st, st); /* Initializations
- happen there. */
- ffestorag_set_init (item_st, NULL);
- ffestorag_set_accretion (item_st, NULL);
- ffestorag_set_symbol (item_st, item_sym);
- ffestorag_set_size (item_st, size);
- ffestorag_set_offset (item_st, item_offset);
- ffestorag_set_alignment (item_st, alignment);
- ffestorag_set_modulo (item_st, modulo);
- ffestorag_set_type (item_st, FFESTORAG_typeEQUIV);
- ffestorag_set_basictype (item_st, ffesymbol_basictype (item_sym));
- ffestorag_set_kindtype (item_st, ffesymbol_kindtype (item_sym));
- ffestorag_set_typesymbol (item_st, item_sym);
- ffestorag_set_is_save (item_st, FALSE); /* Assume FALSE... */
- if (ffestorag_is_save (st)) /* ...update TRUE */
- ffestorag_update_save (item_st); /* if needed. */
- ffestorag_set_is_init (item_st, FALSE); /* Assume FALSE... */
- if (ffestorag_is_init (st)) /* ...update TRUE */
- ffestorag_update_init (item_st); /* if needed. */
- ffesymbol_set_storage (item_sym, item_st);
- ffesymbol_signal_unreported (item_sym);
- if (ffesymbol_is_init (item_sym))
- init = TRUE;
-
- /* Determine new size of equiv area, complain if overflow. */
-
- if (!ffetarget_offset_add (&size, item_offset, size)
- || !ffetarget_offset_add (&size, -ffestorag_offset (st), size))
- ffetarget_offset_overflow (ffesymbol_text (s));
- else if (size > ffestorag_size (st))
- ffestorag_set_size (st, size);
- ffestorag_update (st, item_sym, ffesymbol_basictype (item_sym),
- ffesymbol_kindtype (item_sym));
- }
- else
- {
-#if FFEEQUIV_DEBUG
- fprintf (stderr, " (was %" ffetargetOffset_f "d).\n",
- ffestorag_offset (item_st));
-#endif
- /* Make sure offset agrees with known offset. */
- if (item_offset != ffestorag_offset (item_st))
- {
- char io1[40];
- char io2[40];
-
- sprintf (&io1[0], "%" ffetargetOffset_f "d", item_offset);
- sprintf (&io2[0], "%" ffetargetOffset_f "d", ffestorag_offset (item_st));
- ffebad_start (FFEBAD_EQUIV_MISMATCH);
- ffebad_string (ffesymbol_text (item_sym));
- ffebad_string (ffesymbol_text (root_sym));
- ffebad_string (io1);
- ffebad_string (io2);
- ffebad_finish ();
- }
- }
- ffesymbol_set_equiv (item_sym, NULL); /* Don't bother with me anymore. */
- } /* (For every equivalence item in the list) */
- ffebld_set_head (list, NULL); /* Don't do this list again. */
- } /* (For every equivalence list in the list of
- equivs) */
- } while (new_storage && need_storage);
-
- ffesymbol_set_equiv (root_sym, NULL); /* This one has storage now. */
-
- ffeequiv_kill (eq); /* Fully processed, no longer needed. */
-
- /* If the offset for this storage area is zero (it cannot be positive),
- that means the alignment/modulo info is already correct. Otherwise,
- the alignment info is correct, but the modulo info reflects a
- zero offset, so fix it. */
-
- if (ffestorag_offset (st) < 0)
- {
- /* Calculate the initial padding necessary to preserve
- the alignment/modulo requirements for the storage area.
- These requirements are themselves kept track of in the
- record for the storage area as a whole, but really pertain
- to offset 0 of that area, which is where the root symbol
- was originally placed.
-
- The goal here is to have the offset and size for the area
- faithfully reflect the area itself, not extra requirements
- like alignment. So to meet the alignment requirements,
- the modulo for the area should be set as if the area had an
- alignment requirement of alignment/0 and was aligned/padded
- downward to meet the alignment requirements of the area at
- offset zero, the amount of padding needed being the desired
- value for the modulo of the area. */
-
- alignment = ffestorag_alignment (st);
- modulo = ffestorag_modulo (st);
-
- /* Since we want to move the whole area *down* (lower memory
- addresses) as required by the alignment/modulo paid, negate
- the offset to ffetarget_align, which assumes aligning *up*
- is desired. */
- pad = ffetarget_align (&alignment, &modulo,
- - ffestorag_offset (st),
- alignment, 0);
- ffestorag_set_modulo (st, pad);
- }
-
- if (init)
- ffedata_gather (st); /* Gather subordinate inits into one init. */
-}
-
-/* ffeequiv_offset_ -- Determine offset from start of symbol
-
- ffetargetOffset offset;
- ffesymbol s; // Symbol for error reporting.
- ffebld expr; // opSUBSTR, opARRAYREF, opSYMTER, opANY.
- bool subtract; // FALSE means add to adjust, TRUE means subtract from it.
- ffetargetOffset adjust; // Helps keep answer in pos range (unsigned).
- if (!ffeequiv_offset_(&offset,s,expr,subtract,adjust))
- // error doing the calculation, message already printed
-
- Returns the offset represented by the SUBSTR, ARRAYREF, or SUBSTR/ARRAYREF
- combination added-to/subtracted-from the adjustment specified. If there
- is an error of some kind, returns FALSE, else returns TRUE. Note that
- only the first storage unit specified is considered; A(1:1) and A(1:2000)
- have the same first storage unit and so return the same offset. */
-
-static bool
-ffeequiv_offset_ (ffetargetOffset *offset, ffesymbol s UNUSED,
- ffebld expr, bool subtract, ffetargetOffset adjust,
- bool no_precede)
-{
- ffetargetIntegerDefault value = 0;
- ffetargetOffset cval; /* Converted value. */
- ffesymbol sym;
-
- if (expr == NULL)
- return FALSE;
-
-again: /* :::::::::::::::::::: */
-
- switch (ffebld_op (expr))
- {
- case FFEBLD_opANY:
- return FALSE;
-
- case FFEBLD_opSYMTER:
- {
- ffetargetOffset size; /* Size of a single unit. */
- ffetargetAlign a; /* Ignored. */
- ffetargetAlign m; /* Ignored. */
-
- sym = ffebld_symter (expr);
- if (ffesymbol_basictype (sym) == FFEINFO_basictypeANY)
- return FALSE;
-
- ffetarget_layout (ffesymbol_text (sym), &a, &m, &size,
- ffesymbol_basictype (sym),
- ffesymbol_kindtype (sym), 1, 1);
-
- if (value < 0)
- { /* Really invalid, as in A(-2:5), but in case
- it's wanted.... */
- if (!ffetarget_offset (&cval, -value))
- return FALSE;
-
- if (!ffetarget_offset_multiply (&cval, cval, size))
- return FALSE;
-
- if (subtract)
- return ffetarget_offset_add (offset, cval, adjust);
-
- if (no_precede && (cval > adjust))
- {
- neg: /* :::::::::::::::::::: */
- ffebad_start (FFEBAD_COMMON_NEG);
- ffebad_string (ffesymbol_text (sym));
- ffebad_finish ();
- return FALSE;
- }
- return ffetarget_offset_add (offset, -cval, adjust);
- }
-
- if (!ffetarget_offset (&cval, value))
- return FALSE;
-
- if (!ffetarget_offset_multiply (&cval, cval, size))
- return FALSE;
-
- if (!subtract)
- return ffetarget_offset_add (offset, cval, adjust);
-
- if (no_precede && (cval > adjust))
- goto neg; /* :::::::::::::::::::: */
-
- return ffetarget_offset_add (offset, -cval, adjust);
- }
-
- case FFEBLD_opARRAYREF:
- {
- ffebld symexp = ffebld_left (expr);
- ffebld subscripts = ffebld_right (expr);
- ffebld dims;
- ffetargetIntegerDefault width;
- ffetargetIntegerDefault arrayval;
- ffetargetIntegerDefault lowbound;
- ffetargetIntegerDefault highbound;
- ffebld subscript;
- ffebld dim;
- ffebld low;
- ffebld high;
- int rank = 0;
-
- if (ffebld_op (symexp) != FFEBLD_opSYMTER)
- return FALSE;
-
- sym = ffebld_symter (symexp);
- if (ffesymbol_basictype (sym) == FFEINFO_basictypeANY)
- return FALSE;
-
- if (ffesymbol_size (sym) == FFETARGET_charactersizeNONE)
- width = 1;
- else
- width = ffesymbol_size (sym);
- dims = ffesymbol_dims (sym);
-
- while (subscripts != NULL)
- {
- ++rank;
- if (dims == NULL)
- {
- ffebad_start (FFEBAD_EQUIV_MANY);
- ffebad_string (ffesymbol_text (sym));
- ffebad_finish ();
- return FALSE;
- }
-
- subscript = ffebld_head (subscripts);
- dim = ffebld_head (dims);
-
- if (ffebld_op (subscript) == FFEBLD_opANY)
- return FALSE;
-
- assert (ffebld_op (subscript) == FFEBLD_opCONTER);
- assert (ffeinfo_basictype (ffebld_info (subscript))
- == FFEINFO_basictypeINTEGER);
- assert (ffeinfo_kindtype (ffebld_info (subscript))
- == FFEINFO_kindtypeINTEGERDEFAULT);
- arrayval = ffebld_constant_integerdefault (ffebld_conter
- (subscript));
-
- if (ffebld_op (dim) == FFEBLD_opANY)
- return FALSE;
-
- assert (ffebld_op (dim) == FFEBLD_opBOUNDS);
- low = ffebld_left (dim);
- high = ffebld_right (dim);
-
- if (low == NULL)
- lowbound = 1;
- else
- {
- if (ffebld_op (low) == FFEBLD_opANY)
- return FALSE;
-
- assert (ffebld_op (low) == FFEBLD_opCONTER);
- assert (ffeinfo_basictype (ffebld_info (low))
- == FFEINFO_basictypeINTEGER);
- assert (ffeinfo_kindtype (ffebld_info (low))
- == FFEINFO_kindtypeINTEGERDEFAULT);
- lowbound
- = ffebld_constant_integerdefault (ffebld_conter (low));
- }
-
- if (ffebld_op (high) == FFEBLD_opANY)
- return FALSE;
-
- assert (ffebld_op (high) == FFEBLD_opCONTER);
- assert (ffeinfo_basictype (ffebld_info (high))
- == FFEINFO_basictypeINTEGER);
- assert (ffeinfo_kindtype (ffebld_info (high))
- == FFEINFO_kindtypeINTEGER1);
- highbound
- = ffebld_constant_integerdefault (ffebld_conter (high));
-
- if ((arrayval < lowbound) || (arrayval > highbound))
- {
- char rankstr[10];
-
- sprintf (rankstr, "%d", rank);
- ffebad_start (FFEBAD_EQUIV_SUBSCRIPT);
- ffebad_string (ffesymbol_text (sym));
- ffebad_string (rankstr);
- ffebad_finish ();
- }
-
- subscripts = ffebld_trail (subscripts);
- dims = ffebld_trail (dims);
-
- value += width * (arrayval - lowbound);
- if (subscripts != NULL)
- width *= highbound - lowbound + 1;
- }
-
- if (dims != NULL)
- {
- ffebad_start (FFEBAD_EQUIV_FEW);
- ffebad_string (ffesymbol_text (sym));
- ffebad_finish ();
- return FALSE;
- }
-
- expr = symexp;
- }
- goto again; /* :::::::::::::::::::: */
-
- case FFEBLD_opSUBSTR:
- {
- ffebld begin = ffebld_head (ffebld_right (expr));
-
- expr = ffebld_left (expr);
- if (ffebld_op (expr) == FFEBLD_opANY)
- return FALSE;
- if (ffebld_op (expr) == FFEBLD_opARRAYREF)
- sym = ffebld_symter (ffebld_left (expr));
- else if (ffebld_op (expr) == FFEBLD_opSYMTER)
- sym = ffebld_symter (expr);
- else
- sym = NULL;
-
- if ((sym != NULL)
- && (ffesymbol_basictype (sym) == FFEINFO_basictypeANY))
- return FALSE;
-
- if (begin == NULL)
- value = 0;
- else
- {
- if (ffebld_op (begin) == FFEBLD_opANY)
- return FALSE;
- assert (ffebld_op (begin) == FFEBLD_opCONTER);
- assert (ffeinfo_basictype (ffebld_info (begin))
- == FFEINFO_basictypeINTEGER);
- assert (ffeinfo_kindtype (ffebld_info (begin))
- == FFEINFO_kindtypeINTEGERDEFAULT);
-
- value = ffebld_constant_integerdefault (ffebld_conter (begin));
-
- if ((value < 1)
- || ((sym != NULL)
- && (value > ffesymbol_size (sym))))
- {
- ffebad_start (FFEBAD_EQUIV_RANGE);
- ffebad_string (ffesymbol_text (sym));
- ffebad_finish ();
- }
-
- --value;
- }
- if ((sym != NULL)
- && (ffesymbol_basictype (sym) != FFEINFO_basictypeCHARACTER))
- {
- ffebad_start (FFEBAD_EQUIV_SUBSTR);
- ffebad_string (ffesymbol_text (sym));
- ffebad_finish ();
- value = 0;
- }
- }
- goto again; /* :::::::::::::::::::: */
-
- default:
- assert ("bad op" == NULL);
- return FALSE;
- }
-
-}
-
-/* ffeequiv_add -- Add list of equivalences to list of lists for eq object
-
- ffeequiv eq;
- ffebld list;
- ffelexToken t; // points to first item in equivalence list
- ffeequiv_add(eq,list,t);
-
- Check the list to make sure only one common symbol is involved (even
- if multiple times) and agrees with the common symbol for the equivalence
- object (or it has no common symbol until now). Prepend (or append, it
- doesn't matter) the list to the list of lists for the equivalence object.
- Otherwise report an error and return. */
-
-void
-ffeequiv_add (ffeequiv eq, ffebld list, ffelexToken t)
-{
- ffebld item;
- ffesymbol symbol;
- ffesymbol common = ffeequiv_common (eq);
-
- for (item = list; item != NULL; item = ffebld_trail (item))
- {
- symbol = ffeequiv_symbol (ffebld_head (item));
-
- if (ffesymbol_common (symbol) != NULL) /* Is symbol known in COMMON yet? */
- {
- if (common == NULL)
- common = ffesymbol_common (symbol);
- else if (common != ffesymbol_common (symbol))
- {
- /* Yes, and symbol disagrees with others on the COMMON area. */
- ffebad_start (FFEBAD_EQUIV_COMMON);
- ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
- ffebad_string (ffesymbol_text (common));
- ffebad_string (ffesymbol_text (ffesymbol_common (symbol)));
- ffebad_finish ();
- return;
- }
- }
- }
-
- if ((common != NULL)
- && (ffeequiv_common (eq) == NULL)) /* Is COMMON involved already? */
- ffeequiv_set_common (eq, common); /* No, but it is now. */
-
- for (item = list; item != NULL; item = ffebld_trail (item))
- {
- symbol = ffeequiv_symbol (ffebld_head (item));
-
- if (ffesymbol_equiv (symbol) == NULL)
- ffesymbol_set_equiv (symbol, eq);
- else
- assert (ffesymbol_equiv (symbol) == eq);
-
- if (ffesymbol_common (symbol) == NULL) /* Is symbol in a COMMON
- area? */
- { /* No (at least not yet). */
- if (ffesymbol_is_save (symbol))
- ffeequiv_update_save (eq); /* EQUIVALENCE has >=1 SAVEd entity. */
- if (ffesymbol_is_init (symbol))
- ffeequiv_update_init (eq); /* EQUIVALENCE has >=1 init'd entity. */
- continue; /* Nothing more to do here. */
- }
-
-#if FFEGLOBAL_ENABLED
- if (ffesymbol_is_init (symbol))
- ffeglobal_init_common (ffesymbol_common (symbol), t);
-#endif
-
- if (ffesymbol_is_save (ffesymbol_common (symbol)))
- ffeequiv_update_save (eq); /* EQUIVALENCE is in a SAVEd COMMON block. */
- if (ffesymbol_is_init (ffesymbol_common (symbol)))
- ffeequiv_update_init (eq); /* EQUIVALENCE is in a init'd COMMON block. */
- }
-
- ffeequiv_set_list (eq, ffebld_new_item (list, ffeequiv_list (eq)));
-}
-
-/* ffeequiv_exec_transition -- Do the hard work on all the equivalence objects
-
- ffeequiv_exec_transition(); */
-
-void
-ffeequiv_exec_transition ()
-{
- while (ffeequiv_list_.first != (ffeequiv) &ffeequiv_list_.first)
- ffeequiv_layout_local_ (ffeequiv_list_.first);
-}
-
-/* ffeequiv_init_2 -- Initialize for new program unit
-
- ffeequiv_init_2();
-
- Initializes the list of equivalences. */
-
-void
-ffeequiv_init_2 ()
-{
- ffeequiv_list_.first = (ffeequiv) &ffeequiv_list_.first;
- ffeequiv_list_.last = (ffeequiv) &ffeequiv_list_.first;
-}
-
-/* ffeequiv_kill -- Kill equivalence object after removing from list
-
- ffeequiv eq;
- ffeequiv_kill(eq);
-
- Removes equivalence object from master list, then kills it. */
-
-void
-ffeequiv_kill (ffeequiv victim)
-{
- victim->next->previous = victim->previous;
- victim->previous->next = victim->next;
- if (ffe_is_do_internal_checks ())
- {
- ffebld list;
- ffebld item;
- ffebld expr;
-
- /* Assert that nobody our victim points to still points to it. */
-
- assert ((victim->common == NULL)
- || (ffesymbol_equiv (victim->common) == NULL));
-
- for (list = victim->list; list != NULL; list = ffebld_trail (list))
- {
- for (item = ffebld_head (list); item != NULL; item = ffebld_trail (item))
- {
- ffesymbol sym;
-
- expr = ffebld_head (item);
- sym = ffeequiv_symbol (expr);
- if (sym == NULL)
- continue;
- assert (ffesymbol_equiv (sym) != victim);
- }
- }
- }
- malloc_kill_ks (ffe_pool_program_unit (), victim, sizeof (*victim));
-}
-
-/* ffeequiv_layout_cblock -- Lay out storage for common area
-
- ffestorag st;
- if (ffeequiv_layout_cblock(st))
- // at least one equiv'd symbol has init/accretion expr.
-
- Now that the explicitly COMMONed variables in the common area (whose
- ffestorag object is passed) have been laid out, lay out the storage
- for all variables equivalenced into the area by making subordinate
- ffestorag objects for them. */
-
-bool
-ffeequiv_layout_cblock (ffestorag st)
-{
- ffesymbol s = ffestorag_symbol (st); /* CBLOCK symbol. */
- ffebld list; /* List of explicit common vars, in order, in
- s. */
- ffebld item; /* List of list of equivalences in a given
- explicit common var. */
- ffebld root; /* Expression for (1st) explicit common var
- in list of eqs. */
- ffestorag rst; /* Storage for root. */
- ffetargetOffset root_offset; /* Offset for root into common area. */
- ffesymbol sr; /* Root itself. */
- ffeequiv seq; /* Its equivalence object, if any. */
- ffebld var; /* Expression for equivalence. */
- ffestorag vst; /* Storage for var. */
- ffetargetOffset var_offset; /* Offset for var into common area. */
- ffesymbol sv; /* Var itself. */
- ffebld altroot; /* Alternate root. */
- ffesymbol altrootsym; /* Alternate root symbol. */
- ffetargetAlign alignment;
- ffetargetAlign modulo;
- ffetargetAlign pad;
- ffetargetOffset size;
- ffetargetOffset num_elements;
- bool new_storage; /* Established new storage info. */
- bool need_storage; /* Have need for more storage info. */
- bool ok;
- bool init = FALSE;
-
- assert (st != NULL);
- assert (ffestorag_type (st) == FFESTORAG_typeCBLOCK);
- assert (ffesymbol_kind (ffestorag_symbol (st)) == FFEINFO_kindCOMMON);
-
- for (list = ffesymbol_commonlist (ffestorag_symbol (st));
- list != NULL;
- list = ffebld_trail (list))
- { /* For every variable in the common area */
- assert (ffebld_op (ffebld_head (list)) == FFEBLD_opSYMTER);
- sr = ffebld_symter (ffebld_head (list));
- if ((seq = ffesymbol_equiv (sr)) == NULL)
- continue; /* No equivalences to process. */
- rst = ffesymbol_storage (sr);
- if (rst == NULL)
- {
- assert (ffesymbol_kind (sr) == FFEINFO_kindANY);
- continue;
- }
- ffesymbol_set_equiv (sr, NULL); /* Cancel ref to equiv obj. */
- do
- {
- new_storage = FALSE;
- need_storage = FALSE;
- for (item = ffeequiv_list (seq); /* Get list of equivs. */
- item != NULL;
- item = ffebld_trail (item))
- { /* For every eqv list in the list of equivs
- for the variable */
- altroot = NULL;
- altrootsym = NULL;
- for (root = ffebld_head (item);
- root != NULL;
- root = ffebld_trail (root))
- { /* For every equivalence item in the list */
- sv = ffeequiv_symbol (ffebld_head (root));
- if (sv == sr)
- break; /* Found first mention of "rooted" symbol. */
- if (ffesymbol_storage (sv) != NULL)
- {
- altroot = root; /* If no mention, use this guy
- instead. */
- altrootsym = sv;
- }
- }
- if (root != NULL)
- {
- root = ffebld_head (root); /* Lose its opITEM. */
- ok = ffeequiv_offset_ (&root_offset, sr, root, FALSE,
- ffestorag_offset (rst), TRUE);
- /* Equiv point prior to start of common area? */
- }
- else if (altroot != NULL)
- {
- /* Equiv point prior to start of common area? */
- root = ffebld_head (altroot);
- ok = ffeequiv_offset_ (&root_offset, altrootsym, root,
- FALSE,
- ffestorag_offset (ffesymbol_storage (altrootsym)),
- TRUE);
- ffesymbol_set_equiv (altrootsym, NULL);
- }
- else
- /* No rooted symbol in list of equivalences! */
- { /* Assume this was due to opANY and ignore
- this list for now. */
- need_storage = TRUE;
- continue;
- }
-
- /* We now know the root symbol and the operating offset of that
- root into the common area. The other expressions in the
- list all identify an initial storage unit that must have the
- same offset. */
-
- for (var = ffebld_head (item);
- var != NULL;
- var = ffebld_trail (var))
- { /* For every equivalence item in the list */
- if (ffebld_head (var) == root)
- continue; /* Except root, of course. */
- sv = ffeequiv_symbol (ffebld_head (var));
- if (sv == NULL)
- continue; /* Except erroneous stuff (opANY). */
- ffesymbol_set_equiv (sv, NULL); /* Don't need this ref
- anymore. */
- if (!ok
- || !ffeequiv_offset_ (&var_offset, sv,
- ffebld_head (var), TRUE,
- root_offset, TRUE))
- continue; /* Can't do negative offset wrt COMMON. */
-
- if (ffesymbol_rank (sv) == 0)
- num_elements = 1;
- else
- num_elements = ffebld_constant_integerdefault
- (ffebld_conter (ffesymbol_arraysize (sv)));
- ffetarget_layout (ffesymbol_text (sv), &alignment,
- &modulo, &size,
- ffesymbol_basictype (sv),
- ffesymbol_kindtype (sv),
- ffesymbol_size (sv), num_elements);
- pad = ffetarget_align (ffestorag_ptr_to_alignment (st),
- ffestorag_ptr_to_modulo (st),
- var_offset, alignment, modulo);
- if (pad != 0)
- {
- ffebad_start (FFEBAD_EQUIV_ALIGN);
- ffebad_string (ffesymbol_text (sv));
- ffebad_finish ();
- continue;
- }
-
- if ((vst = ffesymbol_storage (sv)) == NULL)
- { /* Create new ffestorag object, extend
- cblock. */
- new_storage = TRUE;
- vst = ffestorag_new (ffestorag_list_equivs (st));
- ffestorag_set_parent (vst, st); /* Initializations
- happen there. */
- ffestorag_set_init (vst, NULL);
- ffestorag_set_accretion (vst, NULL);
- ffestorag_set_symbol (vst, sv);
- ffestorag_set_size (vst, size);
- ffestorag_set_offset (vst, var_offset);
- ffestorag_set_alignment (vst, alignment);
- ffestorag_set_modulo (vst, modulo);
- ffestorag_set_type (vst, FFESTORAG_typeEQUIV);
- ffestorag_set_basictype (vst, ffesymbol_basictype (sv));
- ffestorag_set_kindtype (vst, ffesymbol_kindtype (sv));
- ffestorag_set_typesymbol (vst, sv);
- ffestorag_set_is_save (vst, FALSE); /* Assume FALSE... */
- if (ffestorag_is_save (st)) /* ...update TRUE */
- ffestorag_update_save (vst); /* if needed. */
- ffestorag_set_is_init (vst, FALSE); /* Assume FALSE... */
- if (ffestorag_is_init (st)) /* ...update TRUE */
- ffestorag_update_init (vst); /* if needed. */
- if (!ffetarget_offset_add (&size, var_offset, size))
- /* Find one size of common block, complain if
- overflow. */
- ffetarget_offset_overflow (ffesymbol_text (s));
- else if (size > ffestorag_size (st))
- /* Extend common. */
- ffestorag_set_size (st, size);
- ffesymbol_set_storage (sv, vst);
- ffesymbol_set_common (sv, s);
- ffesymbol_signal_unreported (sv);
- ffestorag_update (st, sv, ffesymbol_basictype (sv),
- ffesymbol_kindtype (sv));
- if (ffesymbol_is_init (sv))
- init = TRUE;
- }
- else
- {
- /* Make sure offset agrees with known offset. */
- if (var_offset != ffestorag_offset (vst))
- {
- char io1[40];
- char io2[40];
-
- sprintf (&io1[0], "%" ffetargetOffset_f "d", var_offset);
- sprintf (&io2[0], "%" ffetargetOffset_f "d", ffestorag_offset (vst));
- ffebad_start (FFEBAD_EQUIV_MISMATCH);
- ffebad_string (ffesymbol_text (sv));
- ffebad_string (ffesymbol_text (s));
- ffebad_string (io1);
- ffebad_string (io2);
- ffebad_finish ();
- }
- }
- } /* (For every equivalence item in the list) */
- } /* (For every eqv list in the list of equivs
- for the variable) */
- }
- while (new_storage && need_storage);
-
- ffeequiv_kill (seq); /* Kill equiv obj. */
- } /* (For every variable in the common area) */
-
- return init;
-}
-
-/* ffeequiv_merge -- Merge two equivalence objects, return the merged result
-
- ffeequiv eq1;
- ffeequiv eq2;
- ffelexToken t; // points to current equivalence item forcing the merge.
- eq1 = ffeequiv_merge(eq1,eq2,t);
-
- If the two equivalence objects can be merged, they are, all the
- ffesymbols in their lists of lists are adjusted to point to the merged
- equivalence object, and the merged object is returned.
-
- Otherwise, the two equivalence objects have different non-NULL common
- symbols, so the merge cannot take place. An error message is issued and
- NULL is returned. */
-
-ffeequiv
-ffeequiv_merge (ffeequiv eq1, ffeequiv eq2, ffelexToken t)
-{
- ffebld list;
- ffebld eqs;
- ffesymbol symbol;
- ffebld last = NULL;
-
- /* If both equivalence objects point to different common-based symbols,
- complain. Of course, one or both might have NULL common symbols now,
- and get COMMONed later, but the COMMON statement handler checks for
- this. */
-
- if ((ffeequiv_common (eq1) != NULL) && (ffeequiv_common (eq2) != NULL)
- && (ffeequiv_common (eq1) != ffeequiv_common (eq2)))
- {
- ffebad_start (FFEBAD_EQUIV_COMMON);
- ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
- ffebad_string (ffesymbol_text (ffeequiv_common (eq1)));
- ffebad_string (ffesymbol_text (ffeequiv_common (eq2)));
- ffebad_finish ();
- return NULL;
- }
-
- /* Make eq1 the new, merged object (arbitrarily). */
-
- if (ffeequiv_common (eq1) == NULL)
- ffeequiv_set_common (eq1, ffeequiv_common (eq2));
-
- /* If the victim object has any init'ed entities, so does the new object. */
-
- if (eq2->is_init)
- eq1->is_init = TRUE;
-
-#if FFEGLOBAL_ENABLED
- if (eq1->is_init && (ffeequiv_common (eq1) != NULL))
- ffeglobal_init_common (ffeequiv_common (eq1), t);
-#endif
-
- /* If the victim object has any SAVEd entities, then the new object has
- some. */
-
- if (ffeequiv_is_save (eq2))
- ffeequiv_update_save (eq1);
-
- /* If the victim object has any init'd entities, then the new object has
- some. */
-
- if (ffeequiv_is_init (eq2))
- ffeequiv_update_init (eq1);
-
- /* Adjust all the symbols in the list of lists of equivalences for the
- victim equivalence object so they point to the new merged object
- instead. */
-
- for (list = ffeequiv_list (eq2); list != NULL; list = ffebld_trail (list))
- {
- for (eqs = ffebld_head (list); eqs != NULL; eqs = ffebld_trail (eqs))
- {
- symbol = ffeequiv_symbol (ffebld_head (eqs));
- if (ffesymbol_equiv (symbol) == eq2)
- ffesymbol_set_equiv (symbol, eq1);
- else
- assert (ffesymbol_equiv (symbol) == eq1); /* Can see a sym > once. */
- }
-
- /* For convenience, remember where the last ITEM in the outer list is. */
-
- if (ffebld_trail (list) == NULL)
- {
- last = list;
- break;
- }
- }
-
- /* Append the list of lists in the new, merged object to the list of lists
- in the victim object, then use the new combined list in the new merged
- object. */
-
- ffebld_set_trail (last, ffeequiv_list (eq1));
- ffeequiv_set_list (eq1, ffeequiv_list (eq2));
-
- /* Unlink and kill the victim object. */
-
- ffeequiv_kill (eq2);
-
- return eq1; /* Return the new merged object. */
-}
-
-/* ffeequiv_new -- Create new equivalence object, put in list
-
- ffeequiv eq;
- eq = ffeequiv_new();
-
- Creates a new equivalence object and adds it to the list of equivalence
- objects. */
-
-ffeequiv
-ffeequiv_new ()
-{
- ffeequiv eq;
-
- eq = malloc_new_ks (ffe_pool_program_unit (), "ffeequiv", sizeof (*eq));
- eq->next = (ffeequiv) &ffeequiv_list_.first;
- eq->previous = ffeequiv_list_.last;
- ffeequiv_set_common (eq, NULL); /* No COMMON area yet. */
- ffeequiv_set_list (eq, NULL); /* No list of lists of equivalences yet. */
- ffeequiv_set_is_save (eq, FALSE);
- ffeequiv_set_is_init (eq, FALSE);
- eq->next->previous = eq;
- eq->previous->next = eq;
-
- return eq;
-}
-
-/* ffeequiv_symbol -- Return symbol for equivalence expression
-
- ffesymbol symbol;
- ffebld expr;
- symbol = ffeequiv_symbol(expr);
-
- Finds the terminal SYMTER in an equivalence expression and returns the
- ffesymbol for it. */
-
-ffesymbol
-ffeequiv_symbol (ffebld expr)
-{
- assert (expr != NULL);
-
-again: /* :::::::::::::::::::: */
-
- switch (ffebld_op (expr))
- {
- case FFEBLD_opARRAYREF:
- case FFEBLD_opSUBSTR:
- expr = ffebld_left (expr);
- goto again; /* :::::::::::::::::::: */
-
- case FFEBLD_opSYMTER:
- return ffebld_symter (expr);
-
- case FFEBLD_opANY:
- return NULL;
-
- default:
- assert ("bad eq expr" == NULL);
- return NULL;
- }
-}
-
-/* ffeequiv_update_init -- Update the INIT flag for the area to TRUE
-
- ffeequiv eq;
- ffeequiv_update_init(eq);
-
- If the INIT flag for the <eq> object is already set, return. Else,
- set it TRUE and call ffe*_update_init for all objects contained in
- this one. */
-
-void
-ffeequiv_update_init (ffeequiv eq)
-{
- ffebld list; /* Current list in list of lists. */
- ffebld item; /* Current item in current list. */
- ffebld expr; /* Expression in head of current item. */
-
- if (eq->is_init)
- return;
-
- eq->is_init = TRUE;
-
- if ((eq->common != NULL)
- && !ffesymbol_is_init (eq->common))
- ffesymbol_update_init (eq->common); /* Shouldn't be needed. */
-
- for (list = eq->list; list != NULL; list = ffebld_trail (list))
- {
- for (item = ffebld_head (list); item != NULL; item = ffebld_trail (item))
- {
- expr = ffebld_head (item);
-
- again: /* :::::::::::::::::::: */
-
- switch (ffebld_op (expr))
- {
- case FFEBLD_opANY:
- break;
-
- case FFEBLD_opSYMTER:
- if (!ffesymbol_is_init (ffebld_symter (expr)))
- ffesymbol_update_init (ffebld_symter (expr));
- break;
-
- case FFEBLD_opARRAYREF:
- expr = ffebld_left (expr);
- goto again; /* :::::::::::::::::::: */
-
- case FFEBLD_opSUBSTR:
- expr = ffebld_left (expr);
- goto again; /* :::::::::::::::::::: */
-
- default:
- assert ("bad op for ffeequiv_update_init" == NULL);
- break;
- }
- }
- }
-}
-
-/* ffeequiv_update_save -- Update the SAVE flag for the area to TRUE
-
- ffeequiv eq;
- ffeequiv_update_save(eq);
-
- If the SAVE flag for the <eq> object is already set, return. Else,
- set it TRUE and call ffe*_update_save for all objects contained in
- this one. */
-
-void
-ffeequiv_update_save (ffeequiv eq)
-{
- ffebld list; /* Current list in list of lists. */
- ffebld item; /* Current item in current list. */
- ffebld expr; /* Expression in head of current item. */
-
- if (eq->is_save)
- return;
-
- eq->is_save = TRUE;
-
- if ((eq->common != NULL)
- && !ffesymbol_is_save (eq->common))
- ffesymbol_update_save (eq->common); /* Shouldn't be needed. */
-
- for (list = eq->list; list != NULL; list = ffebld_trail (list))
- {
- for (item = ffebld_head (list); item != NULL; item = ffebld_trail (item))
- {
- expr = ffebld_head (item);
-
- again: /* :::::::::::::::::::: */
-
- switch (ffebld_op (expr))
- {
- case FFEBLD_opANY:
- break;
-
- case FFEBLD_opSYMTER:
- if (!ffesymbol_is_save (ffebld_symter (expr)))
- ffesymbol_update_save (ffebld_symter (expr));
- break;
-
- case FFEBLD_opARRAYREF:
- expr = ffebld_left (expr);
- goto again; /* :::::::::::::::::::: */
-
- case FFEBLD_opSUBSTR:
- expr = ffebld_left (expr);
- goto again; /* :::::::::::::::::::: */
-
- default:
- assert ("bad op for ffeequiv_update_save" == NULL);
- break;
- }
- }
- }
-}
projects / msp430-gcc.git / blobdiff