run-time.c

Go to the documentation of this file.

/*
 
  $Id: run-time.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
/* Runtime Support Functions Management
 *
 * Fabien Coelho, May and June 1993
 */
 
#include "defines-local.h"
 
#include "effects-generic.h"
#include "effects-simple.h"
#include "effects-convex.h"
 
/* entity MakeRunTimeSupportSubroutine(local_name, number_of_arguments)
 *
 * modify 27/09/93, in order not to attempt to redeclare an already declared
 * subroutine. 
 */
entity 
MakeRunTimeSupportSubroutine(
    string local_name,
    _UNUSED_ int number_of_arguments)
{
    entity res = module_name_to_entity(local_name);
    if (entity_undefined_p(res))
        res = make_empty_subroutine(local_name,make_language_fortran());
    return res;
}
 
/* entity MakeRunTimeSupportFunction
 *   (local_name, number_of_arguments, return_type)
 *
 * this function can be used even if the function is already declared
 * ??? an integer shouldn't always be returned
 */
entity 
MakeRunTimeSupportFunction(
    string local_name,
    _UNUSED_ int number_of_arguments,
    tag return_type)
{
    entity f = make_empty_function(local_name,
                                   (return_type==is_basic_int ? /* ??? rough */
                                    MakeIntegerResult() :
                                    MakeOverloadedResult()),make_language_fortran());
    return f;
}
 
expression 
pvm_what_option_expression(entity v)
{
    pips_assert("variable", entity_variable_p(v));
 
    return(MakeCharacterConstantExpression
               (strdup(pvm_what_options(entity_basic(v)))));
}
 
/* string pvm_what_options(b)
 *
 * the pvm what option is given back as a string, fellowing the basic given.
 */
string pvm_what_options(b)
basic b;
{
    switch (basic_tag(b))
    {
    case is_basic_int:
        switch (basic_int(b))
        {
        case 2: return(PVM_INTEGER2);
        case 4: return(PVM_INTEGER4);
        default:
            pips_internal_error("unexpected integer*%d", basic_int(b));
        }
    case is_basic_float:
        switch (basic_float(b))
        {
        case 4: return(PVM_REAL4);
        case 8: return(PVM_REAL8);
        default:
            pips_internal_error("unexpected real*%d", basic_float(b));
        }
    case is_basic_logical:
        switch (basic_logical(b))
        {
        case 2: return(PVM_INTEGER2);
        case 4: return(PVM_INTEGER4);
        default:
            pips_internal_error("unexpected logical*%d", basic_logical(b));
        }
    case is_basic_overloaded:
        pips_internal_error("overloaded not welcomed");
    case is_basic_complex:
        switch (basic_complex(b))
        {
        case  8: return(PVM_COMPLEX8);
        case 16: return(PVM_COMPLEX16);
        default:
            pips_internal_error("unexpected complex*%d", basic_complex(b));
        }
    case is_basic_string:
        return(PVM_STRING);
    default:
        pips_internal_error("unexpected basic tag");
    }
    return("ERROR");
}
 
 
/****************************************************** STATEMENTS GENERATION */
 
/* Sends
 */
statement st_call_send_or_receive(f, r)
entity f;
reference r;
{
    return
         hpfc_make_call_statement(f,
           CONS(EXPRESSION, pvm_what_option_expression(reference_variable(r)),
           CONS(EXPRESSION, reference_to_expression(r),
                NIL)));
}
 
/* Computes
 */
statement st_compute_current_computer(ref)
reference ref;
{
    if (get_bool_property("HPFC_EXPAND_COMPUTE_COMPUTER"))
    {
        list linds = reference_indices(ref),
             largs = make_list_of_constant(0, 7-gen_length(linds));
        int narray = load_hpf_number(reference_variable(ref));
        
        largs = gen_nconc(CONS(EXPRESSION, int_to_expression(narray), 
                               NIL),
                          gen_nconc(lUpdateExpr(node_module, linds), largs));
        
        return hpfc_make_call_statement(hpfc_name_to_entity(CMP_COMPUTER), 
                                      largs);
    }
    else
        return hpfc_make_call_statement(hpfc_name_to_entity(CMP_COMPUTER),
                     CONS(EXPRESSION, reference_to_expression(ref),
                          NIL));
}
 
