messages.c

Go to the documentation of this file.

/*
 
  $Id: messages.c 23065 2016-03-02 09:05:50Z 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
/* Messages handling
 *
 * Fabien Coelho, August 1993
 */
 
#include "defines-local.h"
#include "access_description.h"
 
/*  ????
 */
static expression safe_static_domain_bound(array, dim, e, shift, lower)
entity array;
int dim;
expression e;
int shift;
bool lower;
{
    expression result;
    int l=0, u=0, tmp=-1;
 
    if (hpfc_integer_constant_expression_p(e, &tmp))
        result = int_to_expression(tmp+shift);
    else
    {
        get_entity_dimensions(array, dim, &l, &u);
        result = int_to_expression(lower ? l : u);
    }
 
    return(result);
}
 
/* message generate_one_message(array, li, lk, lv)
 *
 * generate one message after the reference given,
 */
static message generate_one_message(array, li, lk, lv)
entity array;
list li, lk, lv;
{
    int i   = 1, len = gen_length(li);
    list lip  = li, lkp  = lk, lvp  = lv, lr   = NIL, ldom = NIL;
    entity newarray = load_new_node(array);
    Pvecteur procv = VECTEUR_NUL;
    
    assert(len==(int)gen_length(lk) && len==(int)gen_length(lv));
 
    for ( ; i<=len ; i++, lip=CDR(lip), lkp=CDR(lkp), lvp=CDR(lvp))
    {
        tag at = access_tag(INT(CAR(lkp)));
        Pvecteur v  = (Pvecteur) PVECTOR(CAR(lvp));
        expression indice = EXPRESSION(CAR(lip)); 
        dimension newdim = FindIthDimension(newarray, i);
        int
            arraylo = HpfcExpressionToInt(dimension_lower(newdim)),
            arrayup = HpfcExpressionToInt(dimension_upper(newdim));
 
        pips_debug(9, "array %s, dimension %d, access considered is %d\n",
                   entity_local_name(newarray), i, at);
 
        switch (at)
        {
        case aligned_constant:
        {
            /* I think I don't need to store the to where value...
             * that's rather interesting since I do not know where I could
             * put it...
             */
            Value cst = vect_coeff(TCST, v), vt = vect_coeff(TEMPLATEV, v);
            int tpl = VALUE_TO_INT(vt),
                localarraycell = template_cell_local_mapping(array, i, tpl);
 
            /* no neighbour concerned */
            /* content: */
            lr = gen_nconc(lr,
                           CONS(RANGE,
                                make_range(int_to_expression(localarraycell),
                                           int_to_expression(localarraycell),
                                           int_to_expression(1)),
                                NIL));
            /* domain: */
            ldom = gen_nconc(ldom,
                             CONS(RANGE,
                                  make_range(Value_to_expression(cst),
                                             Value_to_expression(cst),
                                             int_to_expression(1)),
                                  NIL));
            break;
        }
        case aligned_shift: 
            /* 
             * note that rate==1 
             */
        {
            Pvecteur vindex = the_index_of_vect(v);
            entity index = (entity) var_of(vindex);
            range rg = loop_index_to_range(index);
            Value vs = vect_coeff(TSHIFTV, v), vi = vect_coeff(TCST, v);
            int procdim,
                shift = VALUE_TO_INT(vs),
                ishft = VALUE_TO_INT(vi),
                n     = DistributionParameterOfArrayDim(array, i, &procdim);
            expression dom_lb, dom_ub;
 
            debug(10, "generate_one_message",
                  "n = %d, just to avoid a gcc warning:-)\n", n);
            
            if (shift!=0)
            {
                /* neighbour to send to */
                procv = vect_add(procv, 
                                 vect_new((Variable) (intptr_t)procdim, 
                                          (shift<0)?(VALUE_ONE):(VALUE_MONE)));
                
                /* content, on the sender point of view... */
                if (shift<0)
                {
                    lr = gen_nconc
                        (lr,
                         CONS(RANGE,
                              make_range(int_to_expression(arrayup+shift+1),
                                         int_to_expression(arrayup),
                                         int_to_expression(1)),
                              NIL));
                }
                else /* (shift>0) */
                {
                    lr = gen_nconc
                        (lr,
                         CONS(RANGE,
                              make_range(int_to_expression(arraylo),
                                         int_to_expression(arraylo+shift-1),
                                         int_to_expression(1)),
                              NIL));
                }
            }
            else /* shift == 0 */
            {
                /* content: send it all? */
                lr = gen_nconc(lr,
                               CONS(RANGE,
                                    make_range(int_to_expression(arraylo),
                                               int_to_expression(arrayup),
                                               int_to_expression(1)),
                                    NIL));
            }
 
            /* assert(gen_consistent_p(rg)); */
 
            dom_lb = safe_static_domain_bound(array, i, 
                                              range_lower(rg), ishft, true);
            dom_ub = safe_static_domain_bound(array, i, 
                                              range_upper(rg), ishft, false);
            
            /* domain */
            ldom = 
                gen_nconc(ldom,
                          CONS(RANGE,
                               make_range(dom_lb,
                                          dom_ub,
                                          int_to_expression(1)), /* ??? why 1 */
                               NIL));
            
            break;
        }
        case local_constant:
        {
            Value
                /* ??? bug if there is a declaration shift... */
                arraycell = vect_coeff(TCST, v);
 
            /* no neighbour concerned */
            /* content: */
            lr = gen_nconc(lr,
                           CONS(RANGE,
                                make_range(Value_to_expression(arraycell),
                                           Value_to_expression(arraycell),
                                           int_to_expression(1)),
                                NIL));
            /* domain: */
            ldom = gen_nconc(ldom,
                             CONS(RANGE,
                                  make_range(Value_to_expression(arraycell),
                                             Value_to_expression(arraycell),
                                             int_to_expression(1)),
                                  NIL));
            break;
        }
        case local_shift:
        {
            Pvecteur vindex = the_index_of_vect(v);
            entity index = (entity) var_of(vindex);
            range rg = loop_index_to_range(index);
            Value vs = vect_coeff(TCST, v);
            int shift = VALUE_TO_INT(vs),
                ishft = shift,
                lb    = HpfcExpressionToInt(range_lower(rg)),
                ub    = HpfcExpressionToInt(range_upper(rg));
            
            /* no neighbour */
            /* content: all shifted space indexed */
            /* ??? false if declaration shift */
            lr = 
                gen_nconc(lr,
                          CONS(RANGE,
                               make_range(int_to_expression(lb+shift),
                                          int_to_expression(ub+shift),
                                          int_to_expression(1)),
                               NIL));
 
            /* domain */
            ldom = 
                gen_nconc(ldom,
                          CONS(RANGE,
                               make_range(int_to_expression(lb+ishft),
                                          int_to_expression(ub+ishft),
                                          int_to_expression(1)),/* ??? why 1 */
                               NIL));
            
 
            break;
        }
        case local_affine:
        {
            Pvecteur
                vindex = the_index_of_vect(v);
            entity
                index = (entity) var_of(vindex);
            range
                rg = loop_index_to_range(index);
            Value vs = vect_coeff(TCST, v);
            int
                rate  = VALUE_TO_INT(val_of(vindex)),
                shift = VALUE_TO_INT(vs),
                ishft = shift,
                in    = HpfcExpressionToInt(range_increment(rg)),
                lb    = HpfcExpressionToInt(range_lower(rg)),
                ub    = HpfcExpressionToInt(range_upper(rg));
            
            /* no neighbour */
            /* content: all shifted space indexed */
            /* ??? false if declaration shift */
            lr = gen_nconc(lr,
                           CONS(RANGE,
                                make_range(int_to_expression(rate*lb+shift),
                                           int_to_expression(rate*ub+shift),
                                           int_to_expression(in*rate)),
                                    NIL));
 
            /* domain */
            ldom = gen_nconc(ldom,
                             CONS(RANGE,
                                  make_range(int_to_expression(rate*lb+ishft),
                                             int_to_expression(rate*ub+ishft),
                                             int_to_expression(in*rate)), 
                                  NIL));
            
 
            break;
        }
        case local_form_cst:
        {
            /* no neighbour concerned */
            /* content: */
            lr = gen_nconc(lr,
                           CONS(RANGE,
                                make_range(indice,
                                           indice,
                                           int_to_expression(1)),
                                NIL));
            /* domain: */
            ldom = gen_nconc(ldom,
                             CONS(RANGE,
                                  make_range(indice,
                                             indice,
                                             int_to_expression(1)),
                                  NIL));
            break;
        }
        default:
            pips_internal_error("access tag not welcomed here (%d)", at);
            break;
        }
    }       
    
    return(make_message(array, lr, procv, ldom));
}
 
