message-utils.c

Go to the documentation of this file.

/*
 
  $Id: message-utils.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
/* Message Utilities
 * 
 * Fabien Coelho, August 1993
 */
 
#include "defines-local.h"
#include "access_description.h"
 
/* returns the index of an affine vector
 */
Pvecteur the_index_of_vect(v0)
Pvecteur v0;
{
    Pvecteur v1 = vect_del_var(v0, TCST);
 
    vect_erase_var(&v1, DELTAV);
    vect_erase_var(&v1, TEMPLATEV);
    vect_erase_var(&v1, TSHIFTV);
 
    assert(vect_size(v1)==1);
 
    return v1;
}
 
list add_to_list_of_ranges_list(l, r)
list l;
range r;
{
    if (ENDP(l)) /* first time */
        return CONS(LIST, CONS(RANGE, r, NIL), NIL);
 
    /* else */
    MAPL(cc,
     {
         list lr = CONSP(CAR(cc));
         assert(!ENDP(lr));
         lr = gen_nconc(lr, CONS(RANGE, r, NIL));
     },
         l);
 
    return(l);
}
 
/* ??? the complexity of this function could be greatly improved
 */
list dup_list_of_ranges_list(l)
list l;
{
    list result = NIL;
 
    MAPL(cc,
     {
         list lr = CONSP(CAR(cc));
         list lrp = NIL;
         MAP(RANGE, r, lrp = gen_nconc(lrp, CONS(RANGE, r, NIL)), lr);
         assert(gen_length(lrp)==gen_length(lr));
         result = gen_nconc(result, CONS(LIST, lrp, NIL));
     },
         l);
 
    assert(gen_length(l)==gen_length(result));
    return result;
}
 
/* ??? the complexity of this function could be improved greatly...
 */
list dup_list_of_Pvecteur(l)
list l;
{
    list result = NIL;
 
    MAPL(cv,
     {
         Pvecteur v = (Pvecteur) PVECTOR(CAR(cv));
         result = gen_nconc(result, CONS(PVECTOR, (VECTOR) vect_dup(v), NIL));
     },
         l);
 
    return result;
}
 
/* caution, is initial list is destroyed.
 */
list add_elem_to_list_of_Pvecteur(l, var, val)
list l;
int var, val;
{
    list result = NIL;
 
    if (ENDP(l))
        return CONS(PVECTOR, (VECTOR) vect_new((Variable) (intptr_t)var,
                                               int_to_value(val)), NIL);
 
    if ((var==0) || (val==0))
        return l;
 
    /* else */
 
    MAPL(cv,
     {
         Pvecteur v = (Pvecteur) PVECTOR(CAR(cv));
         pips_debug(9, "size of vector %p is %d\n", v, vect_size(v));
         vect_add_elem(&v, (Variable) (intptr_t) var, int_to_value(val));
         result = gen_nconc(result, CONS(PVECTOR, (VECTOR) v, NIL));
     },
         l);
 
    gen_free_list(l);
 
    return result;
}
    
/* range complementary_range(array, dim, r)
 */
range complementary_range(array, dim, r)
entity array;
int dim;
range r;
{
    entity newarray = load_new_node(array);
    dimension d = FindIthDimension(newarray, dim);
    int rlo = HpfcExpressionToInt(range_lower(r)),
        rup = HpfcExpressionToInt(range_upper(r)),
        rin = HpfcExpressionToInt(range_increment(r)),
        dlo = HpfcExpressionToInt(dimension_lower(d)),
        dup = HpfcExpressionToInt(dimension_upper(d));
 
    assert(rin==1);
 
    if (dup==rup)
        return(make_range(int_to_expression(dlo),
                          int_to_expression(rlo-1),
                          int_to_expression(1)));
 
    if (dlo==rlo)
        return(make_range(int_to_expression(rup+1),
                          int_to_expression(dup),
                          int_to_expression(1)));
 
    pips_internal_error("well, there is a problem here around");
 
    return(range_undefined); /* just to avoid a gcc warning */
}
 
