compile.c

Go to the documentation of this file.

/*
 
  $Id: compile.c 23495 2018-10-24 09:19:47Z coelho $
 
  Copyright 1989-2016 MINES ParisTech
 
  This file is part of PIPS.
 
  PIPS is free software: you can redistribute it and/or modify it
  under the terms of the GNU General Public License as published by
  the Free Software Foundation, either version 3 of the License, or
  any later version.
 
  PIPS is distributed in the hope that it will be useful, but WITHOUT ANY
  WARRANTY; without even the implied warranty of MERCHANTABILITY or
  FITNESS FOR A PARTICULAR PURPOSE.
 
  See the GNU General Public License for more details.
 
  You should have received a copy of the GNU General Public License
  along with PIPS.  If not, see <http://www.gnu.org/licenses/>.
 
*/
#ifdef HAVE_CONFIG_H
    #include "pips_config.h"
#endif
/* HPFC by Fabien Coelho, May 1993 and later...
 */
 
#include "defines-local.h"
 
#include "pipsdbm.h"
#include "workspace-util.h" // for reset_prettyprinter_common_hook
#include "prettyprint.h"
#include "resources.h"
#include "effects-generic.h"
#include "effects-simple.h"
#include "effects-convex.h"
#include "expressions.h"
 
#define src(name, suf) \
        strdup(concatenate(WORKSPACE_SRC_SPACE "/", name, suf, NULL))
 
void 
make_host_and_node_modules (entity module)
{
    const char* name = entity_local_name(module);
    entity host, node;
 
    if (bound_new_node_p(module))
        return;
 
    if (entity_main_module_p(module))
    {
        host = make_empty_subroutine(HOST_NAME,make_language_fortran());
        node = make_empty_subroutine(NODE_NAME,make_language_fortran());
    }
    else
    {
        string tmp;
 
        /* HOST and NODE empty routines...
         */
        tmp = strdup(concatenate(name, "_", HOST_NAME, NULL));
        host = make_empty_subroutine(tmp,make_language_fortran());
        free(tmp);
 
        tmp = strdup(concatenate(name, "_", NODE_NAME, NULL));
        node = make_empty_subroutine(tmp,make_language_fortran());
        free(tmp);
 
        /*  Arity and result
         */
        update_functional_as_model(host, module);
        update_functional_as_model(node, module);
 
        if (entity_function_p(module))
        {
            /* then the variable corresponding to the function name
             * must be created for those new functions. The overloaded
             * basic is used to be sure that the variable will not be put 
             * in the declarations by the enforced coherency. 
             * ??? this issue could be managed by the coherency function ?
             */
            string
                var_name = concatenate(name, MODULE_SEP_STRING, name, NULL);
            entity
                var = gen_find_tabulated(var_name, entity_domain), neh, nen;
 
            pips_assert("defined", !entity_undefined_p(var));
 
            const char* tmp_name = entity_local_name(host);
            neh = find_or_create_scalar_entity(tmp_name, tmp_name, 
                                               is_basic_overloaded);
            tmp_name = entity_local_name(node);
            nen = find_or_create_scalar_entity(tmp_name, tmp_name, 
                                               is_basic_overloaded);
            store_new_host_node_variable(neh, nen, var);
        }               
    }
 
    /*  to allow the update of the call sites.
     */
    store_new_host_variable(host, module);
    store_new_node_variable(node, module);
}
 
/* kind of a quick hack to remove distributed arguments for the host 
 */
static void 
drop_distributed_arguments(entity module) /* of the host */
{
    type t = entity_type(module);
    functional f;
    list /* of parameter */ le = NIL, lp;
    int len, i, n /* number of next kept parameter */;
 
    message_assert("functional", type_functional_p(t));
    f = type_functional(t);
    lp = functional_parameters(f);
    len = gen_length(lp);
 
    pips_debug(8, "considering %d arg(s) of %s\n", len, entity_name(module));
 
    for (i=1, n=1; i<=len; i++, POP(lp))
    {
        entity ent = find_ith_parameter(module, i);
        
        if (!entity_undefined_p(ent) && !array_distributed_p(ent))
        {
            le = CONS(PARAMETER, PARAMETER(CAR(lp)), le);
            pips_debug(8, "keeping %d argument %s\n", i, entity_name(ent));
 
            formal_offset(storage_formal(entity_storage(ent))) = n;
            n++;
        }
        else
        {
            if (!entity_undefined_p(ent))
                formal_offset(storage_formal(entity_storage(ent))) = INT_MAX;
 
            pips_debug(8, "dropping %d argument %s\n", i, 
                       entity_undefined_p(ent)? "undefined": entity_name(ent));
        }
    }
 
    lp = functional_parameters(f);
    functional_parameters(f) = gen_nreverse(le);
    gen_free_list(lp);
}
 
