compiler-util.c

Go to the documentation of this file.

/*
 
  $Id: compiler-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
/* Compiler Utilities
 *
 * Fabien Coelho, May 1993
 */
 
#include "defines-local.h"
 
/***************************************************************************/
 
void update_control_lists(c, map)
control c;
control_mapping map;
{
    control cprime = (control) GET_CONTROL_MAPPING(map, c);
 
    pips_assert("empty lists for cprime",
                control_predecessors(cprime)==NIL &&
                control_successors(cprime)==NIL);
 
    control_predecessors(cprime) = 
        updated_control_list(control_predecessors(c), map);
    control_successors(cprime) = 
        updated_control_list(control_successors(c), map);
}
 
list updated_control_list(lc, map)
list lc;
control_mapping map;
{
    list lc_result = NIL;
    control new_c = control_undefined;
 
    MAP(CONTROL, current,
     {
         new_c = (control) GET_CONTROL_MAPPING(map, current);
 
         pips_assert("defined",
                     !control_undefined_p(current) ||
                     !control_undefined_p(new_c));
 
         lc_result = CONS(CONTROL, new_c, lc_result);
     },
         lc);
 
    return(gen_nreverse(lc_result));
}
 
/* FindRefToDistArrayInStatement
 *
 * everything may be quite false regarding to the real effects of
 * the functions called, but it seems to me that the pips effect analysis
 * doesn't match my needs... and I have not much time to think about that...
 *
 * ??? these stupid functions assume no indirections on distributed arrays
 * ??? also that they are not written by a function other than assign
 */
static list
   found_written = NIL,
   found_read = NIL;
 
#define call_assign_p(c) \
  (strcmp(entity_local_name(call_function(c)), ASSIGN_OPERATOR_NAME)==0)
 
static bool FindRefToDistArrayInStatement_call_filter(c)
call c;
{
    list l;
    syntax s;
 
    if (!call_assign_p(c)) return(true);
 
    /*   else ASSIGN case
     */
 
    l = call_arguments(c);
    s = expression_syntax(EXPRESSION(CAR(l)));
    
    if (array_distributed_p(reference_variable(syntax_reference(s))))
        found_written = CONS(SYNTAX, s, found_written);
    
    found_read = 
        gen_nconc(FindRefToDistArray(EXPRESSION(CAR(CDR(l)))),
                  found_read);
    
    return(false);
}
 
static bool FindRefToDistArrayInStatement_expression_filter(e)
expression e;
{
    found_read = gen_nconc(FindRefToDistArray(e), found_read);
    return(false);
}
 
void FindRefToDistArrayInStatement(obj, lwp, lrp)
statement obj;
list *lwp, *lrp;
{
    list
        saved_r = found_read,
        saved_w = found_written;
 
    found_read = NIL, found_written = NIL;
 
    gen_multi_recurse(obj,
                      call_domain,
                      FindRefToDistArrayInStatement_call_filter,
                      gen_null,
                      expression_domain,
                      FindRefToDistArrayInStatement_expression_filter,
                      gen_null,
                      NULL);
 
    *lwp = found_written, *lrp = found_read,
    found_read = saved_r, found_written = saved_w;
}
 
 
/* computes the list of indices of the list of ref that are variables...
 */
list lIndicesOfRef(lsyn)
list lsyn;
{
    return((ENDP(lsyn))?
           (NULL):
           (AddOnceToIndicesList(IndicesOfRef(SYNTAX(CAR(lsyn))),
                                 lIndicesOfRef(CDR(lsyn)))));
}
 
list IndicesOfRef(syn)
syntax syn;
{
    list l = NIL;
 
    pips_assert("reference", syntax_reference_p(syn));
 
    MAP(EXPRESSION, e,
     {
         syntax s = expression_syntax(e);
 
         switch (syntax_tag(s))
         {
         case is_syntax_reference:
             l = CONS(SYNTAX, s, l);
             break;
         case is_syntax_range:
             pips_internal_error("don't konw what to do with a range");
             break;
         case is_syntax_call:
             /*     ??? could check that the given call is a constant.
              */
             break;
         default:
             pips_internal_error("unexpected syntax tag");
         }       
     },
         reference_indices(syntax_reference(syn)));
 
    return(l);   
}
 
list AddOnceToIndicesList(l, lsyn)
list l, lsyn;
{
    MAP(SYNTAX, s,
        if (!is_in_syntax_list(reference_variable(syntax_reference(s)), lsyn))
             lsyn = CONS(SYNTAX, s, lsyn),
        l);
 
    gen_free_list(l);
    return(lsyn);
}
 
bool is_in_syntax_list(e, l)
entity e;
list l;
{
    MAP(SYNTAX, s,
        if (e==reference_variable(syntax_reference(s))) return(true),
        l);
 
    return(false);
}
 
/* ??? False!
 * The definition looked for must be an assignment call...
 */
static list
  syntax_list=NIL,
  found_definitions=NIL;
 