/* list generate_message_from_3_lists(array, lcontent, lneighbour, ldomain)
 */
list generate_message_from_3_lists(array, lcontent, lneighbour, ldomain)
entity array;
list lcontent, lneighbour, ldomain;
{
    list lc = lcontent, ln = lneighbour, ld = ldomain, lm = NIL;
    int len = gen_length(lcontent);
 
    assert(len==(int)gen_length(lneighbour) && len==(int)gen_length(ldomain));
 
    for ( ; lc!=NIL ; lc=CDR(lc), ln=CDR(ln), ld=CDR(ld))
    {
        lm = CONS(MESSAGE,
                  make_message(array,
                               CONSP(CAR(lc)),
                               (Pvecteur)PVECTOR(CAR(ln)),
                               CONSP(CAR(ld))),
                  lm);                         
    }
 
    return(lm);
}
 
bool empty_section_p(lr)
list lr;
{
    return((ENDP(lr))?
           (false):
           (empty_range_p(RANGE(CAR(lr))) || empty_section_p(CDR(lr))));
}
 
bool empty_range_p(r)
range r;
{
    int lo, up;
 
    /*   if we cannot decide, the range is supposed not to be empty
     */
    if (! (hpfc_integer_constant_expression_p(range_lower(r), &lo) &&
           hpfc_integer_constant_expression_p(range_upper(r), &up)))
        return false; 
    else
        return lo>up;
}
 
char *sprint_lrange(str, l)
string str;
list l;
{
    string s = str;
    bool firstrange = true;
 
    MAP(RANGE, r,
    {
        if (!firstrange)
        {
            sprintf(s, ", "); 
            s += strlen(s);
        }
        else
            firstrange = false;
 
        sprint_range(s, r);
        s += strlen(s);
    },
        l);
 
    return str;
}
 
char *sprint_range(string str, range r)
{
    int lo, up, in;
    bool
        blo = hpfc_integer_constant_expression_p(range_lower(r), &lo),
        bup = hpfc_integer_constant_expression_p(range_upper(r), &up),
        bin = hpfc_integer_constant_expression_p(range_increment(r), &in);
 
    if (blo && bup && bin)
    {
        if (in==1)
        {
            if (lo==up)
                sprintf(str, "%d", lo);
            else
                sprintf(str, "%d:%d", lo, up);
        }
        else
            sprintf(str, "%d:%d:%d", lo, up, in);
    }
    else
        sprintf(str, "X");
 
    return str+strlen(str);
}
 
list compute_receive_content(array, lr, v)
entity array;
list lr;
Pvecteur v;
{
    list content = NIL, l = lr;
    int i = 1;
 
    assert(NumberOfDimension(array)==(int)gen_length(lr));
 
    for (; l; i++, POP(l))
    {
        int procdim = 0;
        bool distributed_dim = ith_dim_distributed_p(array, i, &procdim);
        Value vn = distributed_dim? 
            vect_coeff((Variable) (intptr_t)procdim, v): VALUE_ZERO;
        int neighbour = VALUE_TO_INT(vn);
        range r = RANGE(CAR(l));
 
        if (neighbour!=0)
        {
            entity newarray = load_new_node(array);
            dimension nadim = FindIthDimension(newarray, i);
            expression incr  = range_increment(r);
            int lom1  = HpfcExpressionToInt(dimension_lower(nadim))-1,
                upp1  = HpfcExpressionToInt(dimension_upper(nadim))+1,
                width = (HpfcExpressionToInt(range_upper(r)) -
                         HpfcExpressionToInt(range_lower(r)));
 
            content =
                gen_nconc(content,
                          CONS(RANGE,
                               (neighbour<0)?
                               make_range(int_to_expression(upp1),
                                          int_to_expression(upp1+width),
                                          incr):
                               make_range(int_to_expression(lom1-width),
                                          int_to_expression(lom1),
                                          incr),
                               NIL));
        }
        else
        {
            content = gen_nconc(content, CONS(RANGE, r, NIL)); /* shared! */
        }                               
    }
 
    return(content);
}
 