statement st_compute_current_owners(ref)
reference ref;
{
    if (get_bool_property("HPFC_EXPAND_COMPUTE_OWNER"))
    {
        list linds = reference_indices(ref),
             largs = make_list_of_constant(0, 7-gen_length(linds));
        int narray = load_hpf_number(reference_variable(ref));
        
        largs = gen_nconc(CONS(EXPRESSION, int_to_expression(narray), NIL),
                          gen_nconc(lUpdateExpr(node_module,  linds), largs));
        
        return hpfc_make_call_statement(hpfc_name_to_entity(CMP_OWNERS), 
                                      largs);
    }
    else
        return hpfc_make_call_statement(hpfc_name_to_entity(CMP_OWNERS),
                     CONS(EXPRESSION, reference_to_expression(ref),
                          NIL));
}
 
/* new index computation formula, derived from the new declarations
 * made for the given dimension.
 */
expression 
expr_compute_local_index(
    entity array,
    int dim,
    expression expr)
{
    if (get_bool_property("HPFC_EXPAND_COMPUTE_LOCAL_INDEX"))
    {
        tag newdecl = new_declaration_tag(array, dim);
        dimension the_dim = entity_ith_dimension(array, dim);
        
        switch(newdecl)
        {
        case is_hpf_newdecl_none:
            return(expr);
        case is_hpf_newdecl_alpha:
        {
            int dl = HpfcExpressionToInt(dimension_lower(the_dim));
            expression shift = int_to_expression(1 - dl);
            
            return(MakeBinaryCall(entity_intrinsic(PLUS_OPERATOR_NAME), 
                                  expr, shift));
        }
        case is_hpf_newdecl_beta:
        {
            align a = load_hpf_alignment(array);
            entity template = align_template(a);
            distribute d = load_hpf_distribution(template);
            alignment al = FindAlignmentOfDim(align_alignment(a), dim);
            int tempdim = alignment_templatedim(al), procdim;
            dimension template_dim = FindIthDimension(template,tempdim);
            distribution
                di = FindDistributionOfDim(distribute_distribution(d), 
                                           tempdim, 
                                           &procdim);
            expression
                parameter = distribution_parameter(di),
                rate = alignment_rate(al),
                prod, t1, the_mod, t2;
            int
                iabsrate = abs(HpfcExpressionToInt(rate)),
                ishift = (HpfcExpressionToInt(alignment_constant(al)) - 
                          HpfcExpressionToInt(dimension_lower(template_dim)));
            
            
            prod = 
                ((HpfcExpressionToInt(rate)==1)?
                 (expr):
                 ((iabsrate==1)?
                  (MakeUnaryCall(entity_intrinsic(UNARY_MINUS_OPERATOR_NAME),
                                 expr)):
                  (MakeBinaryCall(entity_intrinsic(MULTIPLY_OPERATOR_NAME),
                                  rate,
                                  expr))));
            
            t1 = ((ishift==0)?
                  (prod):
                  ((ishift>0)?
                   (MakeBinaryCall(entity_intrinsic(PLUS_OPERATOR_NAME),prod,
                                   int_to_expression(ishift))):
                   (MakeBinaryCall(entity_intrinsic(MINUS_OPERATOR_NAME),prod,
                                   int_to_expression(abs(ishift))))));
            
            the_mod = MakeBinaryCall(entity_intrinsic(MOD_INTRINSIC_NAME),
                                     t1,
                                     parameter);
            
            t2 = ((iabsrate==1)?
                  (the_mod):
                  MakeBinaryCall(entity_intrinsic(DIVIDE_OPERATOR_NAME),
                                 the_mod,
                                 int_to_expression(iabsrate)));
            
            return(MakeBinaryCall(entity_intrinsic(PLUS_OPERATOR_NAME), 
                              t2,
                                  int_to_expression(1)));
        }
        case is_hpf_newdecl_gamma:
        {
            expression
                expr1 = 
                    int_to_expression(load_hpf_number(array)),
                    expr2 = int_to_expression(dim);
            
            return(MakeTernaryCall(hpfc_name_to_entity(LOCAL_IND_GAMMA), 
                                       expr1, expr2, expr));
        }
        case is_hpf_newdecl_delta:
        {
            expression
                expr1 = int_to_expression(load_hpf_number(array)),
                expr2 = int_to_expression(dim);
            
            return(MakeTernaryCall(hpfc_name_to_entity(LOCAL_IND_DELTA), 
                                       expr1, expr2, expr));
        }
        default:
            pips_internal_error("unexpected new declaration tag");
        }
        
    }
    else
    {
        expression
            expr1 = int_to_expression(load_hpf_number(array)),
            expr2 = int_to_expression(dim);
        
        return(MakeTernaryCall(hpfc_name_to_entity(LOCAL_IND), 
                                   expr1, expr2, expr));
    }
 
    return(expression_undefined); /* just to avoid a gcc warning */
}
 
