equivalence.c File Reference

#include <stdio.h>
#include "genC.h"
#include "linear.h"
#include "ri.h"
#include "ri-util.h"
#include "workspace-util.h"
#include "parser_private.h"
#include "properties.h"
#include "misc.h"
#include "syntax.h"

Include dependency graph for equivalence.c:

Go to the source code of this file.

Macros
#define	EQUIADD   0
	lint More...
#define	EQUIMERGE   1

Functions
void	ResetChains ()
	undefine chains between two successives calls to parser More...
void	SetChains ()
	initialize chains before each call to the parser More...
atom	MakeEquivAtom (syntax s)
	this function creates an atom of an equivalence chain. More...
void	StoreEquivChain (chain c)
	This function is called when an equivalence chain has been completely parsed. More...
void	ComputeEquivalences ()
	This function merges all the equivalence chains to take into account equivalences due to transitivity. More...
int	AddOrMergeChain (chain ct)
	this function adds a chain ct to the set of equivalences. More...
int	ChainIntersection (cons *opc1, cons *opc2)
	this function returns true if the there is a variable that occurs in both atom lists. More...
cons *	MergeTwoChains (cons *opc1, cons *opc2)
	this function merges two equivalence chains whose intersection is not empty, ie. More...
void	PrintChains (equivalences e)
	two debugging functions, just in case ... More...
void	PrintChain (chain c)
bool	entity_in_equivalence_chains_p (entity e)
bool	entity_in_equivalence_chain_p (entity e, chain c)
void	ComputeAddresses ()
	This function computes an address for every variable. More...
void	SaveChains ()
	Initialize the shared fields of aliased variables. More...

Variables
char	vcid_syntax_equivalence [] = "$Id: equivalence.c 23065 2016-03-02 09:05:50Z coelho $"
	Support and resolve equivalence chains. More...
static equivalences	TempoEquivSet = equivalences_undefined
	external variables used by functions from equivalence.c More...
static equivalences	FinalEquivSet = equivalences_undefined

Macro Definition Documentation

EQUIADD

#define EQUIADD   0

lint

equivalence.c: contains EQUIVALENCE related routines

Definition at line 54 of file equivalence.c.

EQUIMERGE

#define EQUIMERGE   1

Definition at line 55 of file equivalence.c.

Function Documentation

AddOrMergeChain()

int AddOrMergeChain

(

chain

ct

)

this function adds a chain ct to the set of equivalences.

if the intersection with all other chains is empty, ct is just added to the set. Otherwise ct is merged with the chain that intersects ct.

Parameters

ct

t

Definition at line 269 of file equivalence.c.

{
    cons *pcl, *pcf, *pct;
 
    pct = chain_atoms(ct);
    chain_atoms(ct) = NIL;
    
    for (pcl = equivalences_chains(FinalEquivSet); pcl != NIL; pcl=CDR(pcl)) {
        chain cf;
 
        cf = CHAIN(CAR(pcl));
        pcf = chain_atoms(cf);
 
        if (ChainIntersection(pct, pcf)) {
            chain_atoms(cf) = MergeTwoChains(pct, pcf);
            return(EQUIMERGE);
        }
    }
 
    equivalences_chains(FinalEquivSet) =
            CONS(CHAIN, make_chain(pct), 
                 equivalences_chains(FinalEquivSet));
 
    return(EQUIADD);
}

References CAR, CDR, CHAIN, chain_atoms, ChainIntersection(), CONS, EQUIADD, EQUIMERGE, equivalences_chains, FinalEquivSet, make_chain(), MergeTwoChains(), and NIL.

Referenced by ComputeEquivalences().

Here is the call graph for this function:

Here is the caller graph for this function:

ChainIntersection()

int ChainIntersection	(	cons *	opc1,
		cons *	opc2
	)

this function returns true if the there is a variable that occurs in both atom lists.

Parameters

opc1	pc1
opc2	pc2

Definition at line 302 of file equivalence.c.

{
    cons *pc1, *pc2;
    
    for (pc1 = opc1; pc1 != NIL; pc1 = CDR(pc1))
            for (pc2 = opc2; pc2 != NIL; pc2 = CDR(pc2))
                    if (gen_eq((atom_equivar(ATOM(CAR(pc1)))),
                               (atom_equivar(ATOM(CAR(pc2))))))
                            return(true);
 
    return(false);
}

References ATOM, atom_equivar, CAR, CDR, gen_eq(), and NIL.

Referenced by AddOrMergeChain().

Here is the call graph for this function:

Here is the caller graph for this function:

ComputeAddresses()

void ComputeAddresses

(

void

)

This function computes an address for every variable.

Three different cases are adressed: variables in user-declared commons, static variables and dynamic variables.

Variables may have:

• an undefined storage because they have the default dynamic storage or because they should inherit their storage from an equivalence chain. The inherited storage can be "user-declared common", "static" or even "dynamic".
• a user-declared common storage. The offsets of these variables can be computed from the common partial layout. Offsets for variables equivalenced to one of them are derived and the layouts are updated.
• a static storage: the offset must be unknown on entrance in this function.
• a dynamic storage: this is forbidden because there is no DYNAMIC declaration. The Fortran programmer does not have a way to enforce explictly a dynamic storage. All dynamic variables have an undefined storage upon entrance.
• a non-ram storage: this obviously is forbidden.