list compute_receive_domain(lr, v)
list lr;
Pvecteur v;
{
    list l = lr, domain = NIL;
    int i = 1;
    
    for ( ; l!=NIL ; i++, l=CDR(l))
    {
        range r = RANGE(CAR(l));
        Value vn = vect_coeff((Variable) (intptr_t)i, v);
        int neighbour = VALUE_TO_INT(vn);
 
        if (neighbour==0)
            domain = gen_nconc(domain, CONS(RANGE, r, NIL)); /* shared! */
        else
        {
            int lo = HpfcExpressionToInt(range_lower(r)),
                up = HpfcExpressionToInt(range_upper(r));
 
            domain = 
                gen_nconc(domain, 
                          CONS(RANGE, 
                               make_range(int_to_expression(lo+neighbour),
                                          int_to_expression(up+neighbour),
                                          range_increment(r)), 
                               NIL));
        }           
    }
    
    return(domain);
}
 
bool larger_message_in_list(m, l)
message m;
list l;
{
    MAP(MESSAGE, mp, if (message_larger_p(mp, m)) return true, l);
    return(false);
}
 
/* bool message_larger_p(m1, m2)
 *
 * true if m1>=m2... (caution, it is only a partial order)
 */
bool message_larger_p(m1, m2)
message m1, m2;
{
    if (message_array(m1)!=message_array(m2))
        return(false);
 
    if (value_ne(vect_coeff(TCST, (Pvecteur) message_neighbour(m1)),
                 vect_coeff(TCST, (Pvecteur) message_neighbour(m2))))
        return(false);
 
    /*
     * same array and same destination, let's look at the content and domain...
     */
 
    return(lrange_larger_p(message_content(m1), message_content(m2)) &&
           lrange_larger_p(message_dom(m1), message_dom(m2)));
}
 
bool lrange_larger_p(lr1, lr2)
list lr1, lr2;
{
    list l1 = lr1, l2 = lr2;
 
    assert(gen_length(lr1) == gen_length(lr2));
    
    for ( ; l1; POP(l1), POP(l2))
    {
        range r1 = RANGE(CAR(l1)), r2 = RANGE(CAR(l2));
        int lo1, up1, in1, lo2, up2, in2;
        bool
            blo1 = hpfc_integer_constant_expression_p(range_lower(r1), &lo1),
            bup1 = hpfc_integer_constant_expression_p(range_upper(r1), &up1),
            bin1 = hpfc_integer_constant_expression_p(range_increment(r1), &in1),
            blo2 = hpfc_integer_constant_expression_p(range_lower(r2), &lo2),
            bup2 = hpfc_integer_constant_expression_p(range_upper(r2), &up2),
            bin2 = hpfc_integer_constant_expression_p(range_increment(r2), &in2),
            bcst = (blo1 && bup1 && bin1 && blo2 && bup2 && bin2);
 
        if (!bcst) /* can look for formal equality... */
        {
            return(expression_equal_p(range_lower(r1), range_lower(r2)) &&
                   expression_equal_p(range_upper(r1), range_upper(r2)) &&
                   expression_equal_p(range_increment(r1), range_increment(r2)));
        }
 
        if (in1!=in2) return(false);
        
        /* ??? something more intelligent could be expected */
        if ((in1!=1) && ((lo1!=lo2) || (up1!=up2))) 
            return(false);
 
        if ((in1==1) && ((lo1>lo2) || (up1<up2)))
            return(false);
    }
 
    pips_debug(7, "returning TRUE\n");
 
    return true;
}
 
/****************************************************************** RANGES */
 
