generate-util.c

Go to the documentation of this file.

/*
 
  $Id: generate-util.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
/* HPFC module by Fabien COELHO
 */
 
#include "defines-local.h"
 
static expression 
pvm_encoding_option(int n)
{
    static const string option[] = 
    {
        "PvmDataDefault",
        "PvmDataRaw",
        "PvmDataInPlace"
    };
 
    return MakeCharacterConstantExpression(option[n]);
}
 
/* builds a statement
 *   VAR_i = MYPOS(i, proc_number) // i=1 to proc dimension
 */
statement 
define_node_processor_id(
    entity proc,
    entity (*creation)(int))
{
    int i, procn = load_hpf_number(proc);
    list /* of expression */ mypos_indices,
         /* of statement */  ls = NIL;
    reference mypos;
    entity dummy;
 
    for(i=NumberOfDimension(proc); i>0; i--)
    {
        dummy = creation(i);
        mypos_indices = CONS(EXPRESSION, int_to_expression(i),
                        CONS(EXPRESSION, int_to_expression(procn), 
                             NIL));
        mypos = make_reference(hpfc_name_to_entity(MYPOS), mypos_indices);
        ls = CONS(STATEMENT,
                  make_assign_statement(entity_to_expression(dummy),
                                        reference_to_expression(mypos)),
                  ls);
    }
                                       
    return make_block_statement(ls);
}
 
/* statement generate_deducables(list le)
 *
 * the le list of expression is used to generate the deducables.
 * The fields of interest are the variable which is referenced and 
 * the normalized field which is the expression that is going to
 * be used to define the variable.
 */
statement 
generate_deducables(
    list /* of expression */ le)
{
    list rev = gen_nreverse(gen_copy_seq(le)), ls = NIL;
 
    MAP(EXPRESSION, e,
    {
        entity var = reference_variable(expression_reference(e));
        Pvecteur v = normalized_linear(expression_normalized(e));
 
        ls = CONS(STATEMENT, Pvecteur_to_assign_statement(var, v), ls);
    },
        rev);
 
    gen_free_list(rev);
    return make_block_statement(ls);
}
 
list /* of expression */
hpfc_gen_n_vars_expr(
    entity (*creation)(),
    int number)
{
    list result = NIL;
    pips_assert("valid dimension number", number>=0 && number<=7);
 
    for(; number>0; number--)
        result = CONS(EXPRESSION, entity_to_expression(creation(number)),
                      result);
 
    return result;
}
 
expression 
make_reference_expression(
    entity e,
    entity (*creation)())
{
    return reference_to_expression(make_reference(e,
           hpfc_gen_n_vars_expr(creation, NumberOfDimension(e))));
}
 
/* returns statement VAR = VAR + N
 */
statement 
hpfc_add_n(
    entity var, /* integer scalar variable */
    int n)      /* added value */
{
    return make_assign_statement
        (entity_to_expression(var),
         MakeBinaryCall(entity_intrinsic(PLUS_OPERATOR_NAME),
                        entity_to_expression(var), int_to_expression(n)));
}
 
/* expr = expr + 2
 */
statement 
hpfc_add_2(
    expression exp)
{
    entity plus = entity_intrinsic(PLUS_OPERATOR_NAME);
    return(make_assign_statement
           (copy_expression(exp), 
            MakeBinaryCall(plus, exp, int_to_expression(2))));
 
}
 
statement 
hpfc_message(
    expression tid,
    expression channel,
    bool send)
{
    expression third;
    entity pvmf;
 
    third = entity_to_expression(hpfc_name_to_entity(send ? INFO : BUFID));
    pvmf = hpfc_name_to_entity(send ? PVM_SEND : PVM_RECV);
 
    return make_block_statement
           (CONS(STATEMENT, hpfc_make_call_statement(pvmf,
                                   CONS(EXPRESSION, tid,
                                   CONS(EXPRESSION, channel,
                                   CONS(EXPRESSION, third,
                                        NIL)))),
            CONS(STATEMENT, hpfc_add_2(copy_expression(channel)),
                 NIL)));
}
 
/* returns if (LAZY_{SEND,RECV}) then
 */
statement 
hpfc_lazy_guard(
    bool snd, 
    statement then)
{
    entity decision = hpfc_name_to_entity(snd ? LAZY_SEND : LAZY_RECV);
    return test_to_statement
     (make_test(entity_to_expression(decision), then, make_empty_statement()));
}
 
/* IF (LAZY_snd) THEN 
 *   PVMFsnd()
 *   LAZY_snd = false // if receive
 * ENDIF
 */
