declarations2.c File Reference

#include <stdio.h>
#include <string.h>
#include "genC.h"
#include "text.h"
#include "constants.h"
#include "text-util.h"
#include "properties.h"
#include "misc.h"
#include "linear.h"
#include "ri.h"
#include "ri-util.h"
#include "pipsdbm.h"
#include "workspace-util.h"
#include "prettyprint.h"

Include dependency graph for declarations2.c:

Go to the source code of this file.

Macros
#define	EQUIV_DEBUG   8
	debugging for equivalences More...
#define	ADD_WORD_LIST_TO_TEXT(t, l)   ADD_WORD_LIST_TO_TEXT_WITH_MARGIN(t, l, 0)
	To deal with declarations above ri-util and pipsdbm and text-util. More...
#define	ADD_WORD_LIST_TO_TEXT_WITH_MARGIN(t, l, m)

Functions
static list	f77_f95_style_management (list prev, string str, bool allocatable_pass_p, bool space_p)
	This handle the fact that a Fortran95 declaration use "::" as a separator between type and variable name. More...
static text	include (const char *file)
	if the common is declared similarly in all routines, generate "include 'COMMON.h'", and the file is put in Src. More...
static void	equiv_class_debug (list l_equiv)
static int	equivalent_entity_compare (entity *ent1, entity *ent2)
	static int equivalent_entity_compare(entity *ent1, entity *ent2) input : two pointers on entities. More...
static text	text_equivalence_class (list l_equiv)
	static text text_equivalence_class(list l_equiv) input : a list of entities representing an equivalence class. More...
static text	text_equivalences (entity __attribute__((unused)) module, list ldecl, bool no_commons)
	input : the current module, and the list of declarations. More...
static sentence	sentence_f95use_declaration (entity e)
	Create a sentence for a USE directive. More...
static sentence	sentence_external (entity f)
static sentence	sentence_symbolic (entity f, list *ppdl)
static sentence	sentence_data (entity e)
	why is it assumed that the constant is an int ??? More...
static sentence	sentence_area (entity e, entity module, bool pp_dimensions, list *ppdl)
	special management of empty commons added. More...
static sentence	sentence_basic_declaration (entity e)
static sentence	sentence_data_statement (statement is, list *ppdl)
	Prettyprint the initializations field of code. More...
static text	text_of_parameters (list lp)
static string	default_common_hook (entity __attribute__((unused)) module, entity common)
	We add this function to cope with the declaration When the user declare sth. More...
void	reset_prettyprinter_common_hook (void)
static text	text_area_included (entity common, entity module)
static text	text_entity_declaration (entity module, list ldecl, bool force_common, list *ppdl)
	This function compute the list of declaration at the begining of a module. More...
text	text_declaration (entity module)
	exported for hpfc. More...
text	text_common_declaration (entity common, entity module)
	needed for hpfc More...
text	text_initializations (entity m)
static text	__attribute__ ((unused))
	returns the DATA initializations. More...

Variables
static string(*	common_hook )(entity, entity)

Macro Definition Documentation

ADD_WORD_LIST_TO_TEXT

#define ADD_WORD_LIST_TO_TEXT	(		t,
			l
	)		ADD_WORD_LIST_TO_TEXT_WITH_MARGIN(t, l, 0)

To deal with declarations above ri-util and pipsdbm and text-util.

Definition at line 54 of file declarations2.c.

ADD_WORD_LIST_TO_TEXT_WITH_MARGIN

#define ADD_WORD_LIST_TO_TEXT_WITH_MARGIN	(		t,
			l,
			m
	)

Value:

  if (!ENDP(l)) ADD_SENTENCE_TO_TEXT(t,\
             make_sentence(is_sentence_unformatted, \
               make_unformatted(NULL, 0, m, l)));

Definition at line 55 of file declarations2.c.

EQUIV_DEBUG

#define EQUIV_DEBUG   8

debugging for equivalences

Definition at line 48 of file declarations2.c.

Function Documentation

__attribute__()

static text __attribute__ ( (unused)  )

static

returns the DATA initializations.

limited to integers, because I do not know where is the value for other types... of entity

of sentence

Definition at line 1273 of file declarations2.c.

{
  list /* of sentence */ ls = NIL;
 
  FOREACH(ENTITY, e, ldecl)
      {
        value v = entity_initial(e);
        if(!value_undefined_p(v) &&
           value_constant_p(v) && constant_int_p(value_constant(v)))
          ls = CONS(SENTENCE, sentence_data(e), ls);
      }
 
  return make_text(ls);
}

References CONS, constant_int_p, ENTITY, entity_initial, FOREACH, make_text(), NIL, SENTENCE, sentence_data(), value_constant, value_constant_p, and value_undefined_p.

Here is the call graph for this function:

default_common_hook()

static string default_common_hook ( entity __attribute__((unused))  module, entity  common  )

static

We add this function to cope with the declaration When the user declare sth.

there's no need to declare sth. for the user. When nothing is declared ( especially there is no way to know whether it's a SUBROUTINE or PROGRAM). We will go over the entire module to find all the variables and declare them properly. Lei ZHOU 18/10/91

the float length is now tested to generate REAL*4 or REAL*8. ??? something better could be done, printing "TYPE*%d". the problem is that you cannot mix REAL*4 and REAL*8 in the same program Fabien Coelho 12/08/93 and 15/09/93

pf4 and pf8 distinction added, FC 26/10/93

Is it really a good idea to print overloaded type variables~? FC 15/09/93 PARAMETERS added. FC 15/09/93

typed PARAMETERs FC 13/05/94 EXTERNALS are missing: added FC 13/05/94

Bug: parameters and their type should be put before other declarations since they may use them. Changed FC 08/06/94

COMMONS are also missing:-) added, FC 19/08/94

updated to fully control the list to be used. hook for commons, when not generated...

Definition at line 773 of file declarations2.c.

{
  return strdup(concatenate
                ("common to include: ", entity_local_name(common), "\n", NULL));
}

References concatenate(), entity_local_name(), and strdup().

Referenced by reset_prettyprinter_common_hook().

Here is the call graph for this function:

Here is the caller graph for this function:

equiv_class_debug()

static void equiv_class_debug ( list  l_equiv )

static

Definition at line 101 of file declarations2.c.

{
  if (ENDP(l_equiv))
    fprintf(stderr, "<none>");
  MAP(ENTITY, equiv_ent,
      {
        fprintf(stderr, " %s", entity_local_name(equiv_ent));
      }, l_equiv);
  fprintf(stderr, "\n");
}

References ENDP, ENTITY, entity_local_name(), fprintf(), and MAP.

Referenced by text_equivalence_class(), and text_equivalences().

Here is the call graph for this function:

Here is the caller graph for this function:

equivalent_entity_compare()

static int equivalent_entity_compare ( entity *  ent1, entity *  ent2  )

static

static int equivalent_entity_compare(entity *ent1, entity *ent2) input : two pointers on entities.

output : an integer for qsort. modifies : nothing. comment : this is a comparison function for qsort; the purpose being to order a list of equivalent variables. algorithm: If two variables have the same offset, the longest one comes first; if they have the same length, use a lexicographic ordering. author: bc.

pips_debug(1, "entities: %s %s\n", entity_local_name(*ent1), entity_local_name(*ent2));

pips_debug(1, "same offset\n");

pips_debug(1, "same size\n");

Definition at line 123 of file declarations2.c.

{
  int result;
  int offset1 = ram_offset(storage_ram(entity_storage(*ent1)));
  int offset2 = ram_offset(storage_ram(entity_storage(*ent2)));
  Value size1, size2;
 
  result = offset1 - offset2;
 
  /* pips_debug(1, "entities: %s %s\n", entity_local_name(*ent1),
     entity_local_name(*ent2)); */
 
  if (result == 0)
    {
      /* pips_debug(1, "same offset\n"); */
      size1 = ValueSizeOfArray(*ent1);
      size2 = ValueSizeOfArray(*ent2);
      result = value_compare(size2,size1);
 
      if (result == 0)
        {
          /* pips_debug(1, "same size\n"); */
          result = strcmp(entity_local_name(*ent1), entity_local_name(*ent2));
        }
    }
 
  return(result);
}