list 
array_ranges_to_template_ranges(
    entity array,
    list lra)
{
    align a = load_hpf_alignment(array);
    entity template = align_template(a);
    list la = align_alignment(a), lrt = NIL;
    int i = 1;
    
    for (i=1 ; i<=NumberOfDimension(template) ; i++)
    {
        alignment al = FindAlignmentOfTemplateDim(la, i);
        int arraydim = alignment_undefined_p(al)? -1: alignment_arraydim(al);
 
        if (arraydim==-1) /* scratched */
        {
            dimension d = FindIthDimension(template, i);
            lrt = gen_nconc(lrt,
               CONS(RANGE,
                    make_range(copy_expression(dimension_lower(d)),
                               copy_expression(dimension_upper(d)),
                               int_to_expression(1)), NIL));
        } 
        else if (arraydim==0) /* replication */
        {
            expression b = alignment_constant(al);
 
            lrt = gen_nconc(lrt,
                            CONS(RANGE,
                                 make_range(b, b, int_to_expression(1)),
                                 NIL));
        }
        else
        {
            range rg = RANGE(gen_nth(arraydim-1, lra));
 
            if (expression_undefined_p(range_lower(rg)))
            {
                /* non distributed dimension, so not used...
                 */
                lrt = gen_nconc(lrt, CONS(RANGE, 
                                          make_range(expression_undefined,
                                                     expression_undefined,
                                                     expression_undefined),
                                          NIL));
            }
            else
            {
                int
                    a  = HpfcExpressionToInt(alignment_rate(al)),
                    b  = HpfcExpressionToInt(alignment_constant(al)),
                    lb, ub, in;
                expression tl, tu, ti;
 
                lb = HpfcExpressionToInt(range_lower(rg));
                ub = HpfcExpressionToInt(range_upper(rg));
                in = HpfcExpressionToInt(range_increment(rg));
                tl = int_to_expression(a*lb+b);
                tu = int_to_expression(a*ub+b);
                ti = int_to_expression(a*in);
 
                lrt = gen_nconc(lrt,
                                CONS(RANGE,
                                     make_range(tl, tu, ti),
                                     NIL));
            }
        }
    }
    
    return(lrt);            
}
 
list template_ranges_to_processors_ranges(template, lrt)
entity template;
list lrt;
{
    distribute d = load_hpf_distribution(template);
    entity proc = distribute_processors(d);
    list ld = distribute_distribution(d), lrp = NIL;
    int i = 1;
 
    for (i=1 ; i<=NumberOfDimension(proc) ; i++)
    {
        int tdim = 0;
        distribution di = FindDistributionOfProcessorDim(ld, i, &tdim);
        style s = distribution_style(di);
        range rg = RANGE(gen_nth(tdim-1, lrt));
        int p  = 0,
            tl = HpfcExpressionToInt(range_lower(rg)),
            tu = HpfcExpressionToInt(range_upper(rg)),
            n  = HpfcExpressionToInt(distribution_parameter(di));
 
        switch (style_tag(s))
        {
        case is_style_block:
        {
            expression
              pl = int_to_expression(processor_number(template, tdim, tl, &p)),
              pu = int_to_expression(processor_number(template, tdim, tu, &p));
 
            /* ??? another increment could be computed?
             */
            lrp = gen_nconc(lrp,
                            CONS(RANGE,
                                 make_range(pl, pu, int_to_expression(1)),
                                 NIL));
            break;
        }
        case is_style_cyclic:
        {
            dimension dp = FindIthDimension(proc, i);
            int sz = dimension_size(dp);
            expression
              pl = int_to_expression(processor_number(template, tdim, tl, &p)),
              pu = int_to_expression(processor_number(template, tdim, tu, &p));
 
            if (((tu-tl)>n*sz) || (pl>pu) || ((pl==pu) && ((tu-tl)>n)))
                lrp = gen_nconc(lrp,
                            CONS(RANGE,
                                 make_range(dimension_lower(dp),
                                            dimension_upper(dp),
                                            int_to_expression(1)),
                                 NIL));
            else
                lrp = gen_nconc(lrp,
                                CONS(RANGE,
                                     make_range(pl, pu,
                                                int_to_expression(1)),
                                     NIL));
            
            break;
        }
        case is_style_none:
            pips_internal_error("unexpected none style distribution");
            break;
        default:
            pips_internal_error("unexpected style tag (%d)",
                       style_tag(s));
        }
    }
    return(lrp);
}
 