static statement 
hpfc_lazy_message(
    expression tid, 
    expression channel, 
    bool snd)
{
    entity decision = hpfc_name_to_entity(snd ? LAZY_SEND : LAZY_RECV);
    statement 
        comm = hpfc_message(tid, channel, snd),
        then = snd ? comm : 
            make_block_statement(CONS(STATEMENT, comm,
                                 CONS(STATEMENT, set_logical(decision, false),
                                      NIL))) ;
    
    return hpfc_lazy_guard(snd, then);
}
 
statement 
hpfc_generate_message(
    entity ld, 
    bool send, 
    bool lazy)
{
    entity nc, nt;
    expression lid, tid, chn;
 
    nc = hpfc_name_to_entity(send ? SEND_CHANNELS : RECV_CHANNELS);
    nt = hpfc_name_to_entity(NODETIDS);
    lid = entity_to_expression(ld);
    tid = reference_to_expression
        (make_reference(nt, CONS(EXPRESSION, lid, NIL)));
    chn = reference_to_expression
        (make_reference(nc, CONS(EXPRESSION, copy_expression(lid), NIL)));
 
    return lazy ? hpfc_lazy_message(tid, chn, send) : 
                  hpfc_message(tid, chn, send);
}
 
statement 
hpfc_initsend(
    bool lazy)
{
    statement init;
 
    /* 2 args to pvmfinitsend
     */
    init = hpfc_make_call_statement
             (hpfc_name_to_entity(PVM_INITSEND), 
              CONS(EXPRESSION, pvm_encoding_option(1),
              CONS(EXPRESSION, entity_to_expression(hpfc_name_to_entity(BUFID)),
                   NIL)));
 
    return lazy ? make_block_statement
        (CONS(STATEMENT, init,
         CONS(STATEMENT, set_logical(hpfc_name_to_entity(LAZY_SEND), false),
              NIL))) :
                  init ;
}
 
/****************************************************************** PACKING */
 
/* returns the buffer entity for array
 */
static entity 
hpfc_buffer_entity(
    entity array,
    string suffix)
{
    return hpfc_name_to_entity(concatenate
                               (pvm_what_options(entity_basic(array)),
                                suffix, NULL));
}
 
/* returns a reference to the typed common hpfc_buffer buffer,
 * that suits array basic type and with index as an index.
 */
expression
hpfc_buffer_reference(
    entity array, /* array to select the right typed buffer */
    entity index) /* index variable */
{
    return reference_to_expression
        (make_reference(hpfc_buffer_entity(array, BUFFER),
         CONS(EXPRESSION, entity_to_expression(index), 
              NIL)));
}
 
/* generates the condition for testing the buffer state:
 * returns (BUFFER_INDEX.[eq|ne].BUFFER_[|RCV]SIZE) depending on swtiches.
 */
static expression 
buffer_full_condition(
    entity array, /* array for the typed buffer size */
    bool is_send, /* while sending or receiving */
    bool is_full) /* TRUE: is full, FALSE: is not empty */
{
    entity opera, bsize, index;
 
    index = hpfc_name_to_entity(BUFFER_INDEX);
    opera = is_full ? 
        entity_intrinsic(EQUAL_OPERATOR_NAME) :
        entity_intrinsic(NON_EQUAL_OPERATOR_NAME) ;
    bsize = is_send ? is_full ?
        hpfc_buffer_entity(array, BUFSZ) :
        MakeConstant("0", is_basic_int) :
        hpfc_name_to_entity(BUFFER_RCV_SIZE);
 
    return MakeBinaryCall(opera,
                          entity_to_expression(index),
                          entity_to_expression(bsize));
}
 
/* array(creation) = buffer(current++) or reverse assignment...
 */
statement 
hpfc_buffer_packing(
    entity array,
    entity (*creation)(), 
    bool pack)
{
    entity index;
    expression array_ref, buffer_ref;
    statement increment, assignment;
 
    index = hpfc_name_to_entity(BUFFER_INDEX);
    array_ref = make_reference_expression(array, creation);
    buffer_ref = hpfc_buffer_reference(array, index);
    increment = hpfc_add_n(index, 1);
    assignment = make_assign_statement(pack ? buffer_ref : array_ref,
                                       pack ? array_ref : buffer_ref);
    
    return make_block_statement(CONS(STATEMENT, increment,
                                CONS(STATEMENT, assignment,
                                     NIL)));
}
 
static entity
hpfc_ith_broadcast_function(
    int dim,      /* number of dimensions of the broadcast */
    bool special) /* whether to use the special version */
{
    char *buffer; /* ??? static buffer size */
    asprintf(&buffer, "%s%d", special? GUARDED_BRD: BROADCAST, dim);
    entity e= MakeRunTimeSupportSubroutine(buffer, 2*dim+1);
    free(buffer);
    return e;
}
 
/* send the buffer, possibly a broadcast.
 * unconditional ? if non empty ?
 * generates hpfc_broadcast_x as required.
 * ??? hardwired for remappings... 
 */