All variables explictly declared in a common have a storage fully defined within this common (see update_common_layout() which must have been called before entering ComputeAddresses()). If such a variable occurs in an equivalence chain, all other variables of this chain will have an address in this common. The exact address depends on the offset stored in the atom.

The variables allocated in the static and dynamic areas are handled differently from variables explicitly declared in a common because the programmer does not have a direct control over the offset as within a common declaration. An arbitrary allocation is performed. The same kind of processing is done for chains containing a static variable or only dynamic variables (i.e. each variable in the chain has an undefined storage).

Static variables obviously have a partially defined storage since they are recognized as static.

Each equivalence chain should be either attached to a user-declared common or to the static area or to the dynamic area of the current module.

Static and dynamic chains are processed in a similar way. The size of each chain is computed and the space for the chain is allocated in the corresponding area. As for user-declared commons (but with no good reason?) only one representant of each chain is added to the layouts of the area.

When the processing of equivalenced variables is completed, non-equivalenced static or dynamic (i.e. variables with undefined storage) variables are allocated.

Finally equivalenced variables are appended to the layouts of the static and dynamic areas. This makes update_common_layout() unapplicable.

As a result, variables declared in the static and dynamic area are not ordered by increasing offsets.

the default section for variables with no address is the dynamic area.

Try to locate the area for the current equivalence chain. Only one variable should have a well-defined storage. Or no variables have one because the equivalence chain is located in the dynamic area.

Compute the total size of the chain. This only should be used for the static and dynamic areas

FI: I do not understand why this assignment is not better guarded. Maybe, because lc's later use is guarded.

A variable may be located in a static area because of a SAVE (?) or a DATA statement and be equivalenced with a variable in a common.

Same as above but in a different order

Let's hope this is due to a DATA and not to a SAVE

Compute the offset and set the storage information for each variable in the equivalence chain that has no storage yet.

check that the offset is positive

Static aliases cannot be added right away because implicitly declared static variables still have to be added whereas aliased variables are assumed to be put behind in the layout list. Except the first one.

Well, I'm not so sure!

Add e in sc'layout and check that sc's size does not have to be increased as for: COMMON /FOO/X REAL Y(100) EQUIVALENCE (X,Y)

Dynamic aliases cannot be added right away because implicitly declared dynamic variables still have to be added whereas aliased variables are assumed to be put behind in the layout list. Except the first one.

If sc really is a common, i.e. neither the dynamic nor the static area, check its size

Varying size arrays must be stack allocated. This is an implicit extension that is not compatible with EQUIVALENCE

This test will fail for stack allocatable varying length character strings because of function SizeOfElements() which cannot indicate failure. Let's wait for the problem...

Try to reallocate in stack area

Formal parameters can have varying sizes

Allocatable arrays can have varying sizes

Could be declared explicitly or implicitly STATIC or be EQUIVALENCEd with such a variable. It could be declared in a COMMON.

The array size is known at compile time. Allocate in synamic area.

All declared variables are scanned and stored in the dynamic area if their storage is still undefined or in the static area if their offsets are still unkown.

This should be the case for all non-aliased static variables and most dynamic variables.

area da = type_area(entity_type(DynamicArea));

area_layout(da) = gen_nconc(area_layout(da), CONS(ENTITY, e, NIL));

area sa = type_area(entity_type(StaticArea));

area_layout(sa) = gen_nconc(area_layout(sa), CONS(ENTITY, e, NIL));

Must be stack area

Add aliased dynamic variables

neither gen_concatenate() nor gen_append() are OK

side effect on area_layout

Add aliased static variables

neither gen_concatenate() nor gen_append() are OK

side effect on area_layout

The sizes of the static and dynamic areas are now known

Definition at line 503 of file equivalence.c.

