communications.c

Go to the documentation of this file.

/*
 
  $Id: communications.c 23372 2017-05-05 15:35:30Z lossing $
 
  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
/*  Computation of communications needed  
 * for generating distributed code in PUMA
 *
 * Corinne Ancourt
 */
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
 
#include "genC.h"
 
#include "linear.h"
#include "ri.h"
#include "effects.h"
 
#include "matrice.h"
#include "tiling.h"
#include "database.h"
#include "text.h"
 
#include "dg.h"
typedef dg_arc_label arc_label;
typedef dg_vertex_label vertex_label;
#include "graph.h"
 
#include "misc.h"
#include "text-util.h"
#include "ri-util.h"
#include "prettyprint.h"
#include "effects-util.h"
#include "resources.h"
#include "movements.h"
#include "constants.h"
#include "wp65.h"
 
/* This function associates to each variable in the call statement  the statement 
 * where it should be communicated  (this statement is often external to the call)
*/
 
void 
call_instruction_to_communications(
    statement s,
    statement st_level1,
    statement st_level2,
    list *lwr,
    list *lwr_local, 
    statement_mapping *fetch_map,
    statement_mapping *store_map, 
    hash_table r_to_ud,
    list *lpv) 
{
  pips_assert("true", r_to_ud==r_to_ud);
 
    if(assignment_statement_p(s)) {
        reference r;
        entity rv;
        list lexpr =
            call_arguments(instruction_call(statement_instruction(s)));
        /* first reference in statement s */
        bool first_reference = true;
 
        for(; !ENDP(lexpr); POP(lexpr)) {
            expression e = EXPRESSION(CAR(lexpr));
            list lr = expression_to_operand_list(e, NIL);
            if (lr != NIL) {
                list consr = lr;
                ifdebug(2) {
                    (void) fprintf(stderr, "reference list:");
                    print_reference_list(lr);
                    (void) fprintf(stderr, "first_reference=%s\n",
                                   bool_to_string(first_reference));
                }
                for(consr = lr; !ENDP(consr) ; POP(consr)) {
                    r = REFERENCE(CAR(consr));
                    rv = reference_variable(r);
                    if (first_reference) {
                        ifdebug(2) {
                            (void) fprintf(stderr,"list lwr_local:");
                            reference_list_print(*lwr_local);}
                        reference_list_update(lwr_local,r);
                        update_map(*store_map,st_level2,r);
                        first_reference = false;
                    }
                    else {
                         if(!entity_is_argument_p(rv, *lpv)) {
                           debug(8,"loop_nest_to_local_variables",
                           "Variable %s is not private\n",  
                                 entity_local_name(rv));
                        ifdebug(2) { 
                            (void) fprintf(stderr,"list lwr_local:");
                            reference_list_print(*lwr_local);
                            (void) fprintf(stderr,"list lwr : ");
                            reference_list_print(*lwr);} 
 
                        if (reference_scalar_p(r)) {
                            if (!reference_in_list_p(r,*lwr_local))
                            update_map(*fetch_map,st_level1,r); 
                        }
                        else {
                            if (array_indice_in_list_p(r,*lwr_local))
                                update_map(*fetch_map,s,r);
                            else if (array_indice_in_list_p(r,*lwr))
                                update_map(*fetch_map,st_level2,r);
                            else update_map(*fetch_map,st_level1,r);
                        }
                       }
                    }
                }
            }
        }
    }
    else { 
        ifdebug(9) 
            (void) fprintf(stderr, 
                           "call-communications - not assignment\n");
    }
}
 
/* This function associates to each variable in the loop the statement 
 * where it should be communicated  (this statement may be external to the loop).
*/
 
 
void loop_instruction_to_communications(statement stmt, statement st_level1, 
                                        statement st_level2, list *lwr, list *lwr_local, 
                                        statement_mapping *fetch_map,statement_mapping *store_map,
                                        hash_table r_to_ud,list *lpv)
{
    instruction inst = statement_instruction(stmt);
    statement b = loop_body(instruction_loop(inst));
    instruction inst2=  (instruction) statement_instruction(b);
    reference_list_add(lwr, lwr_local);
    reference_list_update(lwr,
                          make_reference(loop_index(instruction_loop(inst)),
                                         NIL));
    *lwr_local = NIL; 
    *lpv=loop_locals(instruction_loop(inst));
 
    switch(instruction_tag(inst2)) {
    case is_instruction_block: 
        st_level2 = STATEMENT(CAR(instruction_block(inst)));
        break;
    case is_instruction_call: 
        st_level2 =b;
        break;
    default:
        (void) fprintf(stderr,
                       "loop_instruction_to_communications: non implemented case \n");
        break;
    }
    statement_to_communications(b,st_level1, st_level2,
                             lwr,lwr_local,
                             fetch_map,store_map,r_to_ud,lpv);
 
}
 