References entity_local_name(), entity_storage, ram_offset, storage_ram, value_compare, and ValueSizeOfArray().

Referenced by text_equivalence_class().

Here is the call graph for this function:

Here is the caller graph for this function:

f77_f95_style_management()

static list f77_f95_style_management ( list  prev, string  str, bool  allocatable_pass_p, bool  space_p  )

static

This handle the fact that a Fortran95 declaration use "::" as a separator between type and variable name.

It also adds an "allocatable" modifier if requested. Finally it add a "," between each variable if there more than one to declare.

Definition at line 67 of file declarations2.c.

                                                   {
  list result = prev;
  if (prev == NIL) {
    result = CHAIN_SWORD(result, str);
    if(allocatable_pass_p) {
      result = CHAIN_SWORD(result, ", ALLOCATABLE ");
    }
    if (prettyprint_language_is_fortran95_p ()) {
      result = CHAIN_SWORD(result, ":: ");
    }
  }
  else {
    result = CHAIN_SWORD(result, space_p? ", " : ",");
  }
  return result;
}

References CHAIN_SWORD, NIL, and prettyprint_language_is_fortran95_p().

Referenced by text_entity_declaration().

Here is the call graph for this function:

Here is the caller graph for this function:

include()

static text include ( const char *  file )

static

if the common is declared similarly in all routines, generate "include 'COMMON.h'", and the file is put in Src.

otherwise the full local declarations are generated. That's fun.

Definition at line 92 of file declarations2.c.

{
  return make_text
    (CONS(SENTENCE,
          make_sentence(is_sentence_formatted,
                        strdup(concatenate("      include '", file, "'\n", NULL))),
          NIL));
}

References concatenate(), CONS, is_sentence_formatted, make_sentence(), make_text(), NIL, SENTENCE, and strdup().

Referenced by c_code_string(), and text_area_included().

Here is the call graph for this function:

Here is the caller graph for this function:

reset_prettyprinter_common_hook()

void reset_prettyprinter_common_hook

(

void

)

Definition at line 787 of file declarations2.c.

{
  common_hook=default_common_hook;
}

References common_hook, and default_common_hook().

Referenced by hpfc_print_code().

Here is the call graph for this function:

Here is the caller graph for this function:

sentence_area()

static sentence sentence_area ( entity  e, entity  module, bool  pp_dimensions, list *  ppdl  )

static

special management of empty commons added.

this may happen in the hpfc generated code.

FI: POINTER declarations should be generated for the heap area

shouldn't get in?

the common is not output if it is empty

Definition at line 549 of file declarations2.c.

{
    const char* area_name = module_local_name(e);
    type te = entity_type(e);
    list pc = NIL, entities = NIL;
    bool space_p = get_bool_property("PRETTYPRINT_LISTS_WITH_SPACES");
 
    /* FI: POINTER declarations should be generated for the heap area */
    if (dynamic_area_p(e) || heap_area_p(e) || stack_area_p(e) || pointer_dummy_targets_area_p(e)) /* shouldn't get in? */
        return sentence_undefined;
 
    assert(type_area_p(te));
 
    if (!ENDP(area_layout(type_area(te))))
    {
        bool pp_hpfc = get_bool_property("PRETTYPRINT_HPFC");
 
        if (pp_hpfc)
            entities = gen_copy_seq(area_layout(type_area(te)));
        else
            entities = common_members_of_module(e, module, true);
 
        /*  the common is not output if it is empty
         */
        if (!ENDP(entities))
        {
            bool comma = false, is_save = static_area_p(e);
 
            if (is_save)
            {
                pc = CHAIN_SWORD(pc, "SAVE ");
            }
            else
            {
                pc = CHAIN_SWORD(pc, "COMMON ");
                if (strcmp(area_name, BLANK_COMMON_LOCAL_NAME) != 0)
                {
                    pc = CHAIN_SWORD(pc, "/");
                    pc = CHAIN_SWORD(pc, area_name);
                    pc = CHAIN_SWORD(pc, "/ ");
                }
            }
 
            MAP(ENTITY, ee,
             {
                 if (comma) pc = CHAIN_SWORD(pc, space_p? ", " : ",");
                 else comma = true;
                 pc = gen_nconc(pc,
                                words_declaration(ee, !is_save && pp_dimensions, ppdl));
             },
                 entities);
 
            gen_free_list(entities);
        }
        else
        {
            pips_user_warning("empty common %s for module %s encountered...\n",
                              entity_name(e), entity_name(module));
            return make_sentence(is_sentence_formatted,
               strdup(concatenate("!! empty common ", entity_local_name(e),
                                  " in module ", entity_local_name(module),
                                  "\n", NULL)));
        }
    }
 
    return make_sentence(is_sentence_unformatted,
                         make_unformatted(NULL, 0, get_prettyprint_indentation(), pc));
}

References area_layout, assert, BLANK_COMMON_LOCAL_NAME, CHAIN_SWORD, common_members_of_module(), concatenate(), dynamic_area_p(), ENDP, ENTITY, entity_local_name(), entity_name, entity_type, gen_copy_seq(), gen_free_list(), gen_nconc(), get_bool_property(), get_prettyprint_indentation(), heap_area_p(), is_sentence_formatted, is_sentence_unformatted, make_sentence(), make_unformatted(), MAP, module, module_local_name(), NIL, pips_user_warning, pointer_dummy_targets_area_p(), sentence_undefined, stack_area_p(), static_area_p(), strdup(), type_area, type_area_p, and words_declaration().

Referenced by text_entity_declaration().

Here is the call graph for this function:

Here is the caller graph for this function:

sentence_basic_declaration()

static sentence sentence_basic_declaration ( entity  e )

static

Definition at line 618 of file declarations2.c.

{
  list decl = NIL;
  basic b = entity_basic(e);
 
  pips_assert("b is defined", !basic_undefined_p(b));
 
  decl = CHAIN_SWORD(decl, basic_to_string(b));
  decl = CHAIN_SWORD(decl, " ");
  decl = CHAIN_SWORD(decl, entity_local_name(e));
 
  return(make_sentence(is_sentence_unformatted,
                       make_unformatted(NULL, 0, get_prettyprint_indentation(), decl)));
}

References basic_to_string(), basic_undefined_p, CHAIN_SWORD, entity_basic(), entity_local_name(), get_prettyprint_indentation(), is_sentence_unformatted, make_sentence(), make_unformatted(), NIL, and pips_assert.

Referenced by text_entity_declaration(), and text_of_parameters().

Here is the call graph for this function:

Here is the caller graph for this function:

sentence_data()

static sentence sentence_data ( entity  e )

static

why is it assumed that the constant is an int ???

Definition at line 522 of file declarations2.c.

{
  list pc = NIL;
  constant c;
 
  if (! value_constant_p(entity_initial(e)))
    return(sentence_undefined);
 
  c = value_constant(entity_initial(e));
 
  if (! constant_int_p(c))
    return(sentence_undefined);
 
  pc = CHAIN_SWORD(pc, "DATA ");
  pc = CHAIN_SWORD(pc, entity_local_name(e));
  pc = CHAIN_SWORD(pc, " /");
  pc = CHAIN_IWORD(pc, constant_int(c));
  pc = CHAIN_SWORD(pc, "/");
 
  return(make_sentence(is_sentence_unformatted,
                       make_unformatted(NULL, 0, get_prettyprint_indentation(), pc)));
}