/* list messages_generation(Ro, lRo)
 *
 * first kind of messages generation 
 * (the overlap management is handled in message_manageable_p())
 */
static list messages_generation(Ro, lRo)
list Ro, lRo;
{
    list
        lm = NIL,
        lr = NIL,
        lp = NIL;
   
    for (lr=Ro, lp=lRo ; lr!=NIL ; lr=CDR(lr), lp=CDR(lp))
    {
        reference
            r = syntax_reference(SYNTAX(CAR(lr)));
        entity
            array = reference_variable(r);
        list
            li  = reference_indices(r),
            lkv = CONSP(CAR(lp)),
            lk  = CONSP(CAR(lkv)),
            lv  = CONSP(CAR(CDR(lkv)));
        int
            len = gen_length(li);
 
        assert(len==(int)gen_length(lk) && len==(int)gen_length(lv));
 
        lm = CONS(MESSAGE,
                  generate_one_message(array, li, lk, lv),
                  lm);    
    }
 
    return(lm);
}
 
static list atomize_one_message(m)
message m;
{
    entity
        array = message_array(m);
    list
        content = message_content(m),
        domain  = message_dom(m),
        lneighbour = NIL,
        lcontent   = NIL,
        ldomain    = NIL,
        cnt = NIL, 
        dom = NIL,
        lm = NIL;
    Pvecteur
        v = (Pvecteur) message_neighbour(m);
    int
        i = 1;
    
    ifdebug(9)
    {
        fprintf(stderr, "[atomize_one_message] ");
        fprint_message(stderr, m);
    }
    
    for (cnt=content, dom=domain ; cnt!=NIL ; cnt=CDR(cnt), dom=CDR(dom), i++)
    {
        int procdim;
        range rcnt = RANGE(CAR(cnt)), rdom = RANGE(CAR(dom));
        bool distributed = ith_dim_distributed_p(array, i, &procdim);
        Value vn = distributed? vect_coeff((Variable) (intptr_t)procdim, v):  VALUE_ZERO;
        int neighbour = VALUE_TO_INT(vn);
 
        debug(9, "atomize_one_message", "dimension %d\n", i);
 
        if (neighbour==0)
        {
            lcontent   = add_to_list_of_ranges_list(lcontent, rcnt);
            ldomain    = add_to_list_of_ranges_list(ldomain, rdom);
            lneighbour = add_elem_to_list_of_Pvecteur(lneighbour, 0, 0);
        }
        else /* let's count in binary mode */
        {
            list
                lc = dup_list_of_ranges_list(lcontent),
                ld = dup_list_of_ranges_list(ldomain),
                ln = dup_list_of_Pvecteur(lneighbour);
            
            lcontent = 
                add_to_list_of_ranges_list(lcontent,
                                           complementary_range(array, i, rcnt));
            ldomain    = add_to_list_of_ranges_list(ldomain, rdom);
            lneighbour = add_elem_to_list_of_Pvecteur(lneighbour, 0, 0);
 
            lc = add_to_list_of_ranges_list(lc, rcnt);
            ld = add_to_list_of_ranges_list(ld, rdom);
            ln = add_elem_to_list_of_Pvecteur(ln, procdim, neighbour);
 
            lcontent   = gen_nconc(lcontent, lc);
            ldomain    = gen_nconc(ldomain, ld);
            lneighbour = gen_nconc(lneighbour, ln);
        }       
    }
 
    /*
     * message generation from the lists
     */
 
    lm = generate_message_from_3_lists(array, lcontent, lneighbour, ldomain);
 
    gen_free_list(lcontent);
    gen_free_list(lneighbour);
    gen_free_list(ldomain);
 
    return(lm);
}
 