static void FindDefinitionsOf_rewrite(s)
statement s;
{
    instruction i = statement_instruction(s);
 
    /* ??? False! nothing is checked about the statement movement...
     */
    if (instruction_assign_p(i))
        if (is_in_syntax_list
            (reference_variable
             (expression_reference
              (EXPRESSION(CAR(call_arguments(instruction_call(i)))))),
                 syntax_list))
        {
            found_definitions = 
                CONS(STATEMENT, instruction_to_statement(i), found_definitions);
            statement_instruction(s) = 
                make_continue_instruction();
        }
}
 
list FindDefinitionsOf(stat, lsyn)
statement stat;
list lsyn;
{
    list result = NIL;
 
    pips_assert("empty lists", ENDP(syntax_list) && ENDP(found_definitions));
 
    syntax_list = lsyn;
 
    gen_recurse(stat,
                statement_domain,
                gen_true,
                FindDefinitionsOf_rewrite);
 
    result = found_definitions,
    syntax_list = NIL,
    found_definitions = NIL;
 
    return(result);
}
 
/* atomic_accesses_only_p
 * 
 * checks that only atomic accesses to distributed variables are made
 * inside a parallel loop nest, for every iterations.
 *
 * ??? partially implemented, and the conclusions may be false...
 */
bool atomic_accesses_only_p(_UNUSED_ statement stat)
{
  ifdebug(1)
    hpfc_warning("not  implemented, returning TRUE\n");
  return true;
}
 
/* indirections_inside_statement_p
 *
 * ??? this may be checked using the dependences graph, looking for
 * edges linking two distributed variables inside the loop...
 */
bool indirections_inside_statement_p(_UNUSED_ statement stat)
{
  ifdebug(1)
    hpfc_warning("not implemented yet, returning FALSE\n");
  return false;
}
 
/* ------------------------------------------------------------------
 * statement parallel_loop_nest_to_body(loop_nest, pblocks, ploops)
 * statement loop_nest;
 * list *pblocks, *ploops;
 *
 * What I want is to extract the parallel loops from loop_nest,
 * while keeping track of the structure if the loop nest is not
 * perfectly nested. Only a very simple structure is recognized.
 *
 * it returns the inner statement of the loop nest,
 * a list of pointers to the loops, and a list of pointers
 * to the blocks containing these loops if any.
 *
 * we may discuss the implementation based on static global variables...
 * but I cannot see how to do it otherwise with a gen_recurse.
 */
 
static list 
    loops, /* lisp of loops */
    blocks;/* list of lists, may be NIL if none */
static int n_loops, n_levels;
static statement inner_body;
 
static bool loop_filter(loop l)
{
    return execution_parallel_p(loop_execution(l));
}
 
static void sequence_rewrite(sequence s)
{
    if (n_loops==0 && n_levels==0) /* there was no doall inside */
        return;
 
    if (n_loops-n_levels!=1)
        pips_internal_error("block within a block encountered");
 
    n_levels++, blocks = CONS(LIST, sequence_statements(s), blocks);
}
 
static void loop_rewrite(loop l)
{
    if (n_loops!=n_levels) /* a loop was found directly as a body */
        n_levels++, blocks = CONS(LIST, NIL, blocks);
 
    if (n_loops==0) inner_body=loop_body(l);
    loops = CONS(LOOP, l, loops);
    n_loops++;
}
 
statement parallel_loop_nest_to_body(loop_nest, pblocks, ploops)
statement loop_nest;
list *pblocks, *ploops;
{
    loops=NIL, n_loops=0;
    blocks=NIL, n_levels=0;
    inner_body=statement_undefined;
 
    pips_assert("loop", instruction_loop_p(statement_instruction(loop_nest)));
 
    gen_multi_recurse(loop_nest,
                      sequence_domain, gen_true, sequence_rewrite,
                      loop_domain, loop_filter, loop_rewrite,
                      NULL);
 
    pips_assert("loops found", n_loops!=0 && (n_loops-n_levels==1));
 
    *pblocks = CONS(LIST, NIL, blocks); /* nothing was done for the first ! */
    *ploops=loops;
 
    return(inner_body);
}
 
/************************************************************ CURRENT LOOPS */
 
/*   management of a list of current loops. very burk ???
 */
 
static list current_loop_list=NIL;
 
static void set_current_loops_rewrite(loop l)
{
    current_loop_list = CONS(LOOP, l, current_loop_list);
}
 
void set_current_loops(statement obj)
{
    pips_assert("no current loop", current_loop_list==NIL);
    gen_recurse(obj, loop_domain, gen_true, set_current_loops_rewrite);
}
 
void reset_current_loops()
{
    gen_free_list(current_loop_list);
    current_loop_list=NIL;
}
 
bool entity_loop_index_p(e)
entity e;
{
    MAP(LOOP, l, if (e == loop_index(l)) return true, current_loop_list);
    return false;
}
 
range loop_index_to_range(index)
entity index;
{
    MAP(LOOP, l, if (loop_index(l)==index) return(loop_range(l)),
        current_loop_list);
    return range_undefined;
}
 
/* that is all
 */