References CHAIN_IWORD, CHAIN_SWORD, constant_int, constant_int_p, entity_initial, entity_local_name(), get_prettyprint_indentation(), is_sentence_unformatted, make_sentence(), make_unformatted(), NIL, sentence_undefined, value_constant, and value_constant_p.

Referenced by __attribute__().

Here is the call graph for this function:

Here is the caller graph for this function:

sentence_data_statement()

static sentence sentence_data_statement ( statement  is, list *  ppdl  )

static

Prettyprint the initializations field of code.

Argument List

Reference List

reference list expression, i.e. call to DATA LIST

DATA LIST entity function

Find all initialized variables pending from DATA LIST

Move al to the first value

Print all values

print out the repeat factor if it is not one

Definition at line 635 of file declarations2.c.

{
  unformatted u =
    make_unformatted
    (NULL,
     STATEMENT_NUMBER_UNDEFINED, get_prettyprint_indentation(),
     CONS(STRING, strdup("DATA "), NIL));
  sentence s = make_sentence(is_sentence_unformatted, u);
  list wl = unformatted_words(u);
  instruction ii = statement_instruction(is);
  call ic = instruction_call(ii);
  entity ife = entity_undefined;
  list al = list_undefined; /* Argument List */
  list rl = list_undefined; /* Reference List */
  expression rle = expression_undefined; /* reference list expression, i.e. call to DATA LIST */
  entity rlf = entity_undefined; /* DATA LIST entity function */
  bool space_p = get_bool_property("PRETTYPRINT_LISTS_WITH_SPACES");
 
  pips_assert("An initialization instruction is a call", instruction_call_p(ii));
  ife = call_function(ic);
  pips_assert("The static initialization function is called",
              ENTITY_STATIC_INITIALIZATION_P(ife));
  al = call_arguments(ic);
 
  /* Find all initialized variables pending from DATA LIST */
  rle = EXPRESSION(CAR(al));
  POP(al); /* Move al to the first value */
  pips_assert("The first argument is a call", expression_call_p(rle));
  rlf = call_function(syntax_call(expression_syntax(rle)));
  pips_assert("This is the DATA LIST function", ENTITY_DATA_LIST_P(rlf));
  rl = call_arguments(syntax_call(expression_syntax(rle)));
 
  for(; !ENDP(rl); POP(rl)){
    expression ive = expression_undefined;
    list ivwl = list_undefined;
 
    if(rl!=call_arguments(syntax_call(expression_syntax(rle)))) {
      wl = CHAIN_SWORD(wl, strdup(space_p? ", " : ","));
    }
 
    ive = EXPRESSION(CAR(rl));
    ivwl = words_expression(ive, ppdl);
    wl = gen_nconc(wl, ivwl);
  }
 
  pips_assert("The value list is not empty", !ENDP(al));
 
  /* Print all values */
 
  wl = CHAIN_SWORD(wl, " /");
 
  for(; !ENDP(al); POP(al)){
    expression ve = EXPRESSION(CAR(al));
    call vc = syntax_call(expression_syntax(ve));
    list iwl = list_undefined;
 
    pips_assert("Values are encoded as calls", expression_call_p(ve));
 
    if(strcmp(module_local_name(call_function(vc)), REPEAT_VALUE_NAME)==0) {
      expression rfe = expression_undefined;
      expression rve = expression_undefined;
      list rwl = list_undefined;
 
      pips_assert("Pseudo-intrinsic REPEAT-VALUE must have two arguments",
                  gen_length(call_arguments(vc))==2);
 
      rfe = binary_call_lhs(vc);
      rve = binary_call_rhs(vc);
 
      if(!(integer_constant_expression_p(rfe) && expression_to_int(rfe)==1)) {
        /* print out the repeat factor if it is not one */
        rwl = words_expression(rfe, ppdl);
        wl = gen_nconc(wl, rwl);
        wl = gen_nconc(wl, CONS(STRING, strdup("*"), NIL));
      }
      iwl = words_expression(rve, ppdl);
      wl = gen_nconc(wl, iwl);
    }
    else {
      iwl = words_expression(ve, ppdl);
      wl = gen_nconc(wl, iwl);
    }
    if(!ENDP(CDR(al))) {
      wl = gen_nconc(wl, CONS(STRING, strdup(space_p? ", " : ","), NIL));
    }
  }
 
  wl = CHAIN_SWORD(wl, "/");
 
  return s;
}

References binary_call_lhs, binary_call_rhs, call_arguments, call_function, CAR, CDR, CHAIN_SWORD, CONS, ENDP, ENTITY_DATA_LIST_P, ENTITY_STATIC_INITIALIZATION_P, entity_undefined, EXPRESSION, expression_call_p(), expression_syntax, expression_to_int(), expression_undefined, gen_length(), gen_nconc(), get_bool_property(), get_prettyprint_indentation(), instruction_call, instruction_call_p, integer_constant_expression_p(), is_sentence_unformatted, list_undefined, make_sentence(), make_unformatted(), module_local_name(), NIL, pips_assert, POP, REPEAT_VALUE_NAME, statement_instruction, STATEMENT_NUMBER_UNDEFINED, strdup(), STRING, syntax_call, unformatted_words, and words_expression().

Referenced by text_initializations().

Here is the call graph for this function:

Here is the caller graph for this function:

sentence_external()

static sentence sentence_external ( entity  f )

static

Definition at line 493 of file declarations2.c.

{
  list pc = NIL;
 
  pc = CHAIN_SWORD(pc, "EXTERNAL ");
  pc = CHAIN_SWORD(pc, entity_local_name(f));
 
  return(make_sentence(is_sentence_unformatted,
                       make_unformatted(NULL, 0, get_prettyprint_indentation(), pc)));
}

References CHAIN_SWORD, entity_local_name(), f(), get_prettyprint_indentation(), is_sentence_unformatted, make_sentence(), make_unformatted(), and NIL.

Referenced by text_entity_declaration().

Here is the call graph for this function:

Here is the caller graph for this function:

sentence_f95use_declaration()

static sentence sentence_f95use_declaration ( entity  e )

static

Create a sentence for a USE directive.

@description Use directive is handled by copying the string directly in the name of the entity during the parsing. So we juste get the local name and put it in a sentence.

Returns

a sentence with correct indentation containing the whole use directive in one word.

Definition at line 482 of file declarations2.c.

                                                        {
  list decl = NIL;
 
  decl = CHAIN_SWORD(decl, entity_local_name(e));
 
  return (make_sentence(is_sentence_unformatted, make_unformatted(NULL,
                                                                  0,
                                                                  INDENTATION,
                                                                  decl)));
}

References CHAIN_SWORD, entity_local_name(), INDENTATION, is_sentence_unformatted, make_sentence(), make_unformatted(), and NIL.

Referenced by text_entity_declaration().

Here is the call graph for this function:

Here is the caller graph for this function:

sentence_symbolic()

static sentence sentence_symbolic ( entity  f, list *  ppdl  )

static

Definition at line 504 of file declarations2.c.

{
  list pc = NIL;
  value vf = entity_initial(f);
  expression e = symbolic_expression(value_symbolic(vf));
 
  pc = CHAIN_SWORD(pc, "PARAMETER (");
  pc = CHAIN_SWORD(pc, entity_local_name(f));
  pc = CHAIN_SWORD(pc, " = ");
  pc = gen_nconc(pc, words_expression(e, ppdl));
  pc = CHAIN_SWORD(pc, ")");
 
  return(make_sentence(is_sentence_unformatted,
                       make_unformatted(NULL, 0, get_prettyprint_indentation(), pc)));
}

References CHAIN_SWORD, entity_initial, entity_local_name(), f(), gen_nconc(), get_prettyprint_indentation(), is_sentence_unformatted, make_sentence(), make_unformatted(), NIL, symbolic_expression, value_symbolic, and words_expression().

Referenced by text_of_parameters().

Here is the call graph for this function:

Here is the caller graph for this function:

text_area_included()