static list messages_atomization(lm1)
list lm1;
{
    list lm2 = NIL;
 
    MAP(MESSAGE, m, lm2 = gen_nconc(atomize_one_message(m), lm2), lm1);
 
    return lm2;
}
 
static list keep_non_empty_messages_with_destination(l)
list l;
{
    list result = NIL;
 
    MAP(MESSAGE, m,
     {
         if ((!VECTEUR_NUL_P((Pvecteur) message_neighbour(m))) &&
             (!empty_section_p(message_content(m))))
             result = CONS(MESSAGE, m, result);
         /* ??? else memory leak */
     },
         l);
 
    return(result);
}
 
static list keep_non_empty_domain_messages(l)
list l;
{
    list
        result = NIL;
    
    MAP(MESSAGE, m,
     {
         if (!empty_section_p(message_dom(m)))
             result = CONS(MESSAGE, m, result);
         /* ??? else memory leak */
     },
         l);
 
    return(result);
}
 
/* message shape_one_message(m)
 *
 * caution, rate==1 is assumed.
 */
static message shape_one_message(m)
message m;
{
    entity
        array = message_array(m);
    list 
        lr = message_content(m),
        ld = message_dom(m),
        lnewdomain = NIL;
    int
        procdim = 0,
        i = 1;
 
    for ( ; lr!=NIL ; i++, lr=CDR(lr), ld=CDR(ld))
    {
        range
            d = RANGE(CAR(ld)),
            r = RANGE(CAR(lr));
 
        if (ith_dim_distributed_p(array, i, &procdim)) /* ??? is that all ? */
        {
            int
                newdlo = 0,
                newdup = 0,
                dlo = HpfcExpressionToInt(range_lower(d)),
                dup = HpfcExpressionToInt(range_upper(d)),
                rlo = HpfcExpressionToInt(range_lower(r)),
                rup = HpfcExpressionToInt(range_upper(r)),
                n = DistributionParameterOfArrayDim(array, i, &procdim),
                localdlo = global_array_cell_to_local_array_cell(array, i, dlo),
                localdup = global_array_cell_to_local_array_cell(array, i, dup);
            
            assert(rlo<=rup); /* message content isn't empty */
            
            /*
             * I thought a long time about it, just for these two formulas:
             */
            newdlo = dlo+(rlo-localdlo)+((localdlo>rup)?(n):(0));
            newdup = dup+(rup-localdup)-((localdup<rlo)?(n):(0));
            
            lnewdomain = gen_nconc(lnewdomain,
                                   CONS(RANGE,
                                        make_range(int_to_expression(newdlo),
                                                   int_to_expression(newdup),
                                                   int_to_expression(1)),
                                        NIL));
        }
        else
        {
            lnewdomain = gen_nconc(lnewdomain, CONS(RANGE, d, NIL));
        }                                       
    }
    
    gen_free_list(message_dom(m));
    message_dom(m) = lnewdomain;
    
    return(m);
}
 