list array_access_to_array_ranges(r, lkref, lvref)
reference r;
list lkref, lvref;
{
    entity array = reference_variable(r);
    int dim = 1;
    list li  = reference_indices(r), lk  = lkref, lv  = lvref, lra = NIL,
        ldim = variable_dimensions(type_variable(entity_type(array)));
 
    pips_debug(7, "considering array %s\n", entity_name(array));
 
    for (; li; POP(li), POP(lk), POP(lv), POP(ldim), dim++)
    {
        access a = INT(CAR(lk));
        Pvecteur v = (Pvecteur) PVECTOR(CAR(lv));
        normalized n = expression_normalized(EXPRESSION(CAR(li)));
        
        pips_debug(8, "DIM=%d[%d]\n", dim, a);
 
        switch (access_tag(a))
        {
        case local_form_cst:
        {
            /* this dimension shouldn't be used, 
             * so I put there whatever I want...
             * ??? mouais, the information is in the vector, I think.
             */
            lra = gen_nconc(lra,
                            CONS(RANGE,
                                 make_range(expression_undefined,
                                            expression_undefined,
                                            expression_undefined),
                                 NIL));
            
            break;
        }
        case aligned_constant:
        case local_constant:
        {
            Value tc = vect_coeff(TCST, v);
            expression arraycell = Value_to_expression(tc);
 
            lra = gen_nconc(lra,
                            CONS(RANGE,
                                 make_range(arraycell, arraycell,
                                            int_to_expression(1)),
                                 NIL));
            break;
        }
        case aligned_shift:
        case local_shift:
        {
            range
                /* ??? should check that it is ok */
                rg = loop_index_to_range
                    ((entity) var_of(vect_del_var(v, TCST)));
            expression
                rl = range_lower(rg),
                ru = range_upper(rg),
                in = range_increment(rg),
                al = expression_undefined,
                au = expression_undefined;
            Value vdt =  vect_coeff(TCST, (Pvecteur) normalized_linear(n));
            int lb = -1, ub = -1, dt = VALUE_TO_INT(vdt);
 
            if (expression_integer_constant_p(rl))
                lb = HpfcExpressionToInt(rl),
                al = int_to_expression(lb-dt);
            else
                al = copy_expression(dimension_lower(DIMENSION(CAR(ldim))));
 
            if (expression_integer_constant_p(ru))
                ub = HpfcExpressionToInt(ru),
                au = int_to_expression(ub-dt);
            else
                au = copy_expression(dimension_upper(DIMENSION(CAR(ldim))));
 
            lra = gen_nconc(lra, CONS(RANGE, make_range(al, au, in), NIL));
            break;
        }
        case aligned_affine:
        case local_affine:
        {
            Pvecteur v2 = vect_del_var(v, TCST);
            entity index = (entity) var_of(v2);
            range rg = loop_index_to_range(index);
            Value vdt =  vect_coeff(TCST, (Pvecteur) normalized_linear(n));
            int rate = val_of(v2),
                in = HpfcExpressionToInt(range_increment(rg)),
                lb = HpfcExpressionToInt(range_lower(rg)),
                ub = HpfcExpressionToInt(range_upper(rg)),
                dt = VALUE_TO_INT(vdt);
            expression
                ai = int_to_expression(rate*in),
                al = int_to_expression(rate*lb-dt),
                au = int_to_expression(rate*ub-dt);
 
            lra = gen_nconc(lra, CONS(RANGE, make_range(al, au, ai), NIL));
            break;
        }
        default:
            pips_internal_error("unexpected but maybe legal access");
            break;
        }
    }
    
    return(lra);
}
 