static text text_area_included ( entity  common, entity  module  )

static

the include was generated once before...

same declaration, generate the file!

touch the nofile to avoid the inclusion check latter on.

Parameters

common	the common the declaration of which are of interest
module	the module dealt with

Definition at line 792 of file declarations2.c.

{
  string dir, file, local;
  const char* name;
  text t;
 
  dir = db_get_directory_name_for_module(WORKSPACE_SRC_SPACE);
  name = module_local_name(common);
  if (same_string_p(name, BLANK_COMMON_LOCAL_NAME))
    name = "blank";
  local = strdup(concatenate(name, ".h", NULL));
  file = strdup(concatenate(dir, "/", local, NULL));
  free(dir);
 
  if (file_exists_p(file))
    {
      /* the include was generated once before... */
      t = include(local);
    }
  else
    {
      string nofile =
        strdup(concatenate(file, ".sorry_common_not_homogeneous", NULL));
      t = text_common_declaration(common, module);
      if (!file_exists_p(nofile))
        {
          if (check_common_inclusion(common))
            {
              /* same declaration, generate the file! */
              FILE * f = safe_fopen(file, "w");
              fprintf(f, "!!\n!! pips: include file for common %s\n!!\n",
                      name);
              print_text(f, t);
              safe_fclose(f, file);
              t = include(local);
            }
          else
            {
              /* touch the nofile to avoid the inclusion check latter on. */
              FILE * f = safe_fopen(nofile, "w");
              fprintf(f,
                      "!!\n!! pips: sorry,  cannot include common %s\n!!\n",
                      name);
              safe_fclose(f, nofile);
            }
          free(nofile);
        }
    }
 
  free(local); free(file);
  return t;
}

References BLANK_COMMON_LOCAL_NAME, check_common_inclusion(), concatenate(), db_get_directory_name_for_module(), f(), file_exists_p(), fprintf(), free(), include(), module, module_local_name(), print_text(), safe_fclose(), safe_fopen(), same_string_p, strdup(), text_common_declaration(), and WORKSPACE_SRC_SPACE.

Referenced by text_entity_declaration().

Here is the call graph for this function:

Here is the caller graph for this function:

text_common_declaration()

text text_common_declaration	(	entity	common,
		entity	module
	)

needed for hpfc

Parameters

common	ommon
module	odule

Definition at line 1228 of file declarations2.c.

{
    type t = entity_type(common);
    list l;
    text result;
    list pdl = NIL; // Assumed Fortran only
    pips_assert("indeed a common", type_area_p(t));
    l = CONS(ENTITY, common, common_members_of_module(common, module, false));
    result = text_entity_declaration(module, l, true, &pdl);
    gen_free_list(l);
    gen_free_list(pdl);
    return result;
}

References common_members_of_module(), CONS, ENTITY, entity_type, gen_free_list(), module, NIL, pips_assert, text_entity_declaration(), and type_area_p.

Referenced by hpfc_print_common(), and text_area_included().

Here is the call graph for this function:

Here is the caller graph for this function:

text_declaration()

text text_declaration

(

entity

module

)

exported for hpfc.

Assume Fortran only!

Parameters

module

odule

Definition at line 1216 of file declarations2.c.

{
  /* Assume Fortran only! */
  list pdl = NIL;
  text t = text_entity_declaration
      (module, code_declarations(entity_code(module)), false, &pdl);
  gen_free_list(pdl);
  return t;
}

References code_declarations, entity_code(), gen_free_list(), module, NIL, and text_entity_declaration().

Referenced by ensure_comment_consistency(), and init_host_and_node_entities().

Here is the call graph for this function:

Here is the caller graph for this function:

text_entity_declaration()

static text text_entity_declaration ( entity  module, list  ldecl, bool  force_common, list *  ppdl  )

static

This function compute the list of declaration at the begining of a module.

It's intended to be used with Fortran or Fortran95 only

Parameters

ldecl	is the list of entity to be prettyprinted
force_common	will force the prettyprint of common in include

prettyprint common in include if possible...

Declarations cannot be sorted out because Fortran standard impose at least an order on parameters. Fortunately here, PARAMETER are mostly integers, defined from other integer parameters... I assume that PIPS would fail with an ENTRY referencing an integer array dimensionned with a real parameter. But real parameters are not really well processed by PIPS anyway... Also we are in trouble if arrays or functions are used dimension other arrays

list sorted_ldecl = gen_copy_seq(ldecl);

gen_sort_list(sorted_ldecl, compare_entities);

where to put the dimension information.

subroutines won't be declared

not parsed callee

Do not declare variables used to replace formal labels

PARAMETER

EXTERNAL

AREAS: COMMONS and SAVEs

simple integers are moved ahead...

nothing! some in hpfc I guess...

usually they are sorted in order, and appended backwards, hence the reversion.

all about COMMON and SAVE declarations

and EQUIVALENCE statements... - BC

sorted_

what about DATA statements! FC

More general way with with call to text_initializations(module) in text_named_module()

gen_free_list(sorted_ldecl);

We have to do a recursive call to get the allocatable declarations

Parameters

ldecl

of entity

Definition at line 856 of file declarations2.c.