static list messages_shaping(l)
list l;
{
    list result = NIL;
    
    MAP(MESSAGE, m, result = CONS(MESSAGE, shape_one_message(m), result), l);
 
    return(result);
}
 
static message one_message_guards_and_neighbour(m)
message m;
{
    Pvecteur
        v = (Pvecteur) message_neighbour(m);
    entity
        array     = message_array(m),
        template  = array_to_template(array),
        processor = template_to_processors(template);
    list
        lra = message_dom(m),
        lrt = array_ranges_to_template_ranges(array, lra),
        lrp = template_ranges_to_processors_ranges(template, lrt);
    int
        i = 1, t = 0, procndim = NumberOfDimension(processor);
    Value vt;
 
    gen_free_list(lra);
    gen_free_list(lrt);
 
    message_dom(m) = lrp;
 
    /* now the neighbour computation in the linearized processor
     * arrangment named NODETIDS() of common /HPFC_PARAM/.
     * the code is similar to the runtime support function HPFC_PROCLID().
     */
 
    assert(procndim>=1);
 
    vt = vect_coeff((Variable) 1, v);
    t = VALUE_TO_INT(vt);
    for (i=2 ; i<=NumberOfDimension(processor) ; i++)
    {
        Value vi = vect_coeff((Variable) (intptr_t) i, v);
        t = t*SizeOfIthDimension(processor, i) + VALUE_TO_INT(vi) ;
    }
 
    message_neighbour_(m) =
        newgen_Pvecteur(vect_add(v, vect_new(TCST, int_to_value(t))));
 
    return(m);
}
 