static entity 
create_bound_entity(
    entity module,
    entity array,
    bool upper,
    int dim,
    int number)
{
    entity result = argument_bound_entity(module, array, upper, dim);
 
    free_storage(entity_storage(result));
    entity_storage(result) = 
        make_storage(is_storage_formal, make_formal(module, number));
 
    pips_assert("formal variable", type_variable_p(entity_type(result)));
 
    AddEntityToDeclarations(result, module);
 
    pips_debug(9, "creating %s in %s (arg %d)\n", 
               entity_name(result), entity_name(module), number);
 
    return result;
}
 
static list 
add_one_bound_argument(
    list /* of parameter */ lp,
    entity module,
    entity array,
    bool upper,
    int dim,
    int formal_number)
{
    (void) create_bound_entity(module, array, upper, dim, formal_number);
    lp = CONS(PARAMETER, 
              make_parameter(make_type_variable(
                                                make_variable(MakeBasic(is_basic_int), NIL,NIL)),
                             make_mode_reference(), // FI: Used to be value...
                             make_dummy_unknown()),
              lp);
    return lp;
}
 
static void
add_bound_arguments(entity module) /* for the node */
{
    type t = entity_type(module);
    functional f;
    list /* of parameter */ le = NIL, lp;
    int len, i, next;
 
    message_assert("functional", type_functional_p(t));
    f = type_functional(t);
    lp = functional_parameters(f);
    len = gen_length(lp);
    next = len+1;
 
    for(i=1; i<=len; i++)
    {
        entity arg = find_ith_parameter(module, i),
               old = load_old_node(arg);
        pips_debug(8, "array %s\n", entity_name(old));
 
        if (array_distributed_p(old))
        {
            int dim, ndim;
            ndim = NumberOfDimension(arg);
 
            for(dim=1; dim<=ndim; dim++)
            {       
                if (ith_dim_overlapable_p(old, dim))
                {
                    le = add_one_bound_argument
                        (le, module, arg, false, dim, next++);
                    le = add_one_bound_argument
                        (le, module, arg, true, dim, next++);
                }
            }
        }
    }
 
    if (le)
    {
        functional_parameters(f) = gen_nconc(lp, le);
    }
}
 
/* both host and node modules are initialized with the same
 * declarations than the compiled module, but the distributed arrays
 * declarations... which are not declared in the case of the host_module,
 * and the declarations of which are modified in the node_module
 * (call to NewDeclarationsOfDistributedArrays)...
 */
void 
init_host_and_node_entities ()
{
    entity current_module = get_current_module_entity();
 
    ifdebug(3)
    {
        text t;
        debug_on("PRETTYPRINT_DEBUG_LEVEL");
        pips_debug(3, "old declarations:\n");
        t = text_declaration(current_module);
        print_text(stderr, t);
        free_text(t);
        debug_off();
    }
 
    host_module = load_new_host(current_module);
    node_module = load_new_node(current_module);
 
    /*  First, the commons are updated
     */
    MAP(ENTITY, e,
     {
         type t = entity_type(e);
 
         if (type_area_p(t) && !entity_special_area_p(e))
         {
             debug(3, "init_host_and_node_entities",    /* COMMONS */
                   "considering common %s\n", entity_name(e));
 
             AddCommonToHostAndNodeModules(e); 
             add_a_common(e);
         }
     },
         entity_declarations(current_module)); 
 
    /*   Then, the other entities
     */
    MAP(ENTITY, e,
     {
         type t = entity_type(e);
 
         /* parameters are selected. I think they may be either
          * functional of variable (if declared...) FC 15/09/93
          */
 
         if ((type_variable_p(t)) ||                    /* VARIABLES */
             ((storage_rom_p(entity_storage(e))) &&
              (value_symbolic_p(entity_initial(e)))))
             AddEntityToHostAndNodeModules(e);
         else
         if (type_functional_p(t))                      /* PARAMETERS */
         {
             AddEntityToDeclarations(e, host_module);   
             AddEntityToDeclarations(e, node_module);
         }
     },
         entity_declarations(current_module));
    
    NewDeclarationsOfDistributedArrays();    
 
    drop_distributed_arguments(host_module);
    add_bound_arguments(node_module);
 
    ifdebug(3)
    {
        text t;
        debug_on("PRETTYPRINT_DEBUG_LEVEL");
        pips_debug(3,"new declarations - node_module:\n");
        (void) entity_consistent_p(node_module);
        t = text_declaration(node_module);
        print_text(stderr, t);
        free_text(t);
 
        pips_debug(3, "new declarations - host_module:\n");
        (void) entity_consistent_p(host_module);
        t = text_declaration(host_module);
        print_text(stderr, t);
        free_text(t);
        debug_off();
    }
}
 