{
  /*
   * allocatable_pass indicate if we want to prettyprint allocatable or non
   * allocatable entity, this is set to true during a second recursive pass.
   */
  static bool allocatable_pass_p = false;
  list allocatable_list = NULL;
 
  const char* how_common = get_string_property("PRETTYPRINT_COMMONS");
  bool print_commons = !same_string_p(how_common, "none");
  /* prettyprint common in include if possible... */
  bool pp_cinc = same_string_p(how_common, "include") && !force_common;
  list before = NIL, area_decl = NIL, pi1 = NIL, pi2 = NIL, pi4 = NIL, pi8 =
      NIL, ph1 = NIL, ph2 = NIL, ph4 = NIL, ph8 = NIL, pf4 = NIL, pf8 = NIL,
      pl = NIL, pc8 = NIL, pc16 = NIL, ps = NIL, lparam = NIL, uses = NIL;
  list * ppi = NULL;
  list * pph = NULL;
  text r, t_chars = make_text(NIL), t_area = make_text(NIL);
  const char* pp_var_dim = get_string_property("PRETTYPRINT_VARIABLE_DIMENSIONS");
  bool pp_in_type = false, pp_in_common = false;
  bool space_p = get_bool_property("PRETTYPRINT_LISTS_WITH_SPACES");
  /* Declarations cannot be sorted out because Fortran standard impose
   at least an order on parameters. Fortunately here, PARAMETER are
   mostly integers, defined from other integer parameters... I assume
   that PIPS would fail with an ENTRY referencing an integer array
   dimensionned with a real parameter. But real parameters are not
   really well processed by PIPS anyway... Also we are in trouble if
   arrays or functions are used dimension other arrays
 
   list sorted_ldecl = gen_copy_seq(ldecl);
 
   gen_sort_list(sorted_ldecl, compare_entities); */
 
  check_fortran_declaration_dependencies(ldecl);
 
 
  /*
   * Deals with indentation
   */
  list indentation_words = NIL;
  if( prettyprint_language_is_fortran95_p() ) {
    for(int i=0; i<INDENTATION; i++) {
      indentation_words = CHAIN_SWORD(indentation_words, " ");
    }
  }
 
  /* where to put the dimension information.
   */
  if (same_string_p(pp_var_dim, "type")) {
    pp_in_type = true, pp_in_common = false;
  } else if (same_string_p(pp_var_dim, "common")) {
    pp_in_type = false, pp_in_common = true;
  } else {
    pips_internal_error("PRETTYPRINT_VARIABLE_DIMENSIONS=\"%s\""
        " unexpected value\n", pp_var_dim);
  }
 
 
 
  FOREACH(ENTITY, e,ldecl) {
    type te = entity_type(e);
    bool func = type_functional_p(te) && storage_rom_p(entity_storage(e));
    value v = entity_initial(e);
    bool param = func && value_symbolic_p(v);
    bool external = /* subroutines won't be declared */
          (func
        && (value_code_p(v) || value_unknown_p(v) /* not parsed callee */)
        && !(type_void_p(functional_result(type_functional(te)))
            || (type_variable_p(functional_result(type_functional(te)))
                && basic_overloaded_p(variable_basic(type_variable
                        (functional_result(type_functional(te))))))));
    bool area_p = type_area_p(te);
    bool var = type_variable_p(te);
    bool in_ram = storage_ram_p(entity_storage(e));
    bool in_common = in_ram
        && !entity_special_area_p(ram_section(storage_ram(entity_storage(e))));
    bool skip_it = same_string_p(entity_local_name(e),
        entity_local_name(module));
 
    pips_debug(3, "entity name is %s\n", entity_name(e));
 
    /* Do not declare variables used to replace formal labels */
    if (storage_formal_p(entity_storage(e))
        && get_bool_property("PRETTYPRINT_REGENERATE_ALTERNATE_RETURNS")
        && formal_label_replacement_p(e))
      continue;
 
    if (!print_commons && area_p && !entity_special_area_p(e) && !pp_cinc) {
      area_decl = CONS(SENTENCE,
          make_sentence(is_sentence_formatted,
              common_hook(module, e)),
          area_decl);
    }
 
    if (skip_it) {
      pips_debug(5, "skipping function %s\n", entity_name(e));
    } else if (entity_f95use_p(e)) {
      uses = CONS(SENTENCE, sentence_f95use_declaration(e), uses);
    } else if (!print_commons && (area_p || (var && in_common && pp_cinc))) {
      pips_debug(5, "skipping entity %s\n", entity_name(e));
    } else if (param) {
      /*        PARAMETER
       */
      pips_debug(7, "considered as a parameter\n");
      lparam = CONS(ENTITY, e, lparam);
    } else if (external) {
      /*        EXTERNAL
       */
      pips_debug(7, "considered as an external\n");
      before = CONS(SENTENCE, sentence_basic_declaration(e), before);
      before = CONS(SENTENCE, sentence_external(e), before);
    } else if (area_p && !dynamic_area_p(e) && !heap_area_p(e)
               && !stack_area_p(e) && !pointer_dummy_targets_area_p(e) && !empty_static_area_p(e) ) {
      /*            AREAS: COMMONS and SAVEs
       */
      pips_debug(7, "considered as a regular common\n");
      if (pp_cinc && !entity_special_area_p(e)) {
        text t = text_area_included(e, module);
        MERGE_TEXTS(t_area, t);
      } else
        area_decl = CONS(SENTENCE,
            sentence_area(e, module, pp_in_common, ppdl),
            area_decl);
    } else if (var && !(in_common && pp_cinc)) {
      basic b = variable_basic(type_variable(te));
      bool pp_dim = pp_in_type || variable_static_p(e);
 
      pips_debug(7, "is a variable...\n");
 
      switch(basic_tag(b)) {
        case is_basic_int:
          /* simple integers are moved ahead... */
 
          pips_debug(7, "is an integer\n");
          if (variable_dimensions(type_variable(te))) {
            string s = string_undefined;
            switch(basic_int(b)) {
              case 4:
                ppi = &pi4;
                s = "INTEGER ";
                break;
              case 2:
                ppi = &pi2;
                s = "INTEGER*2 ";
                break;
              case 8:
                ppi = &pi8;
                s = "INTEGER*8 ";
                break;
              case 1:
                ppi = &pi1;
                s = "INTEGER*1 ";
                break;
 
              default:
                pips_internal_error("Unexpected integer size");
            }
 
            *ppi = f77_f95_style_management (*ppi, s, allocatable_pass_p, space_p);
            *ppi = gen_nconc(*ppi, words_declaration(e, pp_dim, ppdl));
          } else {
            string s = string_undefined;
 
            switch(basic_int(b)) {
              case 4:
                pph = &ph4;
                s = "INTEGER ";
                break;
              case 2:
                pph = &ph2;
                s = "INTEGER*2 ";
                break;
              case 8:
                pph = &ph8;
                s = "INTEGER*8 ";
                break;
              case 1:
                pph = &ph1;
                s = "INTEGER*1 ";
                break;
              default:
                pips_internal_error("Unexpected integer size");
            }
            *pph = f77_f95_style_management (*pph, s, allocatable_pass_p, space_p);
            *pph = gen_nconc(*pph, words_declaration(e, pp_dim, ppdl));
          }
          break;
        case is_basic_float:
          pips_debug(7, "is a float\n");
          switch(basic_float(b)) {
            case 4:
              pf4 = f77_f95_style_management(pf4, "REAL*4 ", allocatable_pass_p, space_p);
              pf4 = gen_nconc(pf4, words_declaration(e, pp_dim, ppdl));
              break;
            case 8:
            default:
              pf8 = f77_f95_style_management(pf8, "REAL*8 ", allocatable_pass_p, space_p);
              pf8 = gen_nconc(pf8, words_declaration(e, pp_dim, ppdl));
              break;
          }
          break;
        case is_basic_complex:
          pips_debug(7, "is a complex\n");
          switch(basic_complex(b)) {
            case 8:
              pc8 = f77_f95_style_management(pc8, "COMPLEX*8 ", allocatable_pass_p, space_p);
              pc8 = gen_nconc(pc8, words_declaration(e, pp_dim, ppdl));
              break;
            case 16:
            default:
              pc16 = f77_f95_style_management(pc16, "COMPLEX*16 ", allocatable_pass_p, space_p);
              pc16 = gen_nconc(pc16, words_declaration(e, pp_dim, ppdl));
              break;
          }
          break;
        case is_basic_logical:
          pips_debug(7, "is a logical\n");
          pl = CHAIN_SWORD(pl, pl==NIL ? "LOGICAL " : (space_p? ", " : ","));
          pl = gen_nconc(pl, words_declaration(e, pp_dim, ppdl));
          break;
        case is_basic_overloaded:
          /* nothing! some in hpfc I guess...
           */
          break;
        case is_basic_string: {
          value v = basic_string(b);
          pips_debug(7, "is a string\n");
 
          if (value_constant_p(v) && constant_int_p(value_constant(v))) {
            int i = constant_int(value_constant(v));
 
            if (i == 1) {
              ps = f77_f95_style_management(ps, "CHARACTER ", allocatable_pass_p, space_p);
              ps = gen_nconc(ps, words_declaration(e, pp_dim, ppdl));
            } else {
              list chars = NIL;
              chars = CHAIN_SWORD(chars, "CHARACTER*");
              chars = CHAIN_IWORD(chars, i);
              chars = CHAIN_SWORD(chars, " ");
              chars = gen_nconc(chars, words_declaration(e, pp_dim, ppdl));
              attach_declaration_size_type_to_words(chars, "CHARACTER", i);
              ADD_WORD_LIST_TO_TEXT_WITH_MARGIN(t_chars, chars,
                                                get_prettyprint_indentation());
            }
          } else if (value_unknown_p(v)) {
            list chars = NIL;
            chars = CHAIN_SWORD(chars, "CHARACTER*(*) ");
            chars = gen_nconc(chars, words_declaration(e, pp_dim, ppdl));
            attach_declaration_type_to_words(chars, "CHARACTER*(*)");
            ADD_WORD_LIST_TO_TEXT_WITH_MARGIN(t_chars, chars,
                                              get_prettyprint_indentation());
          } else if (value_symbolic_p(v)) {
            list chars = NIL;
            symbolic s = value_symbolic(v);
            chars = CHAIN_SWORD(chars, "CHARACTER*(");
            chars = gen_nconc(chars, words_expression(symbolic_expression(s),
                                                      ppdl));
            chars = CHAIN_SWORD(chars, ") ");
            chars = gen_nconc(chars, words_declaration(e, pp_dim, ppdl));
 
            attach_declaration_type_to_words(chars, "CHARACTER*(*)");
            ADD_WORD_LIST_TO_TEXT(t_chars, chars);
          } else
            pips_internal_error("unexpected value");
          break;
        }
        case is_basic_derived: {
          if(allocatable_pass_p) {
            pips_internal_error("We got an allocatable but we are inside"
                "allocatable pass !! This should be impossible...\n");
          }
          // Chains the entity to be declared, aka the array inside allocatable
          allocatable_list = CONS(entity,get_allocatable_data_entity(e),allocatable_list);
          break;
        }
        default:
          pips_internal_error("unexpected basic tag (%d)",
              basic_tag(b));
      }
    }
  }
 
 
  /* usually they are sorted in order, and appended backwards,
   * hence the reversion.
   */
  r = make_text(uses);
  MERGE_TEXTS(r, make_text(gen_nreverse(before)));
 
  MERGE_TEXTS(r, text_of_parameters(lparam));
  gen_free_list(lparam), lparam = NIL;
 
  ADD_WORD_LIST_TO_TEXT_WITH_MARGIN(r, ph1, get_prettyprint_indentation());
  attach_declaration_type_to_words(ph1, "INTEGER*1");
  ADD_WORD_LIST_TO_TEXT_WITH_MARGIN(r, ph2, get_prettyprint_indentation());
  attach_declaration_type_to_words(ph2, "INTEGER*2");
  ADD_WORD_LIST_TO_TEXT_WITH_MARGIN(r, ph4, get_prettyprint_indentation());
  attach_declaration_type_to_words(ph4, "INTEGER");
  ADD_WORD_LIST_TO_TEXT_WITH_MARGIN(r, ph8, get_prettyprint_indentation());
  attach_declaration_type_to_words(ph8, "INTEGER*8");
  ADD_WORD_LIST_TO_TEXT_WITH_MARGIN(r, pi1, get_prettyprint_indentation());
  attach_declaration_type_to_words(pi1, "INTEGER*1");
  ADD_WORD_LIST_TO_TEXT_WITH_MARGIN(r, pi2, get_prettyprint_indentation());
  attach_declaration_type_to_words(pi2, "INTEGER*2");
  ADD_WORD_LIST_TO_TEXT_WITH_MARGIN(r, pi4, get_prettyprint_indentation());
  attach_declaration_type_to_words(pi4, "INTEGER");
  ADD_WORD_LIST_TO_TEXT_WITH_MARGIN(r, pi8, get_prettyprint_indentation());
  attach_declaration_type_to_words(pi8, "INTEGER*8");
  ADD_WORD_LIST_TO_TEXT_WITH_MARGIN(r, pf4, get_prettyprint_indentation());
  attach_declaration_type_to_words(pf4, "REAL*4");
  ADD_WORD_LIST_TO_TEXT_WITH_MARGIN(r, pf8, get_prettyprint_indentation());
  attach_declaration_type_to_words(pf8, "REAL*8");
  ADD_WORD_LIST_TO_TEXT_WITH_MARGIN(r, pl, get_prettyprint_indentation());
  attach_declaration_type_to_words(pl, "LOGICAL");
  ADD_WORD_LIST_TO_TEXT_WITH_MARGIN(r, pc8, get_prettyprint_indentation());
  attach_declaration_type_to_words(pc8, "COMPLEX*8");
  ADD_WORD_LIST_TO_TEXT_WITH_MARGIN(r, pc16, get_prettyprint_indentation());
  attach_declaration_type_to_words(pc16, "COMPLEX*16");
  ADD_WORD_LIST_TO_TEXT_WITH_MARGIN(r, ps, get_prettyprint_indentation());
  attach_declaration_type_to_words(ps, "CHARACTER");
  MERGE_TEXTS(r, t_chars);
 
  /* all about COMMON and SAVE declarations
   */
  MERGE_TEXTS(r, make_text(area_decl));
  MERGE_TEXTS(r, t_area);
 
  /* and EQUIVALENCE statements... - BC
   */
  MERGE_TEXTS(r, text_equivalences(module, /* sorted_ */ldecl,
          pp_cinc || !print_commons));
 
  /* what about DATA statements! FC
   */
  /* More general way with with call to text_initializations(module) in
   text_named_module() */
  /*
   if(get_bool_property("PRETTYPRINT_DATA_STATEMENTS")) {
   MERGE_TEXTS(r, text_data(module, ldecl));
   }
   */
 
  /* gen_free_list(sorted_ldecl); */
 
  if(!allocatable_pass_p && !ENDP(allocatable_list)) {
    /* We have to do a recursive call to get the allocatable declarations */
    allocatable_pass_p = true;
    MERGE_TEXTS(r,text_entity_declaration(module,allocatable_list,force_common,ppdl));
    allocatable_pass_p = false;
  }
 
  return r;
}