static list messages_guards_and_neighbour(l)
list l;
{
    list result = NIL;
 
    MAP(MESSAGE, m,
        result = CONS(MESSAGE, one_message_guards_and_neighbour(m), result),
        l);
    
    return result;
}
 
 
static message one_receive_message(send)
message send;
{
    entity
        array = message_array(send);
    Pvecteur
        sendneighbour = (Pvecteur) message_neighbour(send),
        neighbour = vect_new(TCST, 
                             value_uminus(vect_coeff(TCST, sendneighbour)));
    list
        content = compute_receive_content(array, message_content(send), 
                                          sendneighbour),
        domain  = compute_receive_domain(message_dom(send), sendneighbour);
 
    return(make_message(array, content, neighbour, domain));
}
 
/* list receive_messages_generation(lms)
 *
 * this function must warranty that all messages send will be received,
 * so the messages are symetric.
 */
static list receive_messages_generation(lms)
list lms;
{
    list lmr = NIL;
 
    MAP(MESSAGE, send,
    {
        lmr = gen_nconc(lmr, CONS(MESSAGE,
                                  one_receive_message(send),
                                  NIL));
    },
        lms);
 
    return(lmr);
}
 
/* statement st_one_message(m, bsend)
 *
 * this function will have to be modified in order to include 
 * message coalescing and aggregation. Here, a direct call to
 * a function that packs and passes the message is made.
 */
static statement st_one_message(m, bsend)
message m;
bool bsend;
{
    char buffer[100], *buf = buffer;
    entity array     = message_array(m),
           processor = array_to_processors(array);
    list content = message_content(m),
         domain  = message_dom(m);
    Value vn = vect_coeff(TCST, (Pvecteur) message_neighbour(m));
    int neighbour = VALUE_TO_INT(vn);
    statement
        cmpneighbour = st_compute_neighbour(neighbour),
        pass = (bsend ? st_send_to_neighbour() : st_receive_from_neighbour()),
        pack = st_generate_packing(array, content, bsend);
    list interm = CONS(STATEMENT, 
                      cmpneighbour,
                      (bsend ?
                       CONS(STATEMENT, pack, CONS(STATEMENT, pass, NIL)) :
                       CONS(STATEMENT, pass, CONS(STATEMENT, pack, NIL))));
    statement
        result = generate_guarded_statement(make_block_statement(interm),
                                            processor,
                                            domain);
    
    /* comment generation to improve readibility of the code
     */
    sprintf(buf, "! %s(", entity_local_name(processor));
    buf += strlen(buf);
    sprint_lrange(buf, domain);
    buf += strlen(buf);
    sprintf(buf, ") %s %s(", bsend ? "send" : "receive",
            entity_local_name(array));
    buf += strlen(buf);
    sprint_lrange(buf, content);
    buf += strlen(buf);
    sprintf(buf, ") %s (%s%d)\n", bsend ? "to" : "from", 
            neighbour>0 ? "+" : "-", abs(neighbour));
    buf += strlen(buf);
 
    insert_comments_to_statement(result, buffer);
    return result;
}
 
static list generate_the_messages(lm, bsend)
list lm;
bool bsend;
{
    list l = NIL;
 
    MAP(MESSAGE, m, l = CONS(STATEMENT, st_one_message(m, bsend), l), lm);
 
    return l;
}
 
/* list remove_stammering_messages(lm)
 *
 * remove messages that are contained in another message
 */