/* This function associates to each variable in stmt  the 
 *  statement where it should  be communicated.
 * The lwr list corresponds to the list of variables that have 
 * been updated before the current statement bloc. 
 * The lwr_local list corresponds to the list of variables 
 * that are updated in the current statement bloc.
*/
 
void statement_to_communications(statement stmt, statement st_level1, statement st_level2, 
                                 list * lwr,list * lwr_local,
                                 statement_mapping *fetch_map,
                                 statement_mapping * store_map,
                                 hash_table r_to_ud, list *lpv)
{
    instruction inst = statement_instruction(stmt);
    
    debug(8, "statement_to_communications", "begin with tag %d\n", 
          instruction_tag(inst));
 
    switch(instruction_tag(inst)) {
    case is_instruction_block: {
        ifdebug(7) 
            (void) fprintf(stderr,
                           "statement_to_communications-instruction block- begin\n");
        st_level2 = STATEMENT(CAR(instruction_block(inst)));
        MAPL( sts, {
            statement s = STATEMENT(CAR(sts));
            statement_to_communications(s,st_level1, st_level2,
                                        lwr,lwr_local,
                                        fetch_map,store_map, 
                                        r_to_ud,lpv);
        }, instruction_block(inst));
        ifdebug(7) 
            (void) fprintf(stderr,
                           "statement_to_communications-instruction block- end\n");
        break;
    }
    case is_instruction_test:
        (void) fprintf(stderr,"not implemented\n");
        break;
    case is_instruction_loop: {
        ifdebug(7)
            (void) fprintf(stderr,
                           "statement_to_communications-instruction loop- begin\n");
        loop_instruction_to_communications(stmt, stmt, stmt, 
                                           lwr, lwr_local,
                                           fetch_map,store_map,
                                           r_to_ud,lpv);
        reference_list_add(lwr, lwr_local);
        ifdebug(7)
            (void) fprintf(stderr,
                           "statement_to_communications-instruction loop- end\n");
        break;
    }
    case is_instruction_call: {
        ifdebug(7)
            (void) fprintf(stderr,"statement_to_communications-instruction call- begin\n");
        call_instruction_to_communications(stmt, st_level1, st_level2, 
                                           lwr, lwr_local,
                                           fetch_map,store_map,r_to_ud,lpv);
        ifdebug(7)
            (void) fprintf(stderr,"statement_to_communications-instruction call- end\n");
        break; 
    }
    case is_instruction_goto: {
        pips_internal_error("Unexpected goto");
        break;}
    case is_instruction_unstructured: {
        pips_internal_error("Sorry: unstructured not implemented");
        break;}
    default: 
        pips_internal_error("Bad instruction tag");
    }
}
 
␌
/* This function associates to each variable  the statement in l where it should be communicated 
 * Fecth_map contains for each statement the list of variables having to be communicated 
 * before its execution. 
 * Store_map contains for each statement the list of variables having to be communicated 
 * after its execution.
*/
 
void 
compute_communications(list l, statement_mapping *fetch_map,statement_mapping *store_map) 
{
    list lwr=NIL;                       /* list of written variables */
    list lwr_local= NIL;                /* list of variables written in a local
                                           instruction block */
    list lpv = NIL;                     /* list of privates variables */
    hash_table r_to_ud1 = hash_table_make(hash_pointer,0);
    statement first_stmt = STATEMENT(CAR(l));
    MAPL(pm,{
        statement s1 = STATEMENT(CAR(pm));  
        statement_to_communications(s1,first_stmt,s1,&lwr, &lwr_local,
                                    fetch_map,store_map, r_to_ud1,&lpv);
    },l);
 
}
 