static statement 
hpfc_broadcast_buffers(
    entity src,   /* source array */
    entity trg,   /* should be the target array */
    entity lid,   /* broadcast base, maybe partial?! */
    entity proc)  /* processor related to the array... (redundant!?) */
{
    Pcontrainte c;
    int size, npdim, nreplicated;
    list /* of expression */ args = NIL;
    bool avoid_twins = 
        get_bool_property("HPFC_GUARDED_TWINS") && replicated_p(src);
 
    c = full_linearization(proc, (entity) NULL, &size, 
                           get_ith_temporary_dummy, false, 0);
 
    npdim = NumberOfDimension(proc);
    
    for (nreplicated=0; npdim; npdim--)
    {
        if (processors_dim_replicated_p(proc, trg, npdim))
        {
            /* ??? possible replication on sections overlooked here */
            entity v;
            Value step;
            int number;
            
            nreplicated++;
            v = get_ith_temporary_dummy(npdim);
            step = vect_coeff((Variable) v, contrainte_vecteur(c));
            number = SizeOfIthDimension(proc, npdim);
 
            args = CONS(EXPRESSION, int_to_expression(number),
                   CONS(EXPRESSION, Value_to_expression(step),
                        args));
        }
    }
 
    args = CONS(EXPRESSION, entity_to_expression(lid), args);
 
    /* an argument needed by the special function */
    if (avoid_twins) 
        args = CONS(EXPRESSION, int_to_expression(load_hpf_number(src)), args);
    contraintes_free(c);
 
    return call_to_statement
      (make_call(hpfc_ith_broadcast_function(nreplicated, avoid_twins), args));
}
 
/* CALL (pvmtype) HPFC {,UN}PACK
 */
statement 
hpfc_packing_of_current__buffer(
    entity array,
    bool pack)
{
    return hpfc_make_call_statement
        (hpfc_buffer_entity(array, pack? BUFPCK: BUFUPK), NIL);
}
 
statement 
hpfc_broadcast_if_necessary(
    entity array, /* remapped source array */
    entity trg,   /* remapped target array */
    entity lid,   /* lid for target processor(s) */
    entity proc,  /* target processor */
    bool is_lazy) /* lazy or not... */
{
    expression not_empty;
    statement send, pack;
 
    not_empty = buffer_full_condition(array, true, false);
    send = hpfc_broadcast_buffers(array, trg, lid, proc);
    pack = hpfc_packing_of_current__buffer(array, true);
 
    if (is_lazy)
        return test_to_statement
            (make_test(not_empty,
             make_block_statement(CONS(STATEMENT, pack,
                                  CONS(STATEMENT, send, NIL))),
             make_continue_statement(entity_undefined)));
    else
        return make_block_statement
            (CONS(STATEMENT, test_to_statement(make_test(not_empty, pack,
                             make_continue_statement(entity_undefined))),
             CONS(STATEMENT, test_to_statement(make_test(not_expression
                (entity_to_expression(hpfc_name_to_entity(SND_NOT_INIT))),send,
                             make_continue_statement(entity_undefined))),
                  NIL)));
}
 
/* lazy in actually sending or not the packed buffer immediatly...
 */
statement 
hpfc_lazy_buffer_packing(
    entity src,   /* source array */
    entity trg,   /* target array */
    entity lid,   /* local id for base target */
    entity proc,  /* the processors, needed for broadcasts */
    entity (*array_dim)(), /* variables for array dimensions */
    bool is_send, /* send or receive ? */
    bool is_lazy) /* means you send the buffer directly, without packing... */
{
    statement packing, realpack, indexeq0, ifcond, optional;
    expression condition;
    list /* of statement */ l;
    entity array; /* array being manipulated */
 
    array = is_send ? src : trg;
    packing = hpfc_buffer_packing(array, array_dim, is_send);
    condition = buffer_full_condition(array, is_send, true);
 
    /* CALL HPFC PACK/UNPACK
     */
    realpack = call_to_statement
        (make_call(hpfc_buffer_entity(array, is_send ? BUFPCK : BUFUPK), 
           is_send ? NIL : CONS(EXPRESSION, entity_to_expression(lid), NIL)));
 
    /* BUF INDEX=0
     */
    indexeq0 = set_integer(hpfc_name_to_entity(BUFFER_INDEX), 0);
    optional = is_lazy ? 
        is_send ? hpfc_broadcast_buffers(array, trg, lid, proc) :
                  set_logical(hpfc_name_to_entity(RCV_NOT_PRF), true) :
        make_continue_statement(entity_undefined);
                           
    if (is_send)
        l = CONS(STATEMENT, realpack,
            CONS(STATEMENT, optional,
            CONS(STATEMENT, indexeq0,
                 is_lazy? 
                 CONS(STATEMENT, set_logical(hpfc_name_to_entity(SND_NOT_INIT),
                                             true), NIL): NIL)));
    else
        l = CONS(STATEMENT, optional,
            CONS(STATEMENT, realpack,
            CONS(STATEMENT, indexeq0, NIL)));
    
    ifcond = test_to_statement
        (make_test(condition, 
                   make_block_statement(l),
                   make_continue_statement(entity_undefined)));
 
    return make_block_statement
        (is_send ? CONS(STATEMENT, packing, CONS(STATEMENT, ifcond, NIL)) :
                   CONS(STATEMENT, ifcond, CONS(STATEMENT, packing, NIL)));
}
 