FILE *
hpfc_fopen(
    string name)
{
    string base = pips_basename(name, NULL);
    FILE *f = (FILE *) safe_fopen(name, "w");
    fprintf(f, "!\n! File %s\n! This file has been automatically generated " 
            "by the HPF compiler\n!\n", base);
    free(base);
    return f;
}
 
void
hpfc_fclose(
    FILE *f,
    string name)
{
    string base = pips_basename(name, NULL);
    fprintf(f, "!\n! That is all for %s\n!\n", base);
    free(base);
    safe_fclose(f, name);
}
 
/* old name of obj while in module now.
 */
static const char* 
old_name(
    entity module, /* module in which obj appears */
    entity obj)    /* obj */
{
    return module_local_name
        (module==host_module ? load_old_host(obj) : load_old_node(obj));
}
 
/* to be used by the prettyprinter at the head of a file.
 * inclusion of needed runtime headers.
 */
static string
hpfc_head_hook(
    entity m) /* module */
{
    return strdup(concatenate
        ("      implicit none\n"
         "      include \"" GLOBAL_PARAMETERS_H "\"\n"
         "      include \"hpfc_commons.h\"\n"
         "      include \"hpfc_includes.h\"\n"
         "      include \"", old_name(m, m), PARM_SUFFIX "\"\n", NULL));
}
 
/* to be used by the prettyprinter when dealing with a common.
 * inclusion of the parameters and commons...
 */
static string 
hpfc_common_hook(
    entity module,
    entity common)
{
    const char* name = module_local_name(common);/* old_name(module, common); */
    return strdup(concatenate
        ("      include \"", name, PARM_SUFFIX "\"\n"
         "      include \"", name,  
         module==host_module ? HINC_SUFFIX "\"\n" : NINC_SUFFIX "\"\n", NULL));
}
 
void 
hpfc_print_code(
    FILE* file,
    entity module,
    statement stat)
{
    text t;
    debug_on("PRETTYPRINT_DEBUG_LEVEL");
 
    set_prettyprinter_head_hook(hpfc_head_hook);
    set_prettyprinter_common_hook(hpfc_common_hook);
 
    t = text_module(module, stat);
    print_text(file, t);
    free_text(t);
    
    reset_prettyprinter_common_hook();
    reset_prettyprinter_head_hook();
 
    debug_off();
}
 
#define full_name(dir, name) concatenate(dir, "/", name, NULL)
 
void 
put_generated_resources_for_common(entity common)
{
    FILE *host_file, *node_file, *parm_file, *init_file;
    string host_name, node_name, parm_name, init_name, dir_name;
    entity node_common, host_common;
 
    node_common = load_new_node(common),
    host_common = load_new_host(common);
    const char *prefix = module_local_name(common);
    dir_name = db_get_current_workspace_directory();
    
    host_name = src(prefix, HINC_SUFFIX);
    node_name = src(prefix, NINC_SUFFIX);
    parm_name = src(prefix, PARM_SUFFIX);
    init_name = src(prefix, INIT_SUFFIX);
 
    host_file = hpfc_fopen(full_name(dir_name, host_name));
    hpfc_print_common(host_file, host_module, host_common);
    hpfc_fclose(host_file, host_name);
 
    node_file = hpfc_fopen(full_name(dir_name, node_name));
    hpfc_print_common(node_file, node_module, node_common);
    hpfc_fclose(node_file, node_name);
 
    parm_file = hpfc_fopen(full_name(dir_name, parm_name));
    create_parameters_h(parm_file, common);
    hpfc_fclose(parm_file, parm_name);
 
    init_file = hpfc_fopen(full_name(dir_name, init_name));
    create_init_common_param_for_arrays(init_file, common);
    hpfc_fclose(init_file, init_name);
 
    ifdebug(1)
    {
        fprintf(stderr, "Result of HPFC for common %s\n", entity_name(common));
        fprintf(stderr, "-----------------\n");
 
        hpfc_print_file(parm_name);
        hpfc_print_file(init_name);
        hpfc_print_file(host_name);
        hpfc_print_file(node_name);
    }
 
    free(parm_name),
    free(init_name),
    free(host_name),
    free(node_name);
}
 