/*****************************************************************************/
 
/* statement hpfc_make_call_statement(e, l) 
 * generate a call statement to function e, with expression list l 
 * as an argument. 
 */
statement 
hpfc_make_call_statement(entity e, list l)
{
    pips_assert("defined", !entity_undefined_p(e));
    return instruction_to_statement(make_instruction(is_instruction_call,
                                               make_call(e, l)));
}
 
/************************************************************** SUBSTITUTION */
 
static entity 
    sub_call_o = entity_undefined, 
    sub_call_n = entity_undefined,
    sub_ret_label = entity_undefined;
 
static void rwt(call c)
{
    if (call_function(c)==sub_call_o) 
        call_function(c) = sub_call_n;
}
static void srwt(statement s)
{
    if (entity_return_label_p(statement_label(s))) {
        sub_ret_label = statement_label(s);
        statement_label(s) = entity_empty_label();
    }
}
static void 
substitute_return(entity o, entity n, statement s)
{
    sub_call_o = o;
    sub_call_n = n;
 
    gen_multi_recurse(s,
                      statement_domain, gen_true, srwt,
                      call_domain, gen_true, rwt,
                      expression_domain, gen_false, gen_null,
                      NULL);
 
    sub_call_n = entity_undefined;
    sub_call_o = entity_undefined;
}
 
/* this is for the main.
 * also subs CALL RETURN -> CALL HPFC {HOST|NONE} END...
 */
void 
add_pvm_init_and_end(statement *phs, statement *pns)
{
    entity
        rete = entity_intrinsic("RETURN"),
        hhe = hpfc_name_to_entity(HOST_END),
        hne = hpfc_name_to_entity(NODE_END);
    statement ret = hpfc_make_call_statement(rete, NIL);
 
    substitute_return(rete, hhe, *phs);
    substitute_return(rete, hne, *pns);
 
 
    if (sub_ret_label!=entity_undefined) {
        statement_label(ret) = sub_ret_label;
        sub_ret_label = entity_undefined;
    }
 
    (*phs) = make_block_statement(CONS(STATEMENT, st_init_host(),
                                  CONS(STATEMENT, (*phs),
                                  CONS(STATEMENT, ret,
                                       NIL))));
 
    (*pns) = make_block_statement(CONS(STATEMENT, st_init_node(),
                                  CONS(STATEMENT, (*pns),
                                  CONS(STATEMENT, copy_statement(ret),
                                       NIL))));
}
 
/* call to the runtime support function HPFC_CMPNEIGHBOUR(d)
 */
statement st_compute_neighbour(int d)
{
    return hpfc_make_call_statement(hpfc_name_to_entity(CMP_NEIGHBOUR), 
                                  CONS(EXPRESSION, int_to_expression(d),
                                       NIL));
}
 
/* find or create an entity for the packing function...
 */
static entity make_packing_function(ndim, kind, base, nargs)
int ndim;
bool kind;
basic base;
int nargs;
{
    char buffer[100], *buf = buffer;
    sprintf(buf, "%s %s %d", 
            pvm_what_options(base), (kind ? "PACK" : "UNPACK"), ndim);
    buf += strlen(buf);
 
    return MakeRunTimeSupportSubroutine(buffer, nargs);
}
 
/* statement st_generate_packing_and_passing(array, content, bsend)
 *
 * dimension bounds are refered to as parameters, since we do not
 * know yet what is the lower and upper of each dimension...
 */
statement st_generate_packing(array, content, bsend)
entity array;
list content;
bool bsend;
{
    int len = gen_length(content);
    list larg = NIL;
 
    pips_assert("valid number of dimensions",
                len==NumberOfDimension(array) && (len<=4) && (len>=1));
 
    larg = array_lower_upper_bounds_list(array);
 
    MAP(RANGE, r,
     {
         larg = gen_nconc(larg,
                          CONS(EXPRESSION, range_lower(r),
                          CONS(EXPRESSION, range_upper(r),
                          CONS(EXPRESSION, range_increment(r),
                               NIL))));
     },
         content);
 
    larg = CONS(EXPRESSION, entity_to_expression(array),
                larg);
    
    /* larg content:
     *
     * array, dim [lower, upper]*len, range [lower, upper, increment]*len
     */
 
    return hpfc_make_call_statement
           (make_packing_function(len, bsend, entity_basic(array), 1+5*len),
            larg);
 
}
 