{
    cons *pcc, *pca, *pcv;
    entity sc;
    int lc, l, ac;
    list dynamic_aliases = NIL;
    list static_aliases = NIL;
 
    pips_debug(1, "Begin\n");
 
    if (FinalEquivSet != equivalences_undefined) {
        for (pcc = equivalences_chains(FinalEquivSet); pcc != NIL; 
             pcc = CDR(pcc)) {
            chain c = CHAIN(CAR(pcc));
 
            /* the default section for variables with no address is the dynamic
             * area.  */
            sc = DynamicArea;
            lc = 0;
            ac = 0;
 
            /* Try to locate the area for the current equivalence chain.
             * Only one variable should have a well-defined storage.
             * Or no variables have one because the equivalence chain 
             * is located in the dynamic area.
             */
            for (pca = chain_atoms(c); pca != NIL; pca = CDR(pca)) {
                entity e;
                int o;
 
                e = atom_equivar(ATOM(CAR(pca)));
                o = atom_equioff(ATOM(CAR(pca)));
 
                /* Compute the total size of the chain. This only should
                   be used for the static and dynamic areas */
                /* FI: I do not understand why this assignment is not better guarded.
                 * Maybe, because lc's later use *is* guarded.
                 */
                if ((l = SafeSizeOfArray(e)) > lc-o)
                    lc = l+o;
 
                if (entity_storage(e) != storage_undefined) {
                    if (storage_ram_p(entity_storage(e))) {
                        ram r = storage_ram(entity_storage(e));
 
                        if (sc != ram_section(r)) {
                            if (sc == DynamicArea) {
                                sc = ram_section(r);
                                ac = ram_offset(r)-o;
                            } 
                            else if (sc == StaticArea) {
                                /* A variable may be located in a static area because
                                 * of a SAVE (?) or a DATA statement and be equivalenced
                                 * with a variable in a common.
                                 */
                                pips_assert("ComputeAddresses", ram_section(r) != DynamicArea);
                                sc = ram_section(r);
                                ac = ram_offset(r)-o;
                            }
                            else if(ram_section(r) == StaticArea) {
                              /* Same as above but in a different order */
                              /* Let's hope this is due to a DATA and not to a SAVE */
                              ram_section(r) = sc;
                            }
                            else {
                                user_warning("ComputeAddresses",
                                             "Incompatible default area %s and "
                                             "area %s requested by equivalence for %s\n",
                                             entity_name(sc), entity_name(ram_section(r)),
                                             entity_local_name(e));
                                ParserError("ComputeAddresses",
                                            "incompatible areas\n");
                            }
                        }
                    }
                    else
                        FatalError("ComputeAddresses", "non ram storage\n");
                }
            }
 
            /* Compute the offset and set the storage information for each
             * variable in the equivalence chain that has no storage yet.
             */
            for (pca = chain_atoms(c); pca != NIL; pca = CDR(pca)) {
                entity e;
                int o, adr;
 
                e = atom_equivar(ATOM(CAR(pca)));
                o = atom_equioff(ATOM(CAR(pca)));
 
                if (sc == DynamicArea || sc == StaticArea) {
                    ac = area_size(type_area(entity_type(sc)));
                }
 
                /* check that the offset is positive */
                if ((adr = ac+o) < 0) {
                    user_warning("ComputeAddresses", "Offset %d for %s in common /%s/.\n",
                                 ac+o, entity_local_name(e), entity_local_name(sc));
                    ParserError("ComputeAddresses", 
                                "Attempt to extend common backwards. "
                                "Have you checked the code with a Fortran compiler?\n");
                }
 
                if ((entity_storage(e)) != storage_undefined) {
                    ram r;
                    r = storage_ram(entity_storage(e));
 
                    if (adr != ram_offset(r)) {
                        if(ram_offset(r)==UNKNOWN_RAM_OFFSET && ram_section(r)==StaticArea) {
                            ram_offset(r) = adr;
                            if(sc == StaticArea && pca != chain_atoms(c)) {
                                /* Static aliases cannot be added right away because
                                 * implicitly declared static variables still have to
                                 * be added whereas aliased variables are assumed to be
                                 * put behind in the layout list. Except the first one.
                                 *
                                 * Well, I'm not so sure!
                                 */
                                static_aliases = arguments_add_entity(static_aliases, e);
                            }
                            else {
                                area a = type_area(entity_type(sc));
 
                                area_layout(a) = gen_nconc(area_layout(a),
                                                           CONS(ENTITY, e, NIL));
                            }
                        }
                        else if(ram_offset(r)==UNKNOWN_RAM_OFFSET) {
                          ram_offset(r) = adr;
                        }
                        else {
                            user_warning("ComputeAddresses",
                                         "Two conflicting offsets for %s: %d and %d\n",
                                         entity_local_name(e), adr, ram_offset(r));
                            ParserError("ComputeAddresses", "incompatible addresses\n");
                        }
                    }
                }
                else {
                    area a = type_area(entity_type(sc));
 
                    entity_storage(e) = 
                        make_storage(is_storage_ram,
                                     (make_ram(get_current_module_entity(), 
                                               sc, adr, NIL)));
                    /* Add e in sc'layout and check that sc's size
                     * does not have to be increased as for:
                     * COMMON /FOO/X
                     * REAL Y(100)
                     * EQUIVALENCE (X,Y)
                     */
                    pips_assert("Entity e is not yet in sc's layout", 
                                !entity_is_argument_p(e,area_layout(a)));
                    if(sc == DynamicArea && pca != chain_atoms(c)) {
                        /* Dynamic aliases cannot be added right away because
                         * implicitly declared dynamic variables still have to
                         * be added whereas aliased variables are assumed to be
                         * put behind in the layout list. Except the first one.
                         */
                        dynamic_aliases = arguments_add_entity(dynamic_aliases, e);
                    }
                    else {
                        area_layout(a) = gen_nconc(area_layout(a),
                                                   CONS(ENTITY, e, NIL));
                    }
 
                    /* If sc really is a common, i.e. neither the *dynamic*
                     * nor the *static* area, check its size
                     */
                    if(top_level_entity_p(sc)) {
                        int s = common_to_size(sc);
                        int new_s = adr + SafeSizeOfArray(e);
                        if(s < new_s) {
                            (void) update_common_to_size(sc, new_s);
                        }
                    }
                }
            }
 
            if (sc == DynamicArea || sc == StaticArea)
                area_size(type_area(entity_type(sc))) += lc;
 
        }
    }
 
    /* Varying size arrays must be stack allocated. This is an implicit
       extension that is not compatible with EQUIVALENCE */
 
    if(get_bool_property("PARSER_ACCEPT_ANSI_EXTENSIONS")) {
      pips_debug(2, "Process stack variables\n");
 
      for (pcv = code_declarations(EntityCode(get_current_module_entity())); pcv != NIL;
           pcv = CDR(pcv)) {
        entity a = ENTITY(CAR(pcv));
        int s;
 
        /* This test will fail for stack allocatable varying length
           character strings because of function SizeOfElements() which
           cannot indicate failure. Let's wait for the problem... */
        if(type_variable_p(entity_type(a))
           && !(!storage_undefined_p(entity_storage(a)) && storage_formal_p(entity_storage(a)))
           && !SizeOfArray(a, &s)) {
          /* Try to reallocate in stack area */
          s = 0;
          if(storage_undefined_p(entity_storage(a))) {
            entity_storage(a) = make_storage(is_storage_ram,
                                             make_ram(get_current_module_entity(),
                                                      StackArea,
                                                      UNKNOWN_RAM_OFFSET,
                                                      NIL));
 
            pips_debug(8, "Variable %s allocated in stack\n", entity_local_name(a));
          }
          else if(storage_formal_p(entity_storage(a))) {
            /* Formal parameters can have varying sizes */
            ;
          }
          else if(storage_ram_p(entity_storage(a))) {
            entity sec = ram_section(storage_ram(entity_storage(a)));
 
            if(sec==DynamicArea) {
              ram_section(storage_ram(entity_storage(a)))=StackArea;
              pips_debug(8, "Variable %s reallocated in stack\n", entity_local_name(a));
            }
            else if(sec==HeapArea) {
              /* Allocatable arrays can have varying sizes */
              ;
            }
            else {
              /* Could be declared explicitly or implicitly STATIC or be
                 EQUIVALENCEd with such a variable. It could be declared
                 in a COMMON. */
              pips_user_warning("Variable %s with varying dimension cannot be reallocated"
                                " in stack because it has already been allocated in %s\n",
                                entity_local_name(a), entity_local_name(sec));
              ParserError(__FUNCTION__, "Storage cannot be redefined to stack");
            }
          }
          else {
            pips_internal_error("Unexpected storage for entity %s",
                                entity_local_name(a));
          }
        }
        else {
          /* The array size is known at compile time. Allocate in synamic
             area. */
          ;
        }
      }
    }
 
    /* All declared variables are scanned and stored in the dynamic area if their
     * storage is still undefined or in the static area if their offsets are still
     * unkown.
     *
     * This should be the case for all non-aliased static variables and most dynamic
     * variables.
     *
     */
 
    pips_debug(2, "Process left-over dynamic variables\n");
 
    for (pcv = code_declarations(EntityCode(get_current_module_entity())); pcv != NIL;
         pcv = CDR(pcv)) {
        entity e = ENTITY(CAR(pcv));
 
        if (entity_storage(e) == storage_undefined) {
            /* area da = type_area(entity_type(DynamicArea)); */
 
            pips_debug(2, "Add dynamic non-aliased variable %s\n",
                  entity_local_name(e));
 
            entity_storage(e) = 
                make_storage(is_storage_ram,
                             (make_ram(get_current_module_entity(), 
                                       DynamicArea, 
                                       current_offset_of_area(DynamicArea,
                                                              e), NIL)));
            /* area_layout(da) = gen_nconc(area_layout(da), CONS(ENTITY, e, NIL)); */
        }
        else if(storage_ram_p(entity_storage(e))) {
            ram r = storage_ram(entity_storage(e));
            if(ram_offset(r)==UNKNOWN_RAM_OFFSET) {
                if(ram_section(r)==StaticArea) {
                    /* area sa = type_area(entity_type(StaticArea)); */
 
                    pips_debug(2, "Add static non-aliased variable %s\n",
                          entity_local_name(e));
 
                    ram_offset(r) = current_offset_of_area(StaticArea, e);
                    /* area_layout(sa) = gen_nconc(area_layout(sa), CONS(ENTITY, e, NIL)); */
                }
                else if(ram_section(r)==HeapArea) {
                    area ha = type_area(entity_type(HeapArea));
 
                    pips_debug(2,
                          "Ignore heap variable %s because its address cannot be computed\n",
                          entity_local_name(e));
                    area_layout(ha) = gen_nconc(area_layout(ha), CONS(ENTITY, e, NIL));
                }
                else {
                  /* Must be stack area */
                    area sa = type_area(entity_type(StackArea));
 
                    pips_debug(2,
                          "Ignore stack variable %s because its address cannot be computed\n",
                          entity_local_name(e));
                    area_layout(sa) = gen_nconc(area_layout(sa), CONS(ENTITY, e, NIL));
                }
            }
        }
     }
 
    /* Add aliased dynamic variables */
    if(!ENDP(dynamic_aliases)) {
        /* neither gen_concatenate() nor gen_append() are OK */
        list dynamics = area_layout(type_area(entity_type(DynamicArea)));
 
        ifdebug(2) {
            pips_debug(2, "There are dynamic aliased variables:");
            print_arguments(dynamic_aliases);
        }
 
        pips_assert("aliased dynamic variables imply standard dynamic variables",
                    !ENDP(dynamics));
        /* side effect on area_layout */
        (void) gen_nconc(dynamics, dynamic_aliases);
    }
 
    /* Add aliased static variables */
    if(!ENDP(static_aliases)) {
        /* neither gen_concatenate() nor gen_append() are OK */
        list statics = area_layout(type_area(entity_type(StaticArea)));
 
        ifdebug(2) {
            pips_debug(2, "There are static aliased variables:");
            print_arguments(static_aliases);
        }
 
        pips_assert("aliased static variables imply standard static variables",
                    !ENDP(statics));
        /* side effect on area_layout */
        (void) gen_nconc(statics, static_aliases);
    }
 
    /* The sizes of the static and dynamic areas are now known */
    update_common_to_size(StaticArea,
                          area_size(type_area(entity_type(StaticArea))));
    update_common_to_size(DynamicArea,
                          area_size(type_area(entity_type(DynamicArea))));
 
    pips_debug(1, "End\n");
}