static list 
constant_symbolic_communication(
    entity compute_or_memory_module,list lrefs,
    bool load_code,entity var_id) 
{
    /* bool load_code  is true if the generated computational code 
       must be a RECEIVE, false if it  must be a SEND*/
 
    list lrs;
    list ccode = NIL; /* movements for the scalar variables 
                         for the compute module or  the memory module */
    for (lrs =lrefs ; !ENDP(lrs) ; POP(lrs)) {
        reference r = REFERENCE(CAR(lrs));
        statement sblock=
            make_movement_scalar_wp65(compute_or_memory_module,load_code,
                                      r,var_id);
        ccode = gen_nconc(ccode,CONS(STATEMENT, sblock, NIL));
    } 
    return ccode;
}
 
void 
include_constant_symbolic_communication(
    entity compute_or_memory_module,list lrefs,
    bool load_code,statement computational_or_emulator,
    entity var_id) 
{ 
    instruction i;
    list ccode = constant_symbolic_communication(compute_or_memory_module,lrefs, 
                                                   load_code,var_id); 
    /* Add data movements to the appropriated module */
    i = statement_instruction(computational_or_emulator);
    instruction_block(i) = gen_nconc(instruction_block(i), ccode);
}
 
static list 
array_indices_communication(
    entity compute_or_memory_module,
    Pbase bank_indices, 
    int bn,
    int ls,
    list lrefs,
    bool load_code,
    entity var_id,
    Pbase loop_indices,
    tiling tile, 
    Pvecteur tile_delay, 
    Pvecteur tile_indices, 
    Pvecteur tile_local_indices)
{
  pips_assert("true",compute_or_memory_module==compute_or_memory_module
              && load_code==load_code);
    list gcode =NIL;
    list icode = NIL;
    list ind=NIL;
    list lrs = NIL;
    statement stat;
    Pbase bas_var[3];
    Pvecteur pv1,pv2,pv,pvi;
    int i,j;
    Value coef;
   
    /* movements for the scalar variables 
       for the compute module or  the memory module */
    bas_var[1] =  VECTEUR_NUL;
    bas_var[2] = VECTEUR_NUL;
    for (lrs =  lrefs;  !ENDP(lrs); POP(lrs)) { 
        reference r = REFERENCE(CAR(lrs));
        Variable vbank,vligne,vofs;
        expression exp1,exp2,exp3,exp4;
        list lex2;
        type t; 
        Value ms=VALUE_ZERO;
        for(ind= reference_indices(r),i=1 ; !ENDP(ind);POP(ind),i++) { 
            expression e = EXPRESSION(CAR(ind));
            normalized norm = NORMALIZE_EXPRESSION(e);
            if (normalized_linear_p(norm))
                bas_var[i]=vect_dup((Pvecteur) normalized_linear(norm));
            else {  normalized norm=NormalizeSyntax(expression_syntax(e));
                    bas_var[i]=vect_dup((Pvecteur) normalized_linear(norm));
                    fprintf(stderr,
                            "[array_indices_communication ERROR]--> NON LINEAR funct.\n");
                }
        }
 
        t = entity_type(reference_variable(r));
        if (type_variable_p(t)) {
            variable var = type_variable(t);
            cons * dims = variable_dimensions(var);
            dimension dim1 = DIMENSION(CAR(dims));
            expression lower= dimension_lower(dim1);
            normalized norm1 = NORMALIZE_EXPRESSION(lower);
            expression upper= dimension_upper(dim1);
            normalized norm2 = NORMALIZE_EXPRESSION(upper);
            Value min_ms = VALUE_ZERO;
            Value max_ms = VALUE_ZERO;
            if (normalized_linear_p(norm1) && normalized_linear_p(norm2)) {
                min_ms=vect_coeff(TCST,(Pvecteur) normalized_linear(norm1));
                max_ms=vect_coeff(TCST,(Pvecteur) normalized_linear(norm2));
            }
            ms = value_minus(max_ms,min_ms);
            value_increment(ms);
        }
        
        vbank = (Variable) var_id;
        vligne = vecteur_var(bank_indices->succ);
        vofs = vecteur_var(bank_indices->succ->succ);
        if (VECTEUR_NUL_P(bas_var[2]))
            bas_var[2] = vect_new(TCST,VALUE_ONE);
        for (i=1;i<=2;i++) {    
            for (pvi = loop_indices,j=1; !VECTEUR_NUL_P(pvi); 
                 pvi = pvi->succ,j++) {
                if (value_notzero_p(coef = vect_coeff(pvi->var,
                                                      bas_var[i]))) 
                { 
                    pv = make_loop_indice_equation
                        (loop_indices,tile, tile_delay,
                         tile_indices,tile_local_indices,j);
                  vect_add_elem(&bas_var[i],pvi->var,value_uminus(coef)); 
                
                  bas_var[i] =vect_add(bas_var[i],vect_multiply(pv,coef));
                }
            }
        }
        
        /* building equality L = [(var1 -1) +(var2-1)*ms]/bn*ls] */
        pv1 = vect_dup(bas_var[2]);
        pv1 = vect_multiply(pv1,ms);
        pv2 = vect_dup(bas_var[1]);
        pv2 = vect_add(pv2,pv1);
        vect_add_elem(&pv2,TCST,value_plus(value_uminus(ms),VALUE_MONE));
        exp1= make_vecteur_expression(pv2);
        exp2 = int_to_expression(bn*ls);
        lex2 =CONS(EXPRESSION,exp2,NIL);
        exp3 = make_div_expression(exp1,lex2);  
        exp4 = make_vecteur_expression(vect_new(vligne,VALUE_ONE));
        stat = make_assign_statement(exp4,exp3);
 
        icode = CONS(STATEMENT,stat,NIL);
        gcode = gen_nconc(gcode,icode);
        /* building equality B = [(var1 -1) +(var2-1)*ms -bn*ls*L ]/ls+1 */
        pv1 = vect_dup(bas_var[2]);
        pv1 = vect_multiply(pv1,ms);
        pv2 = vect_dup(bas_var[1]);
        pv2 = vect_add(pv2,pv1);
        vect_add_elem(&pv2,vligne,int_to_value((-bn*ls)));
        vect_add_elem(&pv2,TCST,value_plus(value_uminus(ms),VALUE_MONE));
        exp1= make_vecteur_expression(pv2);
        exp2 = int_to_expression(ls);
        lex2 =CONS(EXPRESSION,exp2,NIL);
        exp3 = make_div_expression(exp1,lex2);  
        exp4 = make_vecteur_expression(vect_new(vbank,VALUE_ONE));
        stat = make_assign_statement(exp4,exp3);
        icode = CONS(STATEMENT,stat,NIL);
        gcode = gen_nconc(gcode,icode);
        /* building equality O = [(var1 -1) +(var2-1)*ms -bn*ls*L -ls*B */
        pv1 = vect_dup(bas_var[2]);
        pv1 = vect_multiply(pv1,ms);
        pv2 = vect_dup(bas_var[1]);
        pv2 = vect_add(pv2,pv1);
        vect_add_elem(&pv2,vligne,int_to_value((-bn*ls)));
        vect_add_elem(&pv2,vbank,int_to_value((-ls)));
        vect_add_elem(&pv2,TCST,value_plus(value_uminus(ms),VALUE_MONE));
        exp1= make_vecteur_expression(pv2);
        exp4 = make_vecteur_expression(vect_new(vofs,VALUE_ONE));
        stat = make_assign_statement(exp4,exp1);
        icode = CONS(STATEMENT,stat,NIL);
        gcode = gen_nconc(gcode,icode);
    }
    return (gcode);
}
 
 
static list 
array_scalar_access_to_compute_communication(
    entity compute_module,Pbase bank_indices,
    int bn,int ls,list lt,
    bool load_code,entity proc_id, 
    entity var_id,bool fully_sequential,
    Pbase loop_indices,tiling tile,Pvecteur tile_delay, 
    Pvecteur tile_indices,Pvecteur tile_local_indices)
{
   
    list icode,lst;
    icode  = array_indices_communication(compute_module,bank_indices,
                                         bn,ls,lt,
                                         load_code,var_id,loop_indices,tile,
                                         tile_delay,
                                         tile_indices,tile_local_indices);
  lst = CONS(REFERENCE,make_reference(var_id,NIL),
                    CONS(REFERENCE, 
                         make_reference((entity) bank_indices->succ->var,
                                        NIL),
                         CONS(REFERENCE, 
                              make_reference((entity) bank_indices->succ->succ->var,NIL),
                              NIL)));
 
    if (!fully_sequential) { 
        /*    Generation of the compute code corresponding to the transfer 
              of a scalar array element :
              L = (-101+100*L_J+P)/400
              X3 = (-101+100*L_J+P-400*L)/100
              O = -101+100*L_J+P-400*L-100*X3
              DOALL BANK_ID = 0, 3
              CALL WP65_SEND_4(BANK_ID, X3, 1)
              CALL WP65_SEND_4(BANK_ID, L, 1)
              CALL WP65_SEND_4(BANK_ID, O, 1)
              ENDDO
              CALL WP65_RECEIVE_4(X3, L_B_0_0(P,L_J), 1)
              */
        entity ent1 = make_new_module_variable(compute_module,100);
 
        list ccode= constant_symbolic_communication(compute_module,lst,
                                                    !load_code,ent1);
        range looprange = make_range(int_to_expression(0),
                                     int_to_expression(bn-1),
                                     int_to_expression(1));
        statement loopbody = make_block_statement(ccode);
        entity looplabel = make_loop_label(9000, compute_module);
           
        loop newloop = make_loop(ent1, 
                                 looprange,
                                 loopbody,
                                 looplabel, 
                                 make_execution(is_execution_parallel,UU),
                                 NIL);
 
        statement  stat = loop_to_statement(newloop);
    AddEntityToDeclarations(ent1,compute_module);
        icode = gen_nconc(icode,CONS(STATEMENT,stat,NIL));
        ccode = constant_symbolic_communication(compute_module,lt,load_code,var_id);
        icode = gen_nconc(icode,ccode);  
        return icode;
    }
    else {
 
        list ccode = constant_symbolic_communication(compute_module,lst,!load_code,proc_id);
        ccode =  gen_nconc(icode,ccode);
        icode = constant_symbolic_communication(compute_module,lt,load_code,proc_id);
        ccode =  gen_nconc(ccode,icode);
        return ccode;
    }
}
␌ 
list array_scalar_access_to_bank_communication(entity memory_module,Pbase  bank_indices, 
                                               int bn,int ls, list lt,bool load_code,
                                               entity proc_id,entity var_id,bool fully_sequential)
{   
  pips_assert("true", ls==ls);
  
    reference ref1 = make_reference((entity) bank_indices->succ->var,NIL);
    reference ref2 =  make_reference((entity) bank_indices->succ->succ->var,NIL);
    list lst = CONS(REFERENCE,make_reference(var_id,NIL),
                    CONS(REFERENCE,ref1, CONS(REFERENCE,ref2,NIL)));
    if (!fully_sequential) {
        /* 
           Generation of the emulated shared memory code corresponding to 
           the transfer of a scalar array element :
           
           CALL BANK_RECEIVE_4(PROC_ID, X1, 1)
           CALL BANK_RECEIVE_4(PROC_ID, L, 1)
           CALL BANK_RECEIVE_4(PROC_ID, O, 1)
           IF (BANK_ID = X1) THEN
           CALL BANK_SEND_4(PROC_ID, ES_B(O,L), 1)
           ENDIF
           */
        list ccode= constant_symbolic_communication(memory_module,
                                                    lst,!load_code,proc_id); 
        list tcode = constant_symbolic_communication(memory_module,
                                                     lt,load_code,proc_id);
        expression exp1 =make_vecteur_expression(vect_new(bank_indices->var,
                                                          VALUE_ONE));
        expression exp2 = make_vecteur_expression(vect_new((Variable) var_id,
                                                           VALUE_ONE));
        expression test_bound = MakeBinaryCall(entity_intrinsic(EQUAL_OPERATOR_NAME),exp1,exp2);
        statement testbody = make_block_statement(tcode);
        statement stat = make_test_statement(test_bound,testbody,
            make_empty_block_statement());
        return (gen_nconc(ccode,CONS(STATEMENT,stat,NIL)));
    } 
    else { 
        entity  ent1 = make_new_module_variable(memory_module,100);
        list ccode= constant_symbolic_communication(memory_module,lst,
                                                    !load_code,(entity) bank_indices->var); 
        list icode= constant_symbolic_communication(memory_module,lt,
                                                    load_code,ent1);
        range looprange = make_range(int_to_expression(0),
                                     int_to_expression(bn-1),
                                     int_to_expression(1));
        statement loopbody = make_block_statement(icode);
        entity looplabel = make_loop_label(9000, memory_module);
        
        loop newloop = make_loop(ent1,looprange, loopbody, looplabel, 
                                 make_execution(is_execution_parallel,UU), NIL);
 
        statement  stat = loop_to_statement(newloop);
        AddEntityToDeclarations(ent1,memory_module);
        icode = gen_nconc(ccode,CONS(STATEMENT,stat,NIL));
        return icode;
    }
}
 