statement
hpfc_buffer_initialization(
    bool is_send,
    _UNUSED_ bool is_lazy,
    bool job_was_done)
{
    statement buffindex, msgstate, other;
    list /* of statement */ l;
 
    buffindex = set_integer(hpfc_name_to_entity(BUFFER_INDEX), 0);
    msgstate = set_logical(hpfc_name_to_entity
        (is_send ? SND_NOT_INIT : RCV_NOT_PRF), job_was_done);
    if (is_send)
        other = make_continue_statement(entity_undefined);
    /* set_expression(hpfc_name_to_entity(BUFFER_ENCODING),
       pvm_encoding_option(2)) */
    else
        other = set_expression
            (hpfc_name_to_entity(BUFFER_RCV_SIZE), int_to_expression(0)); 
 
    l = CONS(STATEMENT, buffindex,
        CONS(STATEMENT, msgstate, 
        CONS(STATEMENT, other,
             NIL)));
 
    return make_block_statement(l);
}
 
/* the lazy issues.
 * note that target processors should be known 
 * to generate the appropriate broadcast?
 */
statement 
hpfc_lazy_packing(
    entity array,
    entity lid, 
    entity (*creation)(),
    bool pack,
    bool lazy)
{
    statement pack_stmt = hpfc_buffer_packing(array, creation, pack);
 
    return lazy ? (pack ? make_block_statement
       (CONS(STATEMENT, pack_stmt,
        CONS(STATEMENT, set_logical(hpfc_name_to_entity(LAZY_SEND), true),
             NIL))) :
                   make_block_statement
       (CONS(STATEMENT, hpfc_generate_message(lid, false, true),
        CONS(STATEMENT, pack_stmt,
             NIL)))) : pack_stmt ;
}
 
 
/* statement st_compute_lid(proc)
 *
 *       T_LID=CMP_LID(pn, pi...)
 *
 * if array is not NULL, partial according to array.
 * the offset is shifted as if proc dimensions were normalized,
 * in order to match the runtime library hpfc_broadcast_* expectations.
 */
statement 
hpfc_compute_lid(
    entity lid,               /* variable to be assigned to */
    entity proc,              /* processor arrangement */
    entity (*creation)(),  /* individual variables */
    entity array)             /* to be used for partial (broadcasts...) */
{
    if (!get_bool_property("HPFC_EXPAND_CMPLID"))
    {
        int ndim = NumberOfDimension(proc);
        entity cmp_lid = hpfc_name_to_entity(CMP_LID);
 
        pips_assert("implemented", !array);
        
        return make_assign_statement(entity_to_expression(lid),
          make_call_expression
            (cmp_lid, CONS(EXPRESSION,int_to_expression(load_hpf_number(proc)),
                           gen_nconc(hpfc_gen_n_vars_expr(creation, ndim),
                                     make_list_of_constant(0, 7-ndim)))));
    }
    else
    {
        int size;
        Pcontrainte c;
        Pvecteur v;
        statement result;
 
        c = full_linearization(proc, lid, &size, creation, false, 1);
        v = contrainte_vecteur(c);
 
        if (array)
        {
            /* remove distributed dimensions from the constraint
             * and normalize the partial system so that dims are 0:...
             */
            int npdim;
            pips_assert("defined", array && !entity_undefined_p(array));
            
            for(npdim = NumberOfDimension(proc); npdim; npdim--)
                if (processors_dim_replicated_p(proc, array, npdim))
                {
                    Variable var = (Variable) creation(npdim);
                    int low, up;
                    Value cf, vlow;
 
                    get_entity_dimensions(proc, npdim, &low, &up);
                    cf = vect_coeff(var, v);
                    vlow = int_to_value(low);
                    vect_add_elem(&contrainte_vecteur(c), var, 
                                  value_uminus(cf));
                    vect_add_elem(&contrainte_vecteur(c), TCST, 
                                  value_mult(cf,vlow));
                }
        }
 
        result = Pvecteur_to_assign_statement(lid, contrainte_vecteur(c));
        contraintes_free(c);
        
        return result;
    }
}
 
/* that is all
 */