References area_layout, area_size, arguments_add_entity(), ATOM, atom_equioff, atom_equivar, CAR, CDR, CHAIN, chain_atoms, code_declarations, common_to_size(), CONS, current_offset_of_area(), DynamicArea, ENDP, ENTITY, entity_is_argument_p(), entity_local_name(), entity_name, entity_storage, entity_type, EntityCode(), equivalences_chains, equivalences_undefined, FatalError, FinalEquivSet, gen_nconc(), get_bool_property(), get_current_module_entity(), HeapArea, ifdebug, is_storage_ram, make_ram(), make_storage(), NIL, ParserError(), pips_assert, pips_debug, pips_internal_error, pips_user_warning, print_arguments(), ram_offset, ram_section, SafeSizeOfArray(), SizeOfArray(), StackArea, StaticArea, storage_formal_p, storage_ram, storage_ram_p, storage_undefined, storage_undefined_p, top_level_entity_p(), type_area, type_variable_p, UNKNOWN_RAM_OFFSET, update_common_to_size(), and user_warning.

Referenced by EndOfProcedure().

Here is the call graph for this function:

Here is the caller graph for this function:

ComputeEquivalences()

void ComputeEquivalences

(

void

)

This function merges all the equivalence chains to take into account equivalences due to transitivity.