static list remove_stammering_messages(lm)
list lm;
{
    list kept = NIL;
 
    MAPL(cm,
    {
        message m = MESSAGE(CAR(cm));
 
        if (!larger_message_in_list(m, kept) &&
            !larger_message_in_list(m, CDR(cm)))
            kept = CONS(MESSAGE, m, kept);
    },
        lm);
 
    return kept;
}
 
/* every required conditions are supposed to be verified in this function.
 */
statement messages_handling(Ro, lRo)
list Ro, lRo;
{
    list
        lm1  = NIL,
        lm2  = NIL,
        lm2p = NIL,
        lm3  = NIL,
        lm3p = NIL,
        lm4  = NIL,
        lms  = NIL,
        lmr  = NIL,
        lsend = NIL,
        lreceive = NIL;
    int
        len = gen_length(Ro);
    
    assert(len==(int)gen_length(lRo) && len>=1);
 
    /* first kind of messages generation
     *
     * a message is 
     * an array,
     * a mixed content on the local array,
     * a set of neighbours (in a Pvecteur) and
     * an array section concerned.
     */
    lm1 = messages_generation(Ro, lRo);
 
    debug(6, "messages_handling", "lm1 length is %d\n", gen_length(lm1));
    ifdebug(8)
    {
        fprint_lmessage(stderr, lm1);
    }
 
    /*
     * second kind of messages generation
     *
     * messages are atomized to real messages:
     * a message is 
     * an array, 
     * a content (on the local array),
     * a neighbour to send to (in a Pvecteur),
     * a domain of the array concerned.
     */
    lm2 = messages_atomization(lm1);
    gen_free_list(lm1);
 
    debug(6, "messages_handling",
          "lm2 length is %d\n", gen_length(lm2));
    ifdebug(8)
    {
        fprint_lmessage(stderr, lm2);
    }
 
    lm2p = keep_non_empty_messages_with_destination(lm2);
    gen_free_list(lm2);
 
    debug(6, "messages_handling",
          "lm2p length is %d\n", gen_length(lm2p));
    ifdebug(8)
    {
        fprint_lmessage(stderr, lm2p);
    }
 
 
    /*
     * third kind of messages generation
     *
     * the domain is restricted to what is necessary for the
     * given message, and this on every distributed dimension...
     * this is important for the guards generation later on.
     */
    lm3 = messages_shaping(lm2p);
    gen_free_list(lm2p);
 
    debug(6, "messages_handling",
          "lm3 length is %d\n", gen_length(lm3));
    ifdebug(8)
    {
        fprint_lmessage(stderr, lm3);
    }
 
 
    lm3p = keep_non_empty_domain_messages(lm3);
    gen_free_list(lm3);
 
    debug(6, "messages_handling", "lm3p length is %d\n", gen_length(lm3p));
    ifdebug(8) fprint_lmessage(stderr, lm3p);
 
    /*
     * fourth kind of messages generation
     * 
     * the array section domain is translated into a processors section,
     * and the neighbour shift is computed for the linearized processors 
     * arrangement considered in the runtime resolution.
     */
    lm4 = messages_guards_and_neighbour(lm3p);
    gen_free_list(lm3p);
    
    debug(6, "messages_handling", "lm4 length is %d\n", gen_length(lm4));
    ifdebug(8) fprint_lmessage(stderr, lm4);
 
    /* here should be performed some message coalescing and/or aggregation:
     * a first simple version could check for messages sent twice, and so on.
     */
    hpfc_warning("messages coalescing and aggregation not implemented\n");
 
    lms = remove_stammering_messages(lm4);
 
    /*  RECEIVE 
     */
    lmr = receive_messages_generation(lms);
 
    assert(gen_length(lmr)==gen_length(lms));
 
    ifdebug(8)
    {
        fprintf(stderr, "[message handling] lmr and lms\n");
        fprint_lmessage(stderr, lmr);
        fprint_lmessage(stderr, lms);
    }
 
    lsend = generate_the_messages(lms, SEND);
    lreceive = generate_the_messages(lmr, RECEIVE);
 
    return(make_block_statement(gen_nconc(lsend, lreceive)));    
}
 
/*   that is all
 */