/* returns the entity to which e is attached,
 * that is first a common, then a function...
 */
entity hpfc_main_entity(entity e)
{
    storage s = entity_storage(e);
    bool in_common = entity_in_common_p(e),
         in_ram = storage_ram_p(s);
    ram r = (in_ram ? storage_ram(s) : ram_undefined);
 
    pips_assert("not in rom", !storage_rom_p(s));
 
    return(in_ram ?
           (in_common ? ram_section(r) : ram_function(r)):
           (storage_formal_p(s) ? formal_function(storage_formal(s)) :
            (storage_return_p(s) ? storage_return(s) : entity_undefined)));
}
 
/* returns the name of the entity e belongs too (common, function...)
 */
const char* hpfc_main_entity_name(entity e)
{
    return(module_local_name(hpfc_main_entity(e)));
}
 
/* returns a name for the bound of the declaration 
 * of array array, side side and dimension dim.
 */
string 
bound_parameter_name(
    entity array,
    string side,
    int dim)
{
    return strdup(concatenate(hpfc_main_entity_name(array), " ",
                              entity_local_name(array), " ",
                              side, int2a(dim), NULL));
}
 
entity 
argument_bound_entity(
    entity module,
    entity array,
    bool upper,
    int dim)
{
    entity result;
    string name = bound_parameter_name(array, upper? UPPER: LOWER, dim);
 
    result = find_or_create_typed_entity(name, module_local_name(module), 
                                         is_basic_int);
 
    free(name);
    return result;
}
 
expression 
hpfc_array_bound(entity array, bool upper, int dim)
{
    /*
    return entity_to_expression
        (argument_bound_entity(node_module, array, upper, dim)); 
        */
    return MakeCharacterConstantExpression(bound_parameter_name(array, 
                         upper?UPPER:LOWER, dim));
}
 
static list /* of expressions */
array_bounds_list(entity array, bool upper)
{
    int i = -1, ndim = NumberOfDimension(array);
    list result = NIL;
 
    for (i=ndim ; i>=1 ; i--)
        result = CONS(EXPRESSION, hpfc_array_bound(array, upper, i), result);
 
    return result;
}
 
list /* of expressions */
array_lower_upper_bounds_list(entity array)
{
    list /* of expression */ lb = array_bounds_list(array, false),
                             lu = array_bounds_list(array, true),
                             l = lb, lnb, lnu;
 
    if (!l) return NIL;
    
    /* interleave both lists (just for fun:-)
     */
    for(lnb=CDR(lb), lnu=CDR(lu); lb; 
        CDR(lb)=lu, CDR(lu)=lnb, 
        lb=lnb, lnb=lnb?CDR(lnb):NIL, lu=lnu, lnu=lnu?CDR(lnu):NIL);
 
    return l;
}
 
/************************************************* HPFC ENTITIES MANAGEMENT */
 
/* this file stores the table that describes run time functions and
 * variables that may be called or referenced by the generated code.
 * the information needed (name, arity, type...) is stored in a static
 * table here. The table is scanned to create the corresponding entities
 * for once. Then the entities are quickly returned on demand thru the
 * hpfc_name_to_entity function. It was inspired to me by some static
 * table here around in PIPS, that deal with intrinsics for instance.
 */
 
/*  local defines
 */
 
#define is_end 0
#define is_sub 1
#define is_fun 2
#define is_var 3
#define is_int 4
#define is_ifn 5 /* intrinsic like function */
#define is_iof 6 /* I/O like function */
 
#define no_basic        is_basic_overloaded
#define no_entity       entity_undefined
 
typedef struct 
{
    char    name[30];
    int     arity;
    int     what; /* function or subroutine or variable or ...*/
    tag     basic;/* basic tag if necessary */
    entity  object;
} RunTimeSupportDescriptor;
 
static bool RTSTable_initialized_p = false;
 