It is called at the end of the parsing.

They should be properly initialized by SetChains if (FinalEquivSet == equivalences_undefined) { FinalEquivSet = make_equivalences(NIL); }

Definition at line 215 of file equivalence.c.

{
    cons *pc;
    int again = true;
 
    pips_debug(8, "Begin\n");
 
    /*
    if (TempoEquivSet == equivalences_undefined) {
        pips_debug(8, "Useless call, end\n");
            return;
    }
    */
 
    if (ENDP(equivalences_chains(TempoEquivSet))) {
        pips_debug(8, "No equivalences to process, end\n");
            return;
    }
 
    /* They should be properly initialized by SetChains
    if (FinalEquivSet == equivalences_undefined) {
        FinalEquivSet = make_equivalences(NIL);
    }
    */
 
    pips_debug(8, "Initial equivalence chains\n");
    PrintChains(TempoEquivSet);
 
    while (again) {
        for (pc = equivalences_chains(TempoEquivSet); pc != NIL; pc = CDR(pc))
            again = (AddOrMergeChain(CHAIN(CAR(pc))) == EQUIMERGE);
 
        if (again) {
            free_equivalences(TempoEquivSet);
            TempoEquivSet = FinalEquivSet;
            FinalEquivSet = make_equivalences(NIL);
 
            pips_debug(8, "Intermediate equivalence chains\n");
            PrintChains(TempoEquivSet);
        }
    }
 
    pips_debug(8, "Resulting equivalence chains\n");
 
    PrintChains(FinalEquivSet);
 
    pips_debug(8, "End\n");
}

References AddOrMergeChain(), CAR, CDR, CHAIN, ENDP, EQUIMERGE, equivalences_chains, FinalEquivSet, free_equivalences(), make_equivalences(), NIL, pips_debug, PrintChains(), and TempoEquivSet.

Referenced by EndOfProcedure().

Here is the call graph for this function:

Here is the caller graph for this function:

entity_in_equivalence_chain_p()

bool entity_in_equivalence_chain_p	(	entity	e,
		chain	c
	)

Definition at line 420 of file equivalence.c.

{
    cons *pca;
    atom a;
    bool is_in_p = false;
 
    pips_debug(9, "Begin for entity %s \n", entity_name(e));
 
    for (pca = chain_atoms(c); !ENDP(pca) && !is_in_p; POP(pca)) {
        a = ATOM(CAR(pca));
 
        is_in_p = (atom_equivar(a) == e);
    }
    pips_debug(9, "End\n");
    return is_in_p;
}