References ADD_WORD_LIST_TO_TEXT, ADD_WORD_LIST_TO_TEXT_WITH_MARGIN, attach_declaration_size_type_to_words(), attach_declaration_type_to_words(), basic_complex, basic_float, basic_int, basic_overloaded_p, basic_string, basic_tag, CHAIN_IWORD, CHAIN_SWORD, check_fortran_declaration_dependencies(), common_hook, CONS, constant_int, constant_int_p, dynamic_area_p(), empty_static_area_p(), ENDP, ENTITY, entity_f95use_p(), entity_initial, entity_local_name(), entity_name, entity_special_area_p(), entity_storage, entity_type, f77_f95_style_management(), FOREACH, formal_label_replacement_p(), functional_result, gen_free_list(), gen_nconc(), gen_nreverse(), get_allocatable_data_entity(), get_bool_property(), get_prettyprint_indentation(), get_string_property(), heap_area_p(), INDENTATION, is_basic_complex, is_basic_derived, is_basic_float, is_basic_int, is_basic_logical, is_basic_overloaded, is_basic_string, is_sentence_formatted, make_sentence(), make_text(), MERGE_TEXTS, module, NIL, pips_debug, pips_internal_error, pl, pointer_dummy_targets_area_p(), prettyprint_language_is_fortran95_p(), ram_section, same_string_p, SENTENCE, sentence_area(), sentence_basic_declaration(), sentence_external(), sentence_f95use_declaration(), stack_area_p(), storage_formal_p, storage_ram, storage_ram_p, storage_rom_p, string_undefined, symbolic_expression, text_area_included(), text_equivalences(), text_of_parameters(), type_area_p, type_functional, type_functional_p, type_variable, type_variable_p, type_void_p, value_code_p, value_constant, value_constant_p, value_symbolic, value_symbolic_p, value_unknown_p, variable_basic, variable_dimensions, variable_static_p(), words_declaration(), and words_expression().

Referenced by text_common_declaration(), and text_declaration().

Here is the call graph for this function:

Here is the caller graph for this function:

text_equivalence_class()

static text text_equivalence_class ( list  l_equiv )

static

static text text_equivalence_class(list l_equiv) input : a list of entities representing an equivalence class.

output : a text, which is the prettyprint of this class. modifies : sorts l_equiv according to equivalent_entity_compare. comment : partially associated entities are not handled. author : bc.

FIRST, sort the list by increasing offset from the beginning of the memory suite. If two variables have the same offset, the longest one comes first; if they have the same lenght, use a lexicographic ordering

THEN, prettyprint the sorted list

At each step of the next loop, we consider two entities from the equivalence class. l1 points on the first entity list, and l2 on the second one. If l2 is associated with l1, we compute the output string, and l2 becomes the next entity. If l2 is not associated with l1, l1 becomes the next entity, until it is associated with l1. In the l_equiv list, l1 is always before l2.

loop initialization

If the two variables have the same offset, their first elements are equivalenced.

Else, we first check that there is an overlap