static RunTimeSupportDescriptor RTSTable[] =
{
    { SND_TO_C,         2, is_sub, no_basic, no_entity },
    { SND_TO_H,         2, is_sub, no_basic, no_entity },
    { SND_TO_A,         2, is_sub, no_basic, no_entity },
    { SND_TO_A_BY_H,    2, is_sub, no_basic, no_entity },
    { SND_TO_O,         2, is_sub, no_basic, no_entity },
    { SND_TO_OS,        2, is_sub, no_basic, no_entity },
    { SND_TO_OOS,       2, is_sub, no_basic, no_entity },
    { SND_TO_HA,        2, is_sub, no_basic, no_entity },
    { SND_TO_NO,        2, is_sub, no_basic, no_entity },
    { SND_TO_HNO,       2, is_sub, no_basic, no_entity },
    { RCV_FR_S,         2, is_sub, no_basic, no_entity },
    { RCV_FR_H,         2, is_sub, no_basic, no_entity },
    { RCV_FR_C,         2, is_sub, no_basic, no_entity },
    { RCV_FR_mCS,       2, is_sub, no_basic, no_entity },
    { RCV_FR_mCH,       2, is_sub, no_basic, no_entity },
/*    { CMP_COMPUTER,   1, is_sub, no_basic, no_entity },*/
    { CMP_COMPUTER,     8, is_sub, no_basic, no_entity },
/*    { CMP_OWNERS,     1, is_sub, no_basic, no_entity }, */
    { CMP_OWNERS,       8, is_sub, no_basic, no_entity },
    { CMP_NEIGHBOUR,    1, is_sub, no_basic, no_entity },
    { CMP_LID,          8, is_fun, no_basic, no_entity },
    { TWIN_P,           2, is_fun, no_basic, no_entity },
    { CND_SENDERP,      0, is_fun, no_basic, no_entity },
    { CND_OWNERP,       0, is_fun, no_basic, no_entity },
    { CND_COMPUTERP,    0, is_fun, no_basic, no_entity },
    { CND_COMPINOWNP,   0, is_fun, no_basic, no_entity },
    { LOCAL_IND,        3, is_fun, no_basic, no_entity },
    { LOCAL_IND_GAMMA,  3, is_fun, no_basic, no_entity },
    { LOCAL_IND_DELTA,  3, is_fun, no_basic, no_entity },
    { IDIVIDE,          2, is_fun, no_basic, no_entity },
    { INIT_HOST,        0, is_sub, no_basic, no_entity },
    { INIT_NODE,        0, is_sub, no_basic, no_entity },
    { HOST_END,         0, is_sub, no_basic, no_entity },
    { NODE_END,         0, is_sub, no_basic, no_entity },
    { HPFC_STOP,        0, is_sub, no_basic, no_entity },
    { LOOP_BOUNDS,      0, is_sub, no_basic, no_entity },
    { SYNCHRO,          0, is_sub, no_basic, no_entity },
    { SND_TO_N,         0, is_sub, no_basic, no_entity },
    { RCV_FR_N,         0, is_sub, no_basic, no_entity },
 
/* HOST/NODE MESSAGES
 */
    { HPFC_HCAST,       0, is_sub, no_basic, no_entity },
    { HPFC_NCAST,       0, is_sub, no_basic, no_entity },
    { HPFC_sN2H,        0, is_sub, no_basic, no_entity },
    { HPFC_sH2N,        1, is_sub, no_basic, no_entity },
    { HPFC_rN2H,        1, is_sub, no_basic, no_entity },
    { HPFC_rH2N,        0, is_sub, no_basic, no_entity },
 
/*  PVM 3 stuff
 */
    { PVM_INITSEND,     2, is_sub, no_basic, no_entity },
    { PVM_SEND,         3, is_sub, no_basic, no_entity },
    { PVM_RECV,         3, is_sub, no_basic, no_entity },
    { PVM_CAST,         4, is_sub, no_basic, no_entity },
    { PVM_PACK,         5, is_sub, no_basic, no_entity },
    { PVM_UNPACK,       5, is_sub, no_basic, no_entity },
 
/*  Variables: the overloaded ones *must* be kept overloaded, otherwise
 *             they may be added in the declarations, while there are 
 *             in the included commons...
 */
    { MYPOS,            2, is_var, no_basic, no_entity },
    { MYLID,            0, is_var, no_basic, no_entity },
    { MSTATUS,          1, is_var, no_basic, no_entity },
    { LIVEMAPPING,      1, is_var, no_basic, no_entity },
    { INFO,             0, is_var, is_basic_int,        no_entity },
    { BUFID,            0, is_var, is_basic_int,        no_entity },
    { NBTASKS,          0, is_var, no_basic, no_entity },
    { T_LID,            0, is_var, is_basic_int,        no_entity },
    { T_LIDp,           0, is_var, is_basic_int,        no_entity },
    { NODETIDS,         1, is_var, no_basic, no_entity },
    { SEND_CHANNELS,    1, is_var, no_basic, no_entity },
    { RECV_CHANNELS,    1, is_var, no_basic, no_entity },
    { MCASTHOST,        0, is_var, no_basic, no_entity },
    { HOST_TID,         0, is_var, no_basic, no_entity },
    { HOST_SND_CHAN,    0, is_var, no_basic, no_entity },
    { HOST_RCV_CHAN,    0, is_var, no_basic, no_entity },
 
/* common /hpfc_buffers/
 */
    { LAZY_SEND,        0, is_var, no_basic, no_entity },
    { LAZY_RECV,        0, is_var, no_basic, no_entity },
    { SND_NOT_INIT,     0, is_var, no_basic, no_entity },
    { RCV_NOT_PRF,      0, is_var, no_basic, no_entity },
    { BUFFER_SIZE,      0, is_var, no_basic, no_entity },
    { BUFFER_INDEX,     0, is_var, no_basic, no_entity },
    { BUFFER_RCV_SIZE,  0, is_var, no_basic, no_entity },
    /* { BUFFER_ENCODING,       0, is_var, no_basic, no_entity }, */
  
    /* typed buffers 
     */
    { PVM_BYTE1 BUFFER,                 1, is_var, no_basic, no_entity },
    { PVM_STRING BUFFER,                1, is_var, no_basic, no_entity },
    { PVM_INTEGER2 BUFFER,              1, is_var, no_basic, no_entity },
    { PVM_INTEGER4 BUFFER,              1, is_var, no_basic, no_entity },
    { PVM_REAL4 BUFFER,                 1, is_var, no_basic, no_entity },
    { PVM_REAL8 BUFFER,                 1, is_var, no_basic, no_entity },
    { PVM_COMPLEX8 BUFFER,              1, is_var, no_basic, no_entity },
    { PVM_COMPLEX16 BUFFER,             1, is_var, no_basic, no_entity },
 
    /* typed buffer sizes
     */
    { PVM_BYTE1 BUFSZ,                  1, is_var, no_basic, no_entity },
    { PVM_STRING BUFSZ,                 1, is_var, no_basic, no_entity },
    { PVM_INTEGER2 BUFSZ,               1, is_var, no_basic, no_entity },
    { PVM_INTEGER4 BUFSZ,               1, is_var, no_basic, no_entity },
    { PVM_REAL4 BUFSZ,                  1, is_var, no_basic, no_entity },
    { PVM_REAL8 BUFSZ,                  1, is_var, no_basic, no_entity },
    { PVM_COMPLEX8 BUFSZ,               1, is_var, no_basic, no_entity },
    { PVM_COMPLEX16 BUFSZ,              1, is_var, no_basic, no_entity },
 
    /* typed pack/unpack hpfc functions, for buffer management.
     */
    { PVM_BYTE1 BUFPCK,                 0, is_sub, no_basic, no_entity },
    { PVM_STRING BUFPCK,                0, is_sub, no_basic, no_entity },
    { PVM_INTEGER2 BUFPCK,              0, is_sub, no_basic, no_entity },
    { PVM_INTEGER4 BUFPCK,              0, is_sub, no_basic, no_entity },
    { PVM_REAL4 BUFPCK,                 0, is_sub, no_basic, no_entity },
    { PVM_REAL8 BUFPCK,                 0, is_sub, no_basic, no_entity },
    { PVM_COMPLEX8 BUFPCK,              0, is_sub, no_basic, no_entity },
    { PVM_COMPLEX16 BUFPCK,             0, is_sub, no_basic, no_entity },
 
    { PVM_BYTE1 BUFUPK,                 0, is_sub, no_basic, no_entity },
    { PVM_STRING BUFUPK,                0, is_sub, no_basic, no_entity },
    { PVM_INTEGER2 BUFUPK,              0, is_sub, no_basic, no_entity },
    { PVM_INTEGER4 BUFUPK,              0, is_sub, no_basic, no_entity },
    { PVM_REAL4 BUFUPK,                 0, is_sub, no_basic, no_entity },
    { PVM_REAL8 BUFUPK,                 0, is_sub, no_basic, no_entity },
    { PVM_COMPLEX8 BUFUPK,              0, is_sub, no_basic, no_entity },
    { PVM_COMPLEX16 BUFUPK,             0, is_sub, no_basic, no_entity },
 
/* special FCD target calls.
 */
    { HOST_TIMEON,                      0, is_sub, no_basic, no_entity },
    { NODE_TIMEON,                      0, is_sub, no_basic, no_entity },
    { HOST_TIMEOFF,                     0, is_sub, no_basic, no_entity },
    { NODE_TIMEOFF,                     0, is_sub, no_basic, no_entity },
    { HPFC_NTELL,                       0, is_sub, no_basic, no_entity },
    { HPFC_HTELL,                       0, is_sub, no_basic, no_entity },
 
/* special FCD calls needed for translation...
 */
    { HPF_PREFIX SYNCHRO_SUFFIX,        0, is_sub, no_basic, no_entity },
    { HPF_PREFIX TIMEON_SUFFIX,         0, is_sub, no_basic, no_entity },
    { HPF_PREFIX TIMEOFF_SUFFIX,        0, is_sub, no_basic, no_entity },
    { HPF_PREFIX RENAME_SUFFIX,         0, is_sub, no_basic, no_entity },
    { HPF_PREFIX HOSTSECTION_SUFFIX,    0, is_sub, no_basic, no_entity },
    { HPF_PREFIX TELL_SUFFIX,           0, is_sub, no_basic, no_entity },
 
/* End
 */
    { "",                               0, is_end, -1, NULL },
};
 