References ATOM, atom_equivar, CAR, chain_atoms, ENDP, entity_name, pips_debug, and POP.

Referenced by entity_in_equivalence_chains_p().

Here is the caller graph for this function:

entity_in_equivalence_chains_p()

bool entity_in_equivalence_chains_p

(

entity

e

)

Apparently, TempoEquivSet stays undefined when there are no equivalences

Definition at line 403 of file equivalence.c.

{
    equivalences equiv = TempoEquivSet;
    list pcc;
    bool is_in_p = false;
 
    /* Apparently, TempoEquivSet stays undefined when there are no equivalences */
    if(!equivalences_undefined_p(equiv)) {
        for (pcc = equivalences_chains(equiv); !ENDP(pcc) && !is_in_p; POP(pcc)) {
            is_in_p = entity_in_equivalence_chain_p(e, CHAIN(CAR(pcc)));
        }
    }
 
    return is_in_p;
}

References CAR, CHAIN, ENDP, entity_in_equivalence_chain_p(), equivalences_chains, equivalences_undefined_p, POP, and TempoEquivSet.

Referenced by remove_ghost_variable_entities().

Here is the call graph for this function:

Here is the caller graph for this function:

MakeEquivAtom()

atom MakeEquivAtom

(

syntax

s

)

this function creates an atom of an equivalence chain.

s is a reference to a variable.

reference offset

substring offset

Equivalenced variables cannot be initialized by a DATA statement: false

In case, the entity is not of type variable, reject it.

In case an adjustable array which is not a formal parameter has been encountered, reject it.

what is the offset of this reference ?

Definition at line 89 of file equivalence.c.

{
    reference r = reference_undefined;
    entity e;
    int o = 0; /* reference offset */
    int so = 0; /* substring offset */
 
    if (!syntax_reference_p(s)) {
        pips_assert("This is syntax is a call", syntax_call_p(s));
        if(strcmp(entity_local_name(call_function(syntax_call(s))), 
                  SUBSTRING_FUNCTION_NAME) == 0) {
            list args = call_arguments(syntax_call(s));
            syntax ss = expression_syntax(EXPRESSION(CAR(args)));
            expression lb = EXPRESSION(CAR(CDR(args)));
 
            pips_assert("syntax is reference",syntax_reference_p(ss));
 
            r = syntax_reference(ss);
            if(expression_constant_p(lb)) {
                so = expression_to_int(lb)-1;
            }
            else {
                ParserError("MakeEquivAtom",
                            "Non constant substring lower bound in equivalence chain\n");
            }
        }
        else {
            pips_user_warning("A function call to %s has been identified by the parser "
                              "in an EQUIVALENCE statement. Maybe an array declaration "
                              "should be moved up ahead of the EQUIVALENCE\n",
                              module_local_name(call_function(syntax_call(s))));
            ParserError("MakeEquivAtom", "function call in equivalence chain\n");
        }
    }
    else {
        r = syntax_reference(s);
        so = 0;
    }
 
    e = reference_variable(r);
 
    if(!storage_undefined_p(entity_storage(e)) && formal_parameter_p(e)) {
      pips_user_warning("Formal parameter %s appears in EQUIVALENCE declaration\n",
                        entity_local_name(e));
            ParserError("MakeEquivAtom", "Formal parameter in equivalence chain\n");
    }
 
    /* Equivalenced variables cannot be initialized by a DATA statement: false */
    /*
    if(value_defined_p(entity_initial(e))) {
      pips_user_warning("Initialized variable %s appears in EQUIVALENCE declaration\n",
                        entity_local_name(e));
            ParserError("MakeEquivAtom", "Initialized variable in equivalence chain\n");
    }
    */
 
    /* In case, the entity is not of type variable, reject it. */
    if(!type_variable_p(entity_type(e))) {
      pips_user_warning("Illegal symbol %s appears in EQUIVALENCE declaration\n",
                        entity_local_name(e));
      ParserError("MakeEquivAtom", "Functional variable (?) in equivalence chain.\n");
    }
 
    /* In case an adjustable array which is not a formal parameter has
       been encountered, reject it. */
    if(!array_with_numerical_bounds_p(e)) {
      pips_user_warning("Adjustable array %s appears in EQUIVALENCE declaration\n",
                        entity_local_name(e));
      ParserError("MakeEquivAtom", "Adjustable array in equivalence chain\n");
    }
 
    /* what is the offset of this reference ? */
    o = so + OffsetOfReference(r);
 
    pips_debug(8, "Offset %d for reference to %s\n",
          o, entity_local_name(e));
 
    return(make_atom(e, o));
}

References array_with_numerical_bounds_p(), call_arguments, call_function, CAR, CDR, entity_local_name(), entity_storage, entity_type, EXPRESSION, expression_constant_p(), expression_syntax, expression_to_int(), formal_parameter_p(), make_atom(), module_local_name(), OffsetOfReference(), ParserError(), pips_assert, pips_debug, pips_user_warning, reference_undefined, reference_variable, storage_undefined_p, SUBSTRING_FUNCTION_NAME, syntax_call, syntax_call_p, syntax_reference, syntax_reference_p, and type_variable_p.