/* just copied for the host
 */
void
compile_a_special_io_function(entity module)
{
    string  file_name, h_name, dir_name, fs, ft;
 
    const char *prefix = module_local_name(module);
    file_name = db_get_file_resource(DBR_SOURCE_FILE, prefix, true);
    dir_name = db_get_current_workspace_directory();
    h_name = src(prefix, HOST_SUFFIX);
 
    fs = strdup(concatenate(dir_name, "/", file_name, NULL));
    ft = strdup(concatenate(dir_name, "/", h_name, NULL));
    safe_copy(fs, ft);
    free(fs);
    free(ft);
 
    DB_PUT_FILE_RESOURCE(DBR_HPFC_HOST, prefix, h_name);
    DB_PUT_FILE_RESOURCE(DBR_HPFC_NODE, prefix, NO_FILE);
    DB_PUT_FILE_RESOURCE(DBR_HPFC_RTINIT, prefix, NO_FILE);
    DB_PUT_FILE_RESOURCE(DBR_HPFC_PARAMETERS, prefix, NO_FILE);
}
 
/* simply copied for both host and node... 
 */
void
compile_a_pure_function(entity module)
{
    string file_name, hn_name, dir_name, fs, ft;
 
    pips_debug(1, "compiling pure a function (%s)\n", entity_name(module));
 
    const char* prefix = module_local_name(module);
    dir_name = db_get_current_workspace_directory();
    file_name = db_get_file_resource(DBR_SOURCE_FILE, prefix, true);
    hn_name = src(prefix, BOTH_SUFFIX);
 
    fs = strdup(concatenate(dir_name, "/", file_name, NULL));
    ft = strdup(concatenate(dir_name, "/", hn_name, NULL));
    safe_copy(fs, ft);
    free(fs), free(ft);
 
    DB_PUT_FILE_RESOURCE(DBR_HPFC_HOST, prefix, hn_name);
    DB_PUT_FILE_RESOURCE(DBR_HPFC_NODE, prefix, strdup(hn_name));
    DB_PUT_FILE_RESOURCE(DBR_HPFC_RTINIT, prefix, NO_FILE);
    DB_PUT_FILE_RESOURCE(DBR_HPFC_PARAMETERS, prefix, NO_FILE);
}
 
void 
put_generated_resources_for_module(
    _UNUSED_ statement stat,
    statement host_stat,
    statement node_stat)
{
    FILE *host_file, *node_file, *parm_file, *init_file;
    entity module = get_current_module_entity();
    string host_name, node_name, parm_name, init_name, dir_name;
    
    const char *prefix = module_local_name(module);
    dir_name = db_get_current_workspace_directory();
 
    host_name = src(prefix, HOST_SUFFIX);
    host_file = hpfc_fopen(full_name(dir_name, host_name));
    hpfc_print_code(host_file, host_module, host_stat);
    hpfc_fclose(host_file, host_name);
 
    node_name = src(prefix, NODE_SUFFIX);
    node_file = hpfc_fopen(full_name(dir_name, node_name));
    hpfc_print_code(node_file, node_module, node_stat);
    hpfc_fclose(node_file, node_name);
 
    parm_name = src(prefix, PARM_SUFFIX);
    parm_file = hpfc_fopen(full_name(dir_name, parm_name));
    create_parameters_h(parm_file, module);
    hpfc_fclose(parm_file, parm_name);
 
    init_name = src(prefix, INIT_SUFFIX);
    init_file = hpfc_fopen(full_name(dir_name, init_name));
    create_init_common_param_for_arrays(init_file, module);
    hpfc_fclose(init_file, init_name);
 
    ifdebug(1)
    {
        fprintf(stderr, "Result of HPFC for module %s:\n", 
                module_local_name(module));
        fprintf(stderr, "-----------------\n");
 
        hpfc_print_file(parm_name);
        hpfc_print_file(init_name);
        hpfc_print_file(host_name);
        hpfc_print_file(node_name);
    }
 
    DB_PUT_FILE_RESOURCE(DBR_HPFC_PARAMETERS, prefix, parm_name);
    DB_PUT_FILE_RESOURCE(DBR_HPFC_HOST, prefix, host_name);
    DB_PUT_FILE_RESOURCE(DBR_HPFC_NODE, prefix, node_name);
    DB_PUT_FILE_RESOURCE(DBR_HPFC_RTINIT, prefix, init_name);
}
 