static list 
build_esv_list(list lt, hash_table v_to_esv, Pbase bank_indices)
{
    list newlt=NIL;
    MAPL(ref, {
        Variable var1 = (Variable) reference_variable(REFERENCE(CAR(ref)));
        entity esv = (entity) hash_get(v_to_esv, (char *) var1); 
        expression expr1 = make_vecteur_expression
            (vect_new((char *) bank_indices->succ->var, VALUE_ONE));
        expression expr2 = make_vecteur_expression
            (vect_new((char *) bank_indices->succ->succ->var, VALUE_ONE));
        list args = CONS(EXPRESSION,expr2, CONS(EXPRESSION,expr1,NIL));
        reference ref1 =  make_reference((Variable) esv,args);
    newlt=CONS(REFERENCE,ref1,newlt);
    },lt);
    return gen_nreverse(newlt);
 
}
 
static void insert_array_scalar_access_movement(entity compute_module,entity memory_module,
                                    Pbase  bank_indices, int bn,int ls,entity proc_id,entity ent1,
                                   list lt, statement stat,bool load,hash_table v_to_esv,
                                   list *new_slst,list *new_blist, bool fully_sequential,
                                                Pbase loop_indices,tiling  tile,Pvecteur tile_delay, 
                                      Pvecteur tile_indices,  Pvecteur tile_local_indices)
{
    list ccode ;
    ifdebug(8) {
        fprintf(stderr,
                " communication to be inserted at run time stat no %"PRIdPTR": ",
                statement_number(stat));
        reference_list_print(lt); 
   
               }
  
    /* creation d'une nouvelle entite pour servir de temporaire au 
       numero de banc memoire contenant la variable scalaire */
    ccode =array_scalar_access_to_compute_communication(compute_module, 
                                                        bank_indices,bn,
                                                        ls,lt,load,proc_id,
                                                        ent1,fully_sequential,
                                                        loop_indices,tile, tile_delay,tile_indices,
                                                        tile_local_indices); 
 
    *new_slst = gen_nconc(*new_slst,ccode); 
    lt = build_esv_list(lt,v_to_esv,bank_indices);
    ccode =array_scalar_access_to_bank_communication(memory_module, bank_indices,bn,
                                                     ls,lt,!load, proc_id,
                                                     ent1,fully_sequential);
 
    *new_blist = gen_nconc(*new_blist,ccode);
}  
␌           
 