Here is the call graph for this function:

MergeTwoChains()

cons* MergeTwoChains	(	cons *	opc1,
		cons *	opc2
	)

this function merges two equivalence chains whose intersection is not empty, ie.

one variable occurs in both chains.

Parameters

opc1	pc1
opc2	pc2

Definition at line 322 of file equivalence.c.

{
    int deltaoff;
    cons *pctemp, *pc1, *pc2=NIL;
 
    for (pc1 = opc1; pc1 != NIL; pc1 = CDR(pc1)) {
        for (pc2 = opc2; pc2 != NIL; pc2 = CDR(pc2)) {
            if (gen_eq((atom_equivar(ATOM(CAR(pc1)))),
                       (atom_equivar(ATOM(CAR(pc2)))))) {
                break;
            }
        }
        if (pc2 != NIL)
                break;
    }
 
    if (pc1 == NIL || pc2 == NIL)
            FatalError("MergeTwoChains", "empty intersection\n");
 
    deltaoff = atom_equioff(ATOM(CAR(pc1)))-atom_equioff(ATOM(CAR(pc2)));
 
    if (deltaoff < 0) {
        pctemp = opc2; opc2 = opc1; opc1 = pctemp;
    }
    pc1 = opc1;
    pc2 = opc2;
 
    while (1) {
        atom_equioff(ATOM(CAR(pc2))) += abs(deltaoff);
        if (CDR(pc2) == NIL)
                break;
        pc2 = CDR(pc2);
    }
 
    CDR(pc2) = pc1;
    return(opc2);
}

References abs, ATOM, atom_equioff, atom_equivar, CAR, CDR, FatalError, gen_eq(), and NIL.

Referenced by AddOrMergeChain().

Here is the call graph for this function:

Here is the caller graph for this function:

PrintChain()

void PrintChain

(

chain

c

)

Definition at line 382 of file equivalence.c.

{
    cons *pca;
    atom a;
 
    ifdebug(9) {
        pips_debug(9, "Begin: ");
 
        for (pca = chain_atoms(c); pca != NIL; pca = CDR(pca)) {
            a = ATOM(CAR(pca));
 
            (void) fprintf(stderr, "(%s,%td) ; ",
                           entity_name(atom_equivar(a)), atom_equioff(a));
        }
        (void) fprintf(stderr, "\n");
        pips_debug(9, "End\n");
    }
}

References ATOM, atom_equioff, atom_equivar, CAR, CDR, chain_atoms, entity_name, fprintf(), ifdebug, NIL, and pips_debug.

Referenced by PrintChains().

Here is the call graph for this function:

Here is the caller graph for this function:

PrintChains()

void PrintChains

(

equivalences

e

)

two debugging functions, just in case ...

Definition at line 364 of file equivalence.c.

{
    cons *pcc;
 
    if(ENDP(equivalences_chains(e))) {
        ifdebug(9) {
            (void) fprintf(stderr, "Empty list of equivalence chains\n");
        }
    }
    else {
        for (pcc = equivalences_chains(e); pcc != NIL; pcc = CDR(pcc)) {
            PrintChain(CHAIN(CAR(pcc)));
        }
    }
}

References CAR, CDR, CHAIN, ENDP, equivalences_chains, fprintf(), ifdebug, NIL, and PrintChain().

Referenced by ComputeEquivalences().

Here is the call graph for this function:

Here is the caller graph for this function:

ResetChains()

void ResetChains

(

void

)

undefine chains between two successives calls to parser

Definition at line 65 of file equivalence.c.

{
    free_equivalences(TempoEquivSet);
    free_equivalences(FinalEquivSet);
    TempoEquivSet = equivalences_undefined;
    FinalEquivSet = equivalences_undefined;
}

References equivalences_undefined, FinalEquivSet, free_equivalences(), and TempoEquivSet.

Referenced by EndOfProcedure(), gfc2pips_namespace(), and ParserError().

Here is the call graph for this function:

Here is the caller graph for this function:

SaveChains()

void SaveChains

(

void

)

Initialize the shared fields of aliased variables.

shared = CONS(ENTITY, atom_equivar(ATOM(CAR(pa))), shared);

Check conflicting intializations

Definition at line 859 of file equivalence.c.