If there is no overlap, we change the reference variable

Else, we must compute the coordinates of the element of ent1 which corresponds to the first element of ent2

ATTENTION: Je n'ai pas considere le cas ou il y a association partielle. De ce fait, offset est divisiable par size_elt_1.

while

if-else: there is an overlap

if-else: not same offset

while

Parameters

l_equiv

of entities

Definition at line 159 of file declarations2.c.

{
  text t_equiv = make_text(NIL);
  list lw = NIL;
  list l1, l2;
  entity ent1, ent2;
  int offset1, offset2;
  Value size1, offset_end1;
  bool first;
  bool space_p = get_bool_property("PRETTYPRINT_LISTS_WITH_SPACES");
 
  if (gen_length(l_equiv)<=1) return t_equiv;
 
  /* FIRST, sort the list by increasing offset from the beginning of
     the memory suite. If two variables have the same offset, the longest
     one comes first; if they have the same lenght, use a lexicographic
     ordering */
  ifdebug(EQUIV_DEBUG)
  {
    pips_debug(1, "equivalence class before sorting:\n");
    equiv_class_debug(l_equiv);
  }
 
  gen_sort_list(l_equiv,
                (int (*)(const void *,const void *)) equivalent_entity_compare);
 
  ifdebug(EQUIV_DEBUG)
  {
    pips_debug(1, "equivalence class after sorting:\n");
    equiv_class_debug(l_equiv);
  }
 
  /* THEN, prettyprint the sorted list*/
  pips_debug(EQUIV_DEBUG,"prettyprint of the sorted list\n");
 
  /* At each step of the next loop, we consider two entities
   * from the equivalence class. l1 points on the first entity list,
   * and l2 on the second one. If l2 is associated with l1, we compute
   * the output string, and l2 becomes the next entity. If l2 is not
   * associated with l1, l1 becomes the next entity, until it is
   * associated with l1. In the l_equiv list, l1 is always before l2.
   */
 
  /* loop initialization */
  l1 = l_equiv;
  ent1 = ENTITY(CAR(l1));
  offset1 = ram_offset(storage_ram(entity_storage(ent1)));
  size1 = ValueSizeOfArray(ent1);
  l2 = CDR(l_equiv);
  first = true;
 
  while(!ENDP(l2))
    {
      ent2 = ENTITY(CAR(l2));
      offset2 = ram_offset(storage_ram(entity_storage(ent2)));
 
      pips_debug(EQUIV_DEBUG, "dealing with: %s %s\n",
                 entity_local_name(ent1),
                 entity_local_name(ent2));
 
      /* If the two variables have the same offset, their
       * first elements are equivalenced.
       */
      if (offset1 == offset2)
        {
          pips_debug(EQUIV_DEBUG, "easiest case: offsets are the same\n");
 
          if (first) lw = CHAIN_SWORD(lw, "EQUIVALENCE"), first = false;
          else lw = CHAIN_SWORD(lw, space_p? ", " : ",");
 
          lw = CHAIN_SWORD(lw, " (");
          lw = CHAIN_SWORD(lw, entity_local_name(ent1));
          lw = CHAIN_SWORD(lw, space_p? ", " : ",");
          lw = CHAIN_SWORD(lw, entity_local_name(ent2));
          lw = CHAIN_SWORD(lw, ")");
          POP(l2);
        }
      /* Else, we first check that there is an overlap */
      else
        {
          pips_assert("the equivalence class has been sorted\n",
                      offset1 < offset2);
 
          offset_end1 = value_plus(offset1, size1);
 
          /* If there is no overlap, we change the reference variable */
          if (value_le(offset_end1,offset2))
            {
              pips_debug(1, "second case: there is no overlap\n");
              POP(l1);
              ent1 = ENTITY(CAR(l1));
              offset1 = ram_offset(storage_ram(entity_storage(ent1)));
              size1 = ValueSizeOfArray(ent1);
              if (l1 == l2) POP(l2);
            }
 
          /* Else, we must compute the coordinates of the element of ent1
           * which corresponds to the first element of ent2
           */
          else
            {
              /* ATTENTION: Je n'ai pas considere le cas
               * ou il y a association partielle. De ce fait, offset
               * est divisiable par size_elt_1. */
              int offset = offset2 - offset1;
              int rest;
              int current_dim;
              int dim_max = NumberOfDimension(ent1);
              int size_elt_1 = SizeOfElements(
                                              variable_basic(type_variable(entity_type(ent1))));
              list l_tmp = variable_dimensions
                (type_variable(entity_type(ent1)));
              normalized nlo;
              Pvecteur pvlo;
 
              pips_debug(EQUIV_DEBUG, "third case\n");
              pips_debug(EQUIV_DEBUG,
                         "offset=%d, dim_max=%d, size_elt_1=%d\n",
                         offset, dim_max,size_elt_1);
 
              if (first) lw = CHAIN_SWORD(lw, "EQUIVALENCE"), first = false;
              else lw = CHAIN_SWORD(lw, space_p? ", " : ",");
 
              lw = CHAIN_SWORD(lw, " (");
              lw = CHAIN_SWORD(lw, entity_local_name(ent1));
              lw = CHAIN_SWORD(lw, "(");
 
              pips_assert("partial association case not implemented:\n"
                          "offset % size_elt_1 == 0",
                          (offset % size_elt_1) == 0);
 
              offset = offset/size_elt_1;
              current_dim = 1;
 
              while (current_dim <= dim_max)
                {
                  dimension dim = DIMENSION(CAR(l_tmp));
                  int new_decl;
                  int size;
 
                  pips_debug(EQUIV_DEBUG, "prettyprinting dimension %d\n",
                             current_dim);
                  size = SizeOfIthDimension(ent1, current_dim);
                  rest = (offset % size);
                  offset = offset / size;
                  nlo = NORMALIZE_EXPRESSION(dimension_lower(dim));
                  pvlo = normalized_linear(nlo);
 
                  pips_assert("sg", vect_constant_p(pvlo));
                  pips_debug(EQUIV_DEBUG,
                             "size=%d, rest=%d, offset=%d, lower_bound=%d\n",
                             size, rest, offset, (int)VALUE_TO_INT(val_of(pvlo)));
 
                  new_decl = VALUE_TO_INT(val_of(pvlo)) + rest;
                  lw = CHAIN_SWORD(lw,int2a(new_decl));
                  if (current_dim < dim_max)
                    lw = CHAIN_SWORD(lw, space_p? ", " : ",");
 
                  POP(l_tmp);
                  current_dim++;
 
                } /* while */
 
              lw = CHAIN_SWORD(lw, ")");
              lw = CHAIN_SWORD(lw, space_p? ", " : ",");
              lw = CHAIN_SWORD(lw, entity_local_name(ent2));
              lw = CHAIN_SWORD(lw, ")");
              POP(l2);
            } /* if-else: there is an overlap */
        } /* if-else: not same offset */
    } /* while */
  ADD_WORD_LIST_TO_TEXT(t_equiv, lw);
 
  pips_debug(EQUIV_DEBUG, "end\n");
  return t_equiv;
}

References ADD_WORD_LIST_TO_TEXT, CAR, CDR, CHAIN_SWORD, DIMENSION, dimension_lower, ENDP, ENTITY, entity_local_name(), entity_storage, entity_type, equiv_class_debug(), EQUIV_DEBUG, equivalent_entity_compare(), gen_length(), gen_sort_list(), get_bool_property(), ifdebug, int2a(), make_text(), NIL, NORMALIZE_EXPRESSION, normalized_linear, NumberOfDimension(), offset, pips_assert, pips_debug, POP, ram_offset, size_elt_1, SizeOfElements(), SizeOfIthDimension(), storage_ram, type_variable, val_of, value_le, value_plus, VALUE_TO_INT, ValueSizeOfArray(), variable_basic, variable_dimensions, and vect_constant_p().