void
put_generated_resources_for_program (_UNUSED_ string program_name)
{
    FILE *comm_file, *init_file;
    string comm, init, dir_name;
 
    dir_name = db_get_current_workspace_directory();
 
    comm = src(GLOBAL_PARAMETERS_H, "");
    init = src(GLOBAL_INIT_H, "");
 
    comm_file = hpfc_fopen(full_name(dir_name, comm));
    create_common_parameters_h(comm_file);
    hpfc_fclose(comm_file, comm);
 
    init_file = hpfc_fopen(full_name(dir_name, init));
    create_init_common_param(init_file);
    hpfc_fclose(init_file, init);
    
    ifdebug(1)
    {
        fprintf(stderr, "Results of HPFC for the program\n");
        fprintf(stderr, "-----------------\n");
 
        hpfc_print_file(comm);
        hpfc_print_file(init);
    }
 
    free(comm);
    free(init);
}
 
/* Compiler call, obsole. left here for allowing linking
 */
void 
hpfcompile (const char* module_name)
{
    debug_on("HPFC_DEBUG_LEVEL");
    pips_debug(1, "module: %s\n", module_name);
    pips_internal_error("obsolete");
    debug_off();
}
 
 
/******************************************************* HPFC ATOMIZATION */
 
/*  drivers for atomize_as_required in transformations
 */
static bool expression_simple_nondist_p(expression e)
{
    reference r;
    if (!expression_reference_p(e)) return(false);
    r = syntax_reference(expression_syntax(e));
    return !array_distributed_p(reference_variable(r)) &&
            ENDP(reference_indices(r));
}
 
/* break expression e in reference r if ...
 */
static bool hpfc_decision(reference r, expression e)
{
    return array_distributed_p(reference_variable(r)) &&
           !expression_integer_constant_p(e) && 
           !expression_simple_nondist_p(e);
}
 
entity hpfc_new_variable(entity module, basic b)
{
    entity new_ent =  make_new_scalar_variable(module, copy_basic(b));
    AddEntityToCurrentModule(new_ent);
    return new_ent;
}
 
 
/********************* EXTRACT NON VARIANT TERMS ON DISTRIBUTED DIMENSIONS */
 
DEFINE_LOCAL_STACK(c_stmt, statement)
 
void hpfc_compile_error_handler()
{
    error_reset_c_stmt_stack();
}
 
/* true if no written effect on any variables of e in loe 
 */
static bool invariant_expression_p(
    expression e,
    list /* of effect */ loe,
    list /* of entity */ le)
{
    list /* of effect */ l = proper_effects_of_expression(e);
 
    ifdebug(3) {
        pips_debug(3, "considering expression:");
        print_expression(e);
    }
 
    FOREACH(EFFECT, ef1, l) {
      FOREACH(EFFECT, ef2, loe) {
        if(store_effect_p(ef1) && store_effect_p(ef2)) {
            entity v = effect_variable(ef1);
            if ((v==effect_variable(ef2) && effect_write_p(ef2)) ||
                gen_in_list_p(v, le))
            {
                gen_free_list(l);
                pips_debug(3, "variant\n");
                return false;
            }
        }
      }
    }
 
    gen_free_list(l);
    pips_debug(3, "invariant\n");
    return true;
}
 
/* substitute all occurences of expression e in statement s by variable v
 */
static entity subs_v;
static expression subs_e;
static Pvecteur subs_pv;
 
/* returns if vin is in vref
 */