/***************************************************************** GUARDS */
 
statement generate_guarded_statement(stat, proc, lr)
statement stat;
entity proc;
list lr;
{
    expression guard;
 
    return((make_guard_expression(proc, lr, &guard))?
           (instruction_to_statement
            (make_instruction(is_instruction_test,
                              make_test(guard,
                                        stat,
                                        make_continue_statement
                                        (entity_empty_label()))))):
           stat);
}
 
/* bool make_guard_expression(proc, lr, pguard)
 *
 * compute the expression for the processors ranges lr guard.
 * return true if not empty, false if empty.
 */
bool make_guard_expression(proc, lrref, pguard)
entity proc;
list lrref;
expression *pguard;
{
    int i, len = -1;
    expression procnum = int_to_expression(load_hpf_number(proc));
    list lr = lrref, conjonction = NIL;
    
    for (i=1 ; i<=NumberOfDimension(proc) ; i++, lr=CDR(lr))
    {
         range rg = RANGE(CAR(lr));
         expression
             rloexpr = range_lower(rg),
             rupexpr = range_upper(rg);
         dimension d = FindIthDimension(proc, i);
         int
             lo  = HpfcExpressionToInt(dimension_lower(d)),
             up  = HpfcExpressionToInt(dimension_upper(d)),
             sz  = up-lo+1,
             rlo = HpfcExpressionToInt(rloexpr),
             rup = HpfcExpressionToInt(rupexpr);
 
         if (rlo>rup) /* empty match case */
         {
             (*pguard) = entity_to_expression(entity_intrinsic(".FALSE."));
             return(true); /* ??? memory leak with the content of conjonction */
         }
 
         if ((rlo==rup) && (sz!=1) && (rlo>=lo) && (rup<=up))
         {
             /* MYPOS(i, procnum).EQ.nn
              */
             conjonction = 
                CONS(EXPRESSION,
                     eq_expression(make_mypos_expression(i, procnum), rloexpr),
                     conjonction);
         }
         else
         {
             if (rlo>lo)
             {
                 /* MYPOS(i, procnum).GE.(rloexpr)
                  */
                 conjonction =
                   CONS(EXPRESSION,
                     ge_expression(make_mypos_expression(i, procnum), rloexpr),
                        conjonction);
             }
 
             if (rup<up)
             {
                 /* MYPOS(i, procnum).LE.(rupexpr)
                  */
                 conjonction =
                   CONS(EXPRESSION,
                     le_expression(make_mypos_expression(i, procnum), rupexpr),
                        conjonction);
             }
         }
     }
    
    /* use of conjonction 
     */
 
    len = gen_length(conjonction);
 
    if (len==0) /* no guard */
    {
        (*pguard) = expression_undefined;
        return(false);
    }
    else
    {
        (*pguard) = expression_list_to_conjonction(conjonction);
        gen_free_list(conjonction);
        return(true);
    }
}
 
expression make_mypos_expression(i, exp)
int i;
expression exp;
{
    return(reference_to_expression
           (make_reference(hpfc_name_to_entity(MYPOS),
                           CONS(EXPRESSION, int_to_expression(i),
                           CONS(EXPRESSION, exp,
                                NIL)))));
}
 
statement loop_nest_guard(stat, r, lkref, lvref)
statement stat;
reference r;
list lkref, lvref;
{
    entity
        array    = reference_variable(r),
        template = array_to_template(array),
        proc     = template_to_processors(template);
    list
        lra = array_access_to_array_ranges(r, lkref, lvref),
        lrt = array_ranges_to_template_ranges(array, lra),
        lrp = template_ranges_to_processors_ranges(template, lrt);
    statement
        result = generate_guarded_statement(stat, proc, lrp);
 
    gen_free_list(lra); /* ??? memory leak of some expressions */
    gen_free_list(lrt);
    gen_free_list(lrp);
 
    return(result);
}
 
/*   That is all
 */