Referenced by text_equivalences().

Here is the call graph for this function:

Here is the caller graph for this function:

text_equivalences()

static text text_equivalences ( entity __attribute__((unused))  module, list  ldecl, bool  no_commons  )

static

input : the current module, and the list of declarations.

output : a text for all the equivalences. modifies : nothing comment :

FIRST BUILD EQUIVALENCE CLASSES

consider each entity in the declaration

but only variables which have a ram storage must be considered

If this variable is statically aliased

We first look in already found equivalence classes if there is already a class in which one of the aliased variables appears

add the entities of shared which are not already in the existing equivalence class. Useful ??

!!!

add the list of variables in l_shared; necessary because variables may appear several times in l_shared.

!!! restricted to declared...

SECOND, PRETTYPRINT THEM

AND FREE THEM

THE END

Parameters

module	the module dealt with
ldecl	the list of declarations to consider
no_commons	whether to print common equivivalences

Definition at line 342 of file declarations2.c.

{
  list equiv_classes = NIL, l_tmp;
  text t_equiv_class;
 
  pips_debug(1,"begin\n");
 
  /* FIRST BUILD EQUIVALENCE CLASSES */
 
  pips_debug(EQUIV_DEBUG, "loop on declarations\n");
  /* consider each entity in the declaration */
  MAP(ENTITY, e,
      {
        storage s = entity_storage(e);
        /* but only variables which have a ram storage must be considered
         */
        if (type_variable_p(entity_type(e)) && storage_ram_p(s))
          {
            ram r = storage_ram(s);
            entity common = ram_section(r);
            list l_shared = ram_shared(r);
 
            if (no_commons && !entity_special_area_p(common))
              break;
 
            ifdebug(EQUIV_DEBUG)
            {
              pips_debug(1, "considering entity: %s\n",entity_local_name(e));
              pips_debug(1, "shared variables:\n");
              equiv_class_debug(l_shared);
            }
 
            /* If this variable is statically aliased */
            if (!ENDP(l_shared))
              {
                bool found = false;
                list found_equiv_class = NIL;
 
                /* We first look in already found equivalence classes
                 * if there is already a class in which one of the
                 * aliased variables appears
                 */
                MAP(LIST, equiv_class,
                    {
                      ifdebug(EQUIV_DEBUG)
                      {
                        pips_debug(1, "considering equivalence class:\n");
                        equiv_class_debug(equiv_class);
                      }
 
                      MAP(ENTITY, ent,
                          {
                            if (variable_in_list_p(ent, equiv_class))
                              {
                                found = true;
                                found_equiv_class = equiv_class;
                                break;
                              }
                          }, l_shared);
 
                      if (found) break;
                    },
                    equiv_classes);
 
                if (found)
                  {
                    pips_debug(EQUIV_DEBUG, "already there\n");
                    /* add the entities of shared which are not already in
                     * the existing equivalence class. Useful ??
                     */
                    MAP(ENTITY, ent,
                        {
                          if(!variable_in_list_p(ent, found_equiv_class) &&
                             variable_in_list_p(ent, ldecl)) /* !!! */
                            found_equiv_class =
                              CONS(ENTITY, ent, found_equiv_class);
                        }, l_shared)
                      }
                else
                  {
                    list l_tmp = NIL;
                    pips_debug(EQUIV_DEBUG, "not found\n");
                    /* add the list of variables in l_shared; necessary
                     * because variables may appear several times in
                     * l_shared. */
                    MAP(ENTITY, shared_ent,
                        {
                          if (!variable_in_list_p(shared_ent, l_tmp) &&
                              variable_in_list_p(shared_ent, ldecl))
                            /* !!! restricted to declared... */
                            l_tmp = CONS(ENTITY, shared_ent, l_tmp);
                        },
                        l_shared);
                    equiv_classes = CONS(LIST, l_tmp, equiv_classes);
                  }
              }
          }
      },
      ldecl);
 
  ifdebug(EQUIV_DEBUG)
  {
    pips_debug(1, "final equivalence classes:\n");
    MAP(LIST, equiv_class, equiv_class_debug(equiv_class), equiv_classes);
  }
 
  /* SECOND, PRETTYPRINT THEM */
  t_equiv_class = make_text(NIL);
  MAP(LIST, equiv_class,
      {
        MERGE_TEXTS(t_equiv_class, text_equivalence_class(equiv_class));
      }, equiv_classes);
 
  /* AND FREE THEM */
  for(l_tmp = equiv_classes; !ENDP(l_tmp); POP(l_tmp))
    {
      list equiv_class = LIST(CAR(l_tmp));
      gen_free_list(equiv_class);
      LIST(CAR(l_tmp)) = NIL;
    }
  gen_free_list(equiv_classes);
 
  /* THE END */
  pips_debug(EQUIV_DEBUG, "end\n");
  return(t_equiv_class);
}

References CAR, CONS, ENDP, ENTITY, entity_local_name(), entity_special_area_p(), entity_storage, entity_type, equiv_class_debug(), EQUIV_DEBUG, gen_free_list(), ifdebug, LIST, make_text(), MAP, MERGE_TEXTS, NIL, pips_debug, POP, ram_section, ram_shared, storage_ram, storage_ram_p, text_equivalence_class(), type_variable_p, and variable_in_list_p().

Referenced by text_entity_declaration().

Here is the call graph for this function:

Here is the caller graph for this function:

text_initializations()

text text_initializations

(

entity

m

)

The previous declaration list is useless in Fortran, but the signature of functions designed for C or Fortran must be respected.

Definition at line 1244 of file declarations2.c.

{
  text t = make_text(NIL);
  list il = list_undefined;
 
  pips_assert("m is a module", entity_module_p(m));
 
  il = sequence_statements(code_initializations(value_code(entity_initial(m))));
 
  FOREACH(STATEMENT, is, il) {
    /* The previous declaration list is useless in Fortran, but the
       signature of functions designed for C or Fortran must be
       respected. */
    list pdl = NIL;
    if(!empty_comments_p(statement_comments(is))) {
      ADD_SENTENCE_TO_TEXT(t, make_sentence(is_sentence_formatted,
                                            strdup(statement_comments(is))));
    }
    ADD_SENTENCE_TO_TEXT(t, sentence_data_statement(is, &pdl));
    gen_free_list(pdl);
  }
 
  return t;
}

References ADD_SENTENCE_TO_TEXT, code_initializations, empty_comments_p(), entity_initial, entity_module_p(), FOREACH, gen_free_list(), is_sentence_formatted, list_undefined, make_sentence(), make_text(), NIL, pips_assert, sentence_data_statement(), sequence_statements, STATEMENT, statement_comments, strdup(), and value_code.

Referenced by ensure_comment_consistency().

Here is the call graph for this function:

Here is the caller graph for this function:

text_of_parameters()

static text text_of_parameters ( list  lp )

static

of sentence

generate the sentences

Parameters

lp	of entity that are parameters

Definition at line 729 of file declarations2.c.

{
  list /* of sentence */ ls = NIL;
 
  /* generate the sentences
   */
  FOREACH(ENTITY, e, lp) {
    list pdl = NIL; // Assumed to be Fortran only
    ls = CONS(SENTENCE, sentence_basic_declaration(e),
              CONS(SENTENCE, sentence_symbolic(e, &pdl), ls));
  }
 
  return make_text(ls);
}

References CONS, ENTITY, FOREACH, make_text(), NIL, SENTENCE, sentence_basic_declaration(), and sentence_symbolic().

Referenced by text_entity_declaration().

Here is the call graph for this function:

Here is the caller graph for this function:

Variable Documentation

common_hook

string(* common_hook) (entity, entity) ( entity  , entity    )

staticdefault

Definition at line 780 of file declarations2.c.

{
  common_hook=f;
}

Referenced by reset_prettyprinter_common_hook(), and text_entity_declaration().