static bool vect_in_p(Pvecteur vin, Pvecteur vref)
{
    Pvecteur v;
 
    for (v=vin; v; v=v->succ)
    {
        Variable x = vecteur_var(v);
        if (x)
        {
            if (value_ne(vecteur_val(v),vect_coeff(x, vref)))
                return false;
        }
    }
 
    return true;
}
 
 
static bool expression_flt(expression e)
{
    /* does sg about the linearization of the expression 
     */
    if (subs_pv && expression_linear_p(e))
    {
        normalized n = expression_normalized(e);
        Pvecteur v = normalized_linear(n);
        if (vect_in_p(subs_pv, v))
        {
            Pvecteur vn = vect_substract(v,subs_pv);
            vect_add_elem(&vn, (Variable)subs_v, VALUE_ONE);
            vect_rm(v);
            normalized_linear_(n) = newgen_Pvecteur(vn);
        }
    }
 
    if (expression_equal_p(e, subs_e))
    {
        /* ??? memory leak, but how to deal with effect references? */
        expression_syntax(e) = 
            make_syntax(is_syntax_reference, make_reference(subs_v, NIL));
        free_normalized(expression_normalized(e));
        expression_normalized(e) = 
            make_normalized(is_normalized_linear,
                            vect_new((Variable)subs_v, VALUE_ONE));
        return false;
    }
    return true;
}
static void substitute_and_create(statement s, entity v, expression e)
{
    instruction i;
 
    ifdebug(3) {
        pips_debug(3, "variable %s substituted for\n", entity_name(v));
        print_expression(e);
    }
 
    subs_v = v;
    subs_e = copy_expression(e);
 
    subs_pv = expression_linear_p(e)?
        vect_dup(normalized_linear(expression_normalized(e))):
        (Pvecteur) NULL;
    
    gen_recurse(s, expression_domain, expression_flt, gen_null);
    
    vect_rm(subs_pv), subs_pv=(Pvecteur)NULL;
 
    i = loop_to_instruction
        (make_loop(v, 
                   make_range(copy_expression(subs_e),
                              subs_e, /* the copy is reused! */
                              int_to_expression(1)),
                   instruction_to_statement(statement_instruction(s)),
                   entity_empty_label(),
                   make_execution(is_execution_parallel, UU),
                   NIL));
 
    statement_instruction(s) = i;
}
 
static bool loop_flt(loop l)
{
    statement s;
    list /* of effect */ loce;
    list /* of entity */ lsubs = NIL;
 
    if (execution_sequential_p(loop_execution(l)))
        return true;
 
    s = c_stmt_head();
    loce = effects_effects(load_cumulated_references(s)); 
 
    FOREACH(EFFECT, e, loce)
    {
      if(store_effect_p(e)) {
        reference r = effect_any_reference(e);
        entity v = reference_variable(r);
 
        if (array_distributed_p(v) && effect_write_p(e))
        {
            int dim = 0;
            int p;
            entity n;
 
            pips_debug(3, "considering reference to %s[%zd]\n",
                       entity_name(v), gen_length(reference_indices(r)));
 
            FOREACH(EXPRESSION, x,reference_indices(r))
            {
                dim++;
                ifdebug(3) {
                    pips_debug(3, "considering on dim. %d:\n", dim);
                    print_expression(x);
                }
                if (ith_dim_distributed_p(v, dim, &p) &&
                    invariant_expression_p(x, loce, lsubs) &&
                    !expression_integer_constant_p(x))
                {
                    n = hpfc_new_variable(get_current_module_entity(),
                                          MakeBasic(is_basic_int));
                    substitute_and_create(s, n, x);
                    lsubs = CONS(ENTITY, n, lsubs);
                }
            }
        }
      }
    }
 
    return false;
}
 
/* transformation: DOALL I,J ... A(I,J,e) -> DOALL E=e,e,1 ,I,J A(I,J,E)
 */
static void 
extract_distributed_non_constant_terms(
    statement s)
{
    DEBUG_STAT(2, "in", s);
 
    make_c_stmt_stack();
    gen_multi_recurse(s, 
                      statement_domain, c_stmt_filter, c_stmt_rewrite, 
                      loop_domain, loop_flt, gen_null,
                      NULL);
    free_c_stmt_stack();        
 
    DEBUG_STAT(2, "out", s);
}
 