{
    pips_debug(8, "Begin\n");
 
    if (FinalEquivSet == equivalences_undefined) {
    pips_debug(8, "No equivalence to process. End\n");
        return;
    }
 
    MAPL(pc, {
        cons *shared = NIL;
        chain c = CHAIN(CAR(pc));
 
        pips_debug(8, "Process an equivalence chain:\n");
 
        MAPL(pa, {
          shared = gen_once(atom_equivar(ATOM(CAR(pa))), shared);
          /* shared = CONS(ENTITY, atom_equivar(ATOM(CAR(pa))), shared); */
        }, chain_atoms(c));
        
        pips_assert("SaveChains", !ENDP(shared));
 
        MAPL(pa, {
            atom a = ATOM(CAR(pa));
            entity e = atom_equivar(a);
            storage se = entity_storage(e);
            ram re = storage_ram(se);
 
            pips_debug(8, "\talias %s\n", entity_name(e));
 
            ram_shared(re) = gen_copy_seq(shared);
 
        }, chain_atoms(c));
 
        /* Check conflicting intializations */
        MAPL(pa, {
            atom a = ATOM(CAR(pa));
            entity e = atom_equivar(a);
            storage se = entity_storage(e);
            ram re = storage_ram(se);
            list lce = ram_shared(re);
 
            if(value_defined_p(entity_initial(e))
               && !value_unknown_p(entity_initial(e))) {
              pips_debug(8,
                    "\tCheck initalization consistency for %s\n",
                    entity_name(e));
              MAP(ENTITY, ce, {
                if(e!=ce && variable_entities_may_conflict_p(e, ce)) {
                  if(value_defined_p(entity_initial(ce))
                     && !value_unknown_p(entity_initial(ce))) {
                    pips_user_warning("Overlapping initializations for %s and %s\n",
                                      entity_local_name(e), entity_local_name(ce));
                    ParserError("SaveChains",
                                "ANSI extension: overlapping initializations\n");
                  }
                }
              }, lce);
            }
 
        }, chain_atoms(c));
 
    }, equivalences_chains(FinalEquivSet));
 
    pips_debug(8, "End\n");
}

References ATOM, atom_equivar, CAR, CHAIN, chain_atoms, ENDP, ENTITY, entity_initial, entity_local_name(), entity_name, entity_storage, equivalences_chains, equivalences_undefined, FinalEquivSet, gen_copy_seq(), gen_once(), MAP, MAPL, NIL, ParserError(), pips_assert, pips_debug, pips_user_warning, ram_shared, storage_ram, value_defined_p(), value_unknown_p, and variable_entities_may_conflict_p().

Referenced by EndOfProcedure().

Here is the call graph for this function:

Here is the caller graph for this function:

SetChains()

void SetChains

(

void

)

initialize chains before each call to the parser

Definition at line 76 of file equivalence.c.

{
    pips_assert("TempoEquivSet is undefined", equivalences_undefined_p(TempoEquivSet));
    pips_assert("FinalEquivSet is undefined", equivalences_undefined_p(FinalEquivSet));
    TempoEquivSet = make_equivalences(NIL);
    FinalEquivSet = make_equivalences(NIL);
}

References equivalences_undefined_p, FinalEquivSet, make_equivalences(), NIL, pips_assert, and TempoEquivSet.

Referenced by MakeCurrentFunction().

Here is the call graph for this function:

Here is the caller graph for this function:

StoreEquivChain()

void StoreEquivChain

(

chain

c

)

This function is called when an equivalence chain has been completely parsed.

It looks for the atom with the biggest offset, and then substracts this maximum offset from all atoms. The result is that each atom has its offset from the begining of the chain.

Definition at line 176 of file equivalence.c.

{
    cons * pc;
    int maxoff;
 
    maxoff = 0;
    for (pc = chain_atoms(c); pc != NIL; pc = CDR(pc)) {
        int o = atom_equioff(ATOM(CAR(pc)));
 
        if (o > maxoff)
                maxoff = o;
    }
 
    pips_debug(9, "maxoff %d\n", maxoff);
 
    if (maxoff > 0) {
        for (pc = chain_atoms(c); pc != NIL; pc = CDR(pc)) {
            atom a = ATOM(CAR(pc));
 
            atom_equioff(a) = abs(atom_equioff(a)-maxoff);
        }
    }
 
    /*
    if (TempoEquivSet == equivalences_undefined) {
        TempoEquivSet = make_equivalences(NIL);
    }
    */
    pips_assert("The TempoEquivSet is defined", !equivalences_undefined_p(TempoEquivSet));
 
    equivalences_chains(TempoEquivSet) = 
            CONS(CHAIN, c, equivalences_chains(TempoEquivSet));
}

References abs, ATOM, atom_equioff, CAR, CDR, CHAIN, chain_atoms, CONS, equivalences_chains, equivalences_undefined_p, NIL, pips_assert, pips_debug, and TempoEquivSet.

Variable Documentation

FinalEquivSet

equivalences FinalEquivSet = equivalences_undefined

static

Definition at line 60 of file equivalence.c.

Referenced by AddOrMergeChain(), ComputeAddresses(), ComputeEquivalences(), ResetChains(), SaveChains(), and SetChains().

TempoEquivSet

equivalences TempoEquivSet = equivalences_undefined

static

external variables used by functions from equivalence.c

Definition at line 59 of file equivalence.c.

Referenced by ComputeEquivalences(), entity_in_equivalence_chains_p(), ResetChains(), SetChains(), and StoreEquivChain().

vcid_syntax_equivalence

char vcid_syntax_equivalence[] = "$Id: equivalence.c 23065 2016-03-02 09:05:50Z coelho $"

Support and resolve equivalence chains.

equivalence.c

Allocate addresses in commons and in the static area and in the dynamic area. The heap area is left aside.

Definition at line 33 of file equivalence.c.