/* to be seen from outside of this file
 */
void hpfc_init_run_time_entities()
{
    RunTimeSupportDescriptor *current;
    int i=0;
    list l=NIL;
 
    if (RTSTable_initialized_p) return;
    RTSTable_initialized_p = true;
 
    for(current=RTSTable;
        current->what!=is_end;
        current++)
    {
        pips_debug(6, "initializing %s, %d\n", current->name, current->arity);
 
        switch(current->what)
        {
        case is_fun:
            current->object = MakeRunTimeSupportFunction(current->name, 
                                                         current->arity,
                                                         current->basic);
            break;
        case is_sub:
            current->object = MakeRunTimeSupportSubroutine(current->name, 
                                                           current->arity);
            break;
        case is_ifn: 
            /* they are declared as variables to avoid redefinitions 
             * ??? this fools pips typing (functions/variables and so)
             * just okay for the pretty printer...
             */
        case is_iof:
        case is_var:
            current->object = 
                find_or_create_typed_entity(current->name,
                                            HPFC_PACKAGE, /* why not */
                                            current->basic);
            /* dimensions are updated
             */
            l = NIL;
            for(i=1; i<=current->arity; i++)
                l = CONS(DIMENSION,
                         make_dimension(int_to_expression(1),
                                        int_to_expression(1),
                                        NIL),
                         l);
            variable_dimensions
                (type_variable(entity_type(current->object))) = l;
            break;
        default:
            pips_internal_error("unexpected what field in Descriptor");
        }    
    }
}
 
static RunTimeSupportDescriptor *find_entry_by_name(const char *name)
{
    RunTimeSupportDescriptor *current;
 
    for(current=RTSTable; current->what!=is_end; current++)
        if (!strcmp(current->name, name)) 
            return current;
    
    return (RunTimeSupportDescriptor *) NULL;
}
 
entity hpfc_name_to_entity(const char *name)
{
    RunTimeSupportDescriptor *entry = find_entry_by_name(name);
 
    if (entry) return entry->object;
 
    pips_internal_error("%s not found", name);
 
    return entity_undefined; /* just to avoid a gcc warning */
}
 
bool hpfc_intrinsic_like_function(e)
entity e;
{
    RunTimeSupportDescriptor *entry = find_entry_by_name(entity_local_name(e));
 
    return entry ? entry->what==is_ifn : false;
}
 
bool hpfc_io_like_function(e)
entity e;
{
    RunTimeSupportDescriptor *entry = find_entry_by_name(entity_local_name(e));
 
    return entry ? entry->what==is_iof : false;
}
 
/* that is all
 */