static bool test_atomization(test t, _UNUSED_ expression e)
{
  return ref_to_dist_array_p(t);
}
 
/*
 */
void NormalizeCodeForHpfc(statement s)
{
    extract_distributed_non_constant_terms(s);
    normalize_all_expressions_of(s);
    atomize_as_required(s, 
                        hpfc_decision,      /* reference test */
                        (bool(*)(call,expression)) gen_false2,          /* function call test */
                        (bool(*)(test,expression)) test_atomization,/* test condition test */
                        (bool(*)(range,expression)) gen_false2,          /* range test */
                        (bool(*)(whileloop,expression)) gen_false2,          /* whileloop test */
                        hpfc_new_variable);
}
 
/*************************************************************** COMMONS */
 
/* To manage the common entities, I decided arbitrarilly that all
 * commons will have to be declared exactly the same way (name and so),
 * so I can safely unify the entities among the modules.
 * The rational for this stupid ugly transformation is that it is much
 * easier to manage the common overlaps for instance if they are
 * simply linked to the same entity.
 * 
 * ??? very ugly, indeed.
 */
 
GENERIC_CURRENT_MAPPING(update_common, entity, entity)
 
static void update_common_rewrite(reference r)
{
    entity var = reference_variable(r),
        new_var = load_entity_update_common(var);
 
    pips_debug(7, "%s to %s\n", entity_name(var), 
          entity_undefined_p(new_var) ? "undefined" : entity_name(new_var));
 
    if (!entity_undefined_p(new_var))
        reference_variable(r) = new_var;    
}
 
static void update_loop_rewrite(l)
loop l;
{
     entity var = loop_index(l),
        new_var = load_entity_update_common(var);
 
    if (!entity_undefined_p(new_var))
        loop_index(l) = new_var;       
}
 
static void debug_ref_rwt(reference r)
{
    entity var = reference_variable(r);
 
    if (entity_in_common_p(var))
        fprintf(stderr, "[debug_ref_rwt] reference to %s\n", 
                entity_name(var));
}
 
void debug_print_referenced_entities(void * obj)
{
    gen_multi_recurse(obj, reference_domain, gen_true, debug_ref_rwt, NULL);
}
 
void update_common_references_in_obj(void * obj)
{
    gen_multi_recurse(obj,
                      loop_domain, gen_true, update_loop_rewrite,
                      reference_domain, gen_true, update_common_rewrite,
                      NULL);
 
    ifdebug(8) debug_print_referenced_entities(obj);
}
 
void update_common_references_in_regions()
{
 
    STATEMENT_EFFECTS_MAP(stat, effs,
         {
             list lef = effects_effects(effs);
 
             pips_debug(3, "statement %p (%zu effects)\n",
                        stat, gen_length((list) lef));
 
             // FI: Let's hope the rw effects do not have to be
             // filtered to keep only the store effects...
             MAP(EFFECT, e, update_common_rewrite(effect_any_reference(e)),
                 (list) lef);
         },
             get_rw_effects());
}
 
void 
NormalizeCommonVariables(
    entity module,
    statement stat)
{
    list ldecl = code_declarations(entity_code(module)), lnewdecl = NIL, ltmp;
    entity common, new_e;
 
    /* the new entities for the common variables are created and
     * inserted in the common. The declarations are updated.
     */
    MAP(ENTITY, e,
    {
        if (entity_in_common_p(e))
        {
            common = ram_section(storage_ram(entity_storage(e)));
            new_e = AddEntityToModule(e, common);
            ltmp = area_layout(type_area(entity_type(common)));
            
            if (gen_find_eq(new_e, ltmp)==entity_undefined)
                gen_insert_after(new_e, e, ltmp);
            
            lnewdecl = CONS(ENTITY, new_e, lnewdecl);
            store_entity_update_common(e, new_e);
            
            pips_debug(8, "module %s: %s -> %s\n",
                  entity_name(module), entity_name(e), entity_name(new_e));
        }
        else
            lnewdecl = CONS(ENTITY, e, lnewdecl);
    },
        ldecl);
 
    gen_free_list(ldecl);
    code_declarations(entity_code(module)) = lnewdecl;
 
    /* the references within the program are updated with the new entities
     */
    update_common_references_in_obj(stat);
}
 
/*   That is all
 */