flint_walk.c

Go to the documentation of this file.

/*
 
  $Id: flint_walk.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
/* This file contains a set of functions defined to walk through the
 * internal representation of a module and chek different things, as the
 * number of arguments, the compatibility of the types of these arguments,
 * ...  There is one function for each domain. Its basic principle is to
 * walk through the internal representation by recursive calls to
 * functions handling sub-domains.
 * 
 * Laurent Aniort & Fabien Coelho 1992
 */
 
#include "local.h"
 
/************************************************************/
 
/* Print message and exit violently from flint */
#define FATAL(msg,value) {fprintf(stderr,msg,value);exit(1);}
 
/************************************************************/
/* The only global variable : the name of the current module */
/* extern char    *current_module_name; unused and changed */
 
/************************************************************/
/* These two functions deal with the boundaries of finite   */
/* arrays, verifying their definition as expressions        */
 
void            flint_cons_dimension(pc)
    list            pc;
{
    flint_dimension(DIMENSION(CAR(pc)));
}
 
dimension       flint_dimension(d)
    dimension       d;
{
    expression      el = dimension_lower(d);
    expression      eu = dimension_upper(d);
 
    flint_expression(el);
    flint_expression(eu);
 
    return (d);
}
 
/************************************************************/
/* This function checks the syntax of a call and recursively */
/* verifies its arguments                                   */
 
call            flint_call(c)
    call            c;
{
    list            la = call_arguments(c);
 
    check_the_call(c);
 
    gen_mapl((gen_iter_func_t)flint_cons_actual_argument, la);
 
    return (c);
}
/************************************************************/
/* This function verifies that incremented or decremented   */
/* loop(for) indices do not overflow or underflow their     */
/* limits                                                   */
 
range           flint_range(r)
    range           r;
{
    expression      el = range_lower(r);
    expression      eu = range_upper(r);
    expression      ei = range_increment(r);
 
    flint_expression(el);
    flint_expression(eu);
    flint_expression(ei);
 
    return (r);
}
/************************************************************/
/* A reference is used when given a function the address of */
/* an element instead of its value.                         */
 
reference       flint_reference(r)
    reference       r;
{
    list            pc = reference_indices(r);
 
    (void) check_the_reference(r);
 
    gen_mapl((gen_iter_func_t)flint_cons_expression, pc);
 
    return (r);
}
/************************************************************/
/* verification of syntaxes                                 */
 
void            flint_syntax(s)
    syntax          s;
{
    reference       re;
    range           ra;
    call            c;
 
    /* branch according to the syntax subclass */
    switch (syntax_tag(s)) {
    case is_syntax_reference:
        re = syntax_reference(s);
        flint_reference(re);
        break;
    case is_syntax_range:
        ra = syntax_range(s);
        flint_range(ra);
        break;
    case is_syntax_call:
        c = syntax_call(s);
        flint_call(c);
        break;
    default:
        FATAL("flint_syntax: unexpected tag %u\n", syntax_tag(s));
    }
}
 
/************************************************************/
/* These two functions operate on the list of expressions   */
 
void            flint_cons_expression(pc)
    list            pc;
{
    flint_expression(EXPRESSION(CAR(pc)));
}
 
 
void            
flint_cons_actual_argument(list pc)
{
    expression e = EXPRESSION(CAR(pc));
 
    /* An array actual argument may have no indices */
    if(expression_reference_p(e)) {
        reference r = expression_reference(e);
 
        if(gen_length(reference_indices(r))!=0)
            flint_expression(e);
    }
    else {
        flint_expression(e);
    }
}
 
expression      flint_expression(e)
    expression      e;
{
    syntax          s = expression_syntax(e);
 
    flint_syntax(s);
 
    return (e);
}
/************************************************************/
/* Recursive verification of a loop as (range)+(expression) */
 
loop            flint_loop(l)
    loop            l;
{
    range           r = loop_range(l);
    statement       s = loop_body(l);
 
    flint_range(r);
    flint_statement(s);
 
    return (l);
}
/************************************************************/
/* A test is taken as (expression)+(statement)+(statement)  */
 
test            flint_test(t)
    test            t;
{
    expression      e = test_condition(t);
    statement       st = test_true(t);
    statement       sf = test_false(t);
 
    flint_expression(e);
    flint_statement(st);
    flint_statement(sf);
 
    return (t);
}
/************************************************************/
/* Verification of an instruction with branching according  */
/* to its subclass as defined in the data structure         */
 
instruction flint_instruction(i)
instruction i;
{
    list            pc;
    test            t;
    loop            l;
    call            c;
    unstructured    u;
 
    switch (instruction_tag(i)) {
    case is_instruction_block:
        pc = instruction_block(i);
        gen_mapl((gen_iter_func_t)flint_cons_statement, pc);
        break;
    case is_instruction_test:
        t = instruction_test(i);
        flint_test(t);
        break;
    case is_instruction_loop:
        l = instruction_loop(i);
        flint_loop(l);
        break;
    case is_instruction_goto:
        break;
    case is_instruction_unstructured:
        u = instruction_unstructured(i);
        flint_unstructured(u);
        break;
    case is_instruction_call:
        c = instruction_call(i);
        (void) check_procedure(c);
        flint_call(c);
        break;
    default:
        FATAL("flint_instruction: unexpected tag %u\n", instruction_tag(i));
    }
 
    return (i);
}
/************************************************************/
void            flint_unstructured(u)
    unstructured    u;
{
    list            blocs = NIL;
 
    CONTROL_MAP(c, {
        flint_statement(control_statement(c));
    }, unstructured_control(u), blocs);
 
    gen_free_list(blocs);
}
/************************************************************/
void            flint_cons_statement(pc)
    list            pc;
{
    flint_statement(STATEMENT(CAR(pc)));
}
 
extern statement 
    flint_current_statement;
 
statement       flint_statement(s)
statement       s;
{
    instruction     
        i = statement_instruction(s);
    statement       
        saved = flint_current_statement;
    
    flint_current_statement = s;
    
    flint_instruction(i);
    
    flint_current_statement = saved;
    return (s);
}
 
/************************************************************/
/* End of File */