void insert_run_time_communications(entity compute_module,entity memory_module,
                                    Pbase  bank_indices, int bn,int ls,entity proc_id,
                                   list list_statement_block,
                                    statement_mapping fetch_map,statement_mapping store_map,
                                    list *new_slst,list *new_blist,hash_table v_to_esv,
                                    bool fully_sequential,
                                    Pbase loop_indices,tiling  tile,Pvecteur tile_delay, 
                                      Pvecteur tile_indices,  Pvecteur tile_local_indices)
{
    int nbcall=0; 
    entity ent1=entity_undefined; 
    
    MAPL(st1, 
     { instruction inst = statement_instruction(STATEMENT(CAR(st1)));
       switch(instruction_tag(inst)) {
       case is_instruction_block: {
          
           list new_slst1 = NIL; 
           nbcall = 0; 
           MAPL(st2, {
               insert_run_time_communications(compute_module,memory_module, 
                                              bank_indices,bn,ls,proc_id,
                                              CONS(STATEMENT,
                                                   STATEMENT(CAR(st2)),NIL),
                                              fetch_map,store_map,
                                              &new_slst1,new_blist,
                                              v_to_esv,fully_sequential,
                                              loop_indices,tile, tile_delay,
                                              tile_indices,tile_local_indices);
           
 
},
                instruction_block(inst));  
           instruction_block(inst)= new_slst1;  
           break; }
       case is_instruction_loop: {
           statement lbody = loop_body(instruction_loop(inst));
           statement sbody = make_block_statement(CONS(STATEMENT,
                                                       lbody,NIL));
           cons *nbody=(instruction_call_p(statement_instruction(lbody))) ? 
               CONS(STATEMENT,sbody,NIL) : 
                   CONS(STATEMENT,lbody,NIL);
           insert_run_time_communications(compute_module,memory_module, 
                                          bank_indices,bn,ls,proc_id,
                                          nbody,fetch_map,store_map,new_slst,
                                          new_blist,
                                          v_to_esv,fully_sequential,
                                          loop_indices,tile, tile_delay,
                                          tile_indices,tile_local_indices);
            *new_slst = gen_nconc(*new_slst,
                                  CONS(STATEMENT,STATEMENT(CAR(st1)),NIL)); 
           break;
       }
       case is_instruction_call: {
           list  lt;
         
           if ((lt= (list) 
                GET_STATEMENT_MAPPING(fetch_map,STATEMENT(CAR(st1))))
               != (list) HASH_UNDEFINED_VALUE && nbcall ) { 
 
               ent1 = make_new_module_variable(compute_module,100);
               AddEntityToDeclarations(ent1,compute_module);
               
               insert_array_scalar_access_movement(compute_module,memory_module,bank_indices,
                                                   bn,ls,proc_id,ent1,lt,STATEMENT(CAR(st1)),true,
                                                   v_to_esv,new_slst,new_blist,fully_sequential,
                                                   loop_indices,tile, tile_delay,tile_indices,
                                                   tile_local_indices
                                                   );
           }
           if ((lt=(list) GET_STATEMENT_MAPPING(store_map,
                                                STATEMENT(CAR(st1))))
               != (list) HASH_UNDEFINED_VALUE && nbcall )
           { 
               ent1 = make_new_module_variable(compute_module,100);
               AddEntityToDeclarations(ent1,compute_module);
           
               insert_array_scalar_access_movement(compute_module,memory_module,bank_indices,
                                                   bn,ls,proc_id,ent1,lt,STATEMENT(CAR(st1)),false,
                                                   v_to_esv,new_slst,new_blist,fully_sequential,
                                                   loop_indices,tile, tile_delay,tile_indices,
                                                   tile_local_indices);
           }
           *new_slst = gen_nconc(*new_slst,CONS(STATEMENT,STATEMENT(CAR(st1)),NIL));
           nbcall ++;
           break;
       }
       default:
           break;
       }
   }, list_statement_block);
}
␌
bool 
test_run_time_communications(list list_statement_block,
                                    statement_mapping fetch_map,statement_mapping store_map)
{
    bool ok ;
    int nbcall =0;
    MAPL(st1, 
     { instruction inst = statement_instruction(STATEMENT(CAR(st1)));
       switch(instruction_tag(inst)) {
       case is_instruction_block: { 
           ok = false;
           MAPL(st2, {
               ok = (ok) ? ok : 
                   test_run_time_communications(CONS(STATEMENT,
                                                     STATEMENT(CAR(st2)),
                                                     NIL),
                                                fetch_map,store_map);
           }, 
               instruction_block(inst));
           return ok;
           break; }
       case is_instruction_loop: {
           return(test_run_time_communications(CONS(STATEMENT,
                                                    loop_body(instruction_loop(inst)),
                                                    NIL),
                                               fetch_map,store_map));
           break;}
       case is_instruction_call: {
           list  lt = (list) GET_STATEMENT_MAPPING(fetch_map,STATEMENT(CAR(st1))); 
           if (lt != (list) HASH_UNDEFINED_VALUE) {
               nbcall ++;
           return (true);  
               } else
                   return(false);
           break;
       }
       default:
           break;
       }
   }, 
       list_statement_block);
 /* just to avoid warning */
 return (true);
}
␌