fortran90.c File Reference

#include <stdio.h>
#include "linear.h"
#include "genC.h"
#include "text.h"
#include "text-util.h"
#include "ri.h"
#include "misc.h"
#include "ri-util.h"
#include "prettyprint.h"

Include dependency graph for fortran90.c:

Go to the source code of this file.

Functions
static statement	body_to_assignment_statement (statement b)
	The tests necessary to check the underlying assumptions have been performed in text_loop(): b is either an assignment or a sequence with only one statement which is an assignment. More...
text	text_loop_90 (entity module, const char *label, int margin, loop obj, int n)
	Generate range subscript for simple loop with only one assignment. More...
static expression	expand_call (expression e, entity f, list args)
	Only one call site for expand_call(). More...
expression	expand_reference (syntax s, expression e, entity i, range r)
	A reference cannot always be expanded. More...
expression	expand_expression (e, i, r)
	Expression with a non-expandable sub-expression, e.g. More...

Variables
static set	vectors
	Prettyprint one FORTRAN 90 loop as an array expression. More...

Function Documentation

body_to_assignment_statement()

static statement body_to_assignment_statement ( statement  b )

static

The tests necessary to check the underlying assumptions have been performed in text_loop(): b is either an assignment or a sequence with only one statement which is an assignment.

because of the input assumptions

Definition at line 61 of file fortran90.c.

{
  instruction bi = statement_instruction(b);
  statement s = statement_undefined;
 
  if(instruction_sequence_p(bi)) {
    list sl = sequence_statements(instruction_sequence(bi));
    s = STATEMENT(CAR(sl));
  }
  else /* because of the input assumptions */
    s = b;
 
  return s;
}

References CAR, instruction_sequence, instruction_sequence_p, sequence_statements, STATEMENT, statement_instruction, and statement_undefined.

Referenced by text_loop_90().

Here is the caller graph for this function:

expand_call()

static expression expand_call ( expression  e, entity  f, list  args  )

static

Only one call site for expand_call().

All args have been newly allocated there and are re-used here to build new_e, Or they are freed without forgetting the references thru set "vectors". There is no sharing between e and new_e.

strcmp( entity_local_name( f ), DIVIDE_OPERATOR_NAME ) == 0 ||

FI: Sharing thru args? Yes, but see above.

No sharing between e and new_e

Definition at line 145 of file fortran90.c.

{
    expression new_e = expression_undefined;
    bool vector_op = 
        (strcmp( entity_local_name( f ), PLUS_OPERATOR_NAME ) == 0 ||
         strcmp( entity_local_name( f ), MINUS_OPERATOR_NAME ) == 0 ||
         /* strcmp( entity_local_name( f ), DIVIDE_OPERATOR_NAME ) == 0 || */
         strcmp( entity_local_name( f ), MULTIPLY_OPERATOR_NAME ) == 0 ) ;
 
    if( !vector_op ) {
        /* FI: Sharing thru args? Yes, but see above. */
        bool vectorp = false;
        new_e = make_expression(make_syntax(is_syntax_call,
                                            make_call( f, args )),
                                normalized_undefined);
        MAP(EXPRESSION, arg, {
            vectorp |= set_belong_p( vectors, (char *)arg );
        }, args);
 
        if(vectorp)
            set_add_element( vectors, vectors, (char *)new_e ) ;
    }
    else {
        expression lhs = EXPRESSION(CAR(args)) ;
        expression rhs = EXPRESSION(CAR(CDR(args))) ;
        syntax ls = expression_syntax( lhs ) ;
        syntax rs = expression_syntax( rhs ) ;
 
        if(set_belong_p( vectors, (char *)lhs ) &&
           set_belong_p( vectors, (char *)rhs )) {
            if( syntax_range_p( ls ) && syntax_range_p( rs )) {
                range rl = syntax_range( ls ) ;
                range rr = syntax_range( rs ) ;
 
                new_e = update_range(f, rl, 
                                     range_lower(rr), range_upper(rr),
                                     range_increment(rr), true) ;
            }
            else {
                new_e = MakeBinaryCall( f, lhs, rhs ) ;
            }
            set_add_element( vectors, vectors, (char *)new_e ) ;
        }
        else if( set_belong_p( vectors, (char *)lhs )) {
            if( syntax_range_p( ls )) {
                range rl = syntax_range( ls ) ;
 
                new_e = update_range(f, rl, rhs, rhs, int_to_expression(1), true) ;
            }
            else {
                new_e = MakeBinaryCall( f, lhs, rhs ) ;
            }
            set_add_element( vectors, vectors, (char *)new_e ) ;
        }
        else if( set_belong_p( vectors, (char *)rhs )) {
            if( syntax_range_p( rs )) {
                range rr = syntax_range( rs ) ;
 
                new_e = update_range(f, rr, lhs, lhs, int_to_expression(1), false) ;
            }
            else {
                new_e = MakeBinaryCall( f, lhs, rhs ) ;
            }
            set_add_element(vectors, vectors, (char *) new_e);
        }
        else {
            /* No sharing between e and new_e */
            new_e = copy_expression(e);
        }
    }
    return new_e;
}

References CAR, CDR, copy_expression(), entity_local_name(), EXPRESSION, expression_syntax, expression_undefined, f(), int_to_expression(), is_syntax_call, make_call(), make_expression(), make_syntax(), MakeBinaryCall(), MAP, MINUS_OPERATOR_NAME, MULTIPLY_OPERATOR_NAME, normalized_undefined, PLUS_OPERATOR_NAME, range_increment, range_lower, range_upper, set_add_element(), set_belong_p(), syntax_range, syntax_range_p, update_range(), and vectors.

Referenced by expand_expression().

Here is the call graph for this function:

Here is the caller graph for this function:

expand_expression()

expression expand_expression	(	e	,
		i	,
		r
	)

Expression with a non-expandable sub-expression, e.g.

a non-expandable reference, cannot be expanded.

Arguments are not (should not be) shared with the returned expression.

FI: I do not know why dim is computed. Old cut-and-paste from expand_reference()?

Definition at line 286 of file fortran90.c.

{
    syntax s = expression_syntax( e ) ;
    expression new_e = expression_undefined;
 
    switch(syntax_tag( s )) 
    {
    case is_syntax_reference:
        new_e = expand_reference( s, e, i, r);
        break;
    case is_syntax_call: {
        call c = syntax_call( s ) ;
        cons *new_args = NIL ;
        entity f = call_function( c ) ;
        int dim = 0 ;
        
        MAPL( args, {
            expression arg = EXPRESSION( CAR( args )) ;
            
            new_e = expand_expression( arg, i, r ) ;
 
            if(expression_undefined_p(new_e)) {
                return new_e;
            }
 
            /* FI: I do not know why dim is computed. Old cut-and-paste
               from expand_reference()? */
            if(set_belong_p( vectors, (char *)new_e )) {
                dim++;
            }
 
            new_args = CONS(EXPRESSION, new_e, new_args ) ;
        }, call_arguments( c )) ;
 
        new_e = expand_call(e, f, gen_nreverse(new_args));
        break;
    }
    case is_syntax_range:
        pips_internal_error("Range expansion not implemented" ) ;
    default:
        pips_internal_error("unexpected syntax tag (%d)",
                   syntax_tag(s));
    }
 
    return new_e;
}

References call_arguments, call_function, CAR, CONS, expand_call(), expand_reference(), EXPRESSION, expression_syntax, expression_undefined, expression_undefined_p, f(), gen_nreverse(), is_syntax_call, is_syntax_range, is_syntax_reference, MAPL, NIL, pips_internal_error, set_belong_p(), syntax_call, syntax_tag, and vectors.

Referenced by expand_reference(), and text_loop_90().

Here is the call graph for this function:

Here is the caller graph for this function:

expand_reference()

expression expand_reference	(	syntax	s,
		expression	e,
		entity	i,
		range	r
	)

A reference cannot always be expanded.

Subscript expression coupling as in A(I,I) prevent expansion and an undefined expression is returned. Non-affine expressions such as A(I**2) cannot be transformed into triplets but can be tranformed into implicit DO vectors.

Arguments s, e, i and r should not be shared with the returned expression.

expand occurence of loop index

expand 1 subscript expression or fail or leave unexpanded

If dim is greater than 1, subscript expressions are coupled as in A(I,I+1).

new_args should be freed

Just the spine or more?

Definition at line 225 of file fortran90.c.

{
    reference rf = syntax_reference(s) ;
    expression new_e = expression_undefined;
 
    if( same_entity_p( reference_variable( rf ), i )) {
        /* expand occurence of loop index */
        syntax new_s = make_syntax(is_syntax_range,copy_range(r)) ;
        new_e = make_expression(new_s, normalized_undefined) ;
        set_add_element( vectors, vectors, (char *) new_e ) ;
    }
    else {
        /* expand 1 subscript expression or fail or leave unexpanded */
        int dim = 0 ;
        cons *new_args = NIL ;
        reference new_r ;
 
        MAPL( args, {
            expression arg = EXPRESSION( CAR( args )) ;
 
            new_e = expand_expression( arg, i, r ) ;
 
            if(expression_undefined_p(new_e))
                return new_e;
 
            if(set_belong_p( vectors, (char *)new_e ))
                dim++;
 
            new_args = CONS(EXPRESSION, new_e, new_args ) ;
        }, reference_indices( rf )) ;
 
        if( dim==1 ) {
            new_r = make_reference(reference_variable(rf),
                                   gen_nreverse(new_args)) ;
            new_e = make_expression(make_syntax(is_syntax_reference,new_r),
                                    normalized_undefined) ;
            set_add_element( vectors, vectors, (char *)new_e ) ;
        }
        else if(dim > 1) {
            /* If dim is greater than 1, subscript expressions are coupled
             * as in A(I,I+1).
             */
            /* new_args should be freed */
            new_e = expression_undefined;
        }
        else {
            /* Just the spine or more? */
            gen_free_list(new_args);
            new_e = copy_expression(e);
        }
    }
    return new_e;
}

References CAR, CONS, copy_expression(), copy_range(), expand_expression(), EXPRESSION, expression_undefined, expression_undefined_p, gen_free_list(), gen_nreverse(), is_syntax_range, is_syntax_reference, make_expression(), make_reference(), make_syntax(), MAPL, NIL, normalized_undefined, reference_indices, reference_variable, same_entity_p(), set_add_element(), set_belong_p(), syntax_reference, and vectors.

Referenced by expand_expression().

Here is the call graph for this function:

Here is the caller graph for this function:

text_loop_90()

text text_loop_90	(	entity	module,
		const char *	label,
		int	margin,
		loop	obj,
		int	n
	)

Generate range subscript for simple loop with only one assignment.

fortran90.c

text_loop_90() only is called if the loop is parallel and if its body is a unique assignment statement or a list containing a unique assignment.

statement_ordering must be initialized too to avoid a prettyprinter warning

FI: Although new_s has been converted to text, it cannot always be freed. I do not know which part of new_s is reused in the result of text_statement() or somewhere else... Found with valgrind and validation case Prettyprint/aa01.tpips

No legal vector form has been found

Parameters

module	odule
label	abel
margin	argin
obj	bj

Definition at line 77 of file fortran90.c.

{
    /* text_loop_90() only is called if the loop is parallel and if its
     * body is a unique assignment statement or a list containing a
     * unique assignment.
     */
  statement as = body_to_assignment_statement( loop_body( obj )) ;
  instruction i = statement_instruction(as);
    entity idx = loop_index( obj ) ;
    range r = loop_range( obj ) ;
 
    expression lhs =
        EXPRESSION( CAR( call_arguments( instruction_call( i )))) ;
    expression rhs =
        EXPRESSION( CAR( CDR( call_arguments( instruction_call( i ))))) ;
    expression new_lhs = expression_undefined;
    expression new_rhs = expression_undefined;
    text t = text_undefined;
 
    pips_assert("Loop obj is consistent", loop_consistent_p(obj));
 
    vectors = set_make( set_pointer ) ;
 
    new_lhs = expand_expression( lhs, idx, r ) ;
    new_rhs = expand_expression( rhs, idx, r ) ;
 
    pips_assert("new_lhs is consistent", expression_consistent_p(new_lhs));
    pips_assert("new_rhs is consistent", expression_consistent_p(new_rhs));
 
    set_free(vectors);
 
    if(!expression_undefined_p(new_lhs) && !expression_undefined_p(new_rhs)) {
        statement new_s = make_assign_statement( new_lhs, new_rhs );
 
        statement_number(new_s) = statement_number(as);
        /* statement_ordering must be initialized too to avoid a
           prettyprinter warning */
        statement_ordering(new_s) = statement_ordering(as);
        statement_comments(new_s) = statement_comments(as);
        list pdl = NIL;
        t = text_statement(module, margin, new_s, &pdl);
        gen_free_list(pdl);
        /* FI: Although new_s has been converted to text, it cannot
           always be freed. I do not know which part of new_s is
           reused in the result of text_statement() or somewhere
           else... Found with valgrind and validation case
           Prettyprint/aa01.tpips */
        //free_statement(new_s);
    }
    else {
        /* No legal vector form has been found */
        free_expression(new_lhs);
        free_expression(new_rhs);
        list pdl = NIL;
        t = text_loop_default(module, label, margin, obj, n, &pdl, true);
        gen_free_list(pdl);
    }
 
    pips_assert("Loop obj still is consistent", loop_consistent_p(obj));
 
    return t;
}

References body_to_assignment_statement(), call_arguments, CAR, CDR, expand_expression(), EXPRESSION, expression_consistent_p(), expression_undefined, expression_undefined_p, free_expression(), gen_free_list(), instruction_call, loop_body, loop_consistent_p(), loop_index, loop_range, make_assign_statement(), module, NIL, pips_assert, set_free(), set_make(), set_pointer, statement_comments, statement_instruction, statement_number, statement_ordering, text_loop_default(), text_statement(), text_undefined, and vectors.

Referenced by text_loop().

Here is the call graph for this function:

Here is the caller graph for this function:

Variable Documentation

vectors

set vectors

static

Prettyprint one FORTRAN 90 loop as an array expression.

Pierre Jouvelot

For one level only loop, with one assignment as body. Replaces occurences of the index variable by ranges in expressions. Ranges are prettyprinted as triplet when they occur as subscript expressions and as vectors with implicit DO otherwise. If the replacement cannot occur, for instance because subscript expressions are coupled, the loop is printed as a loop.

There are/were memory leaks here since a new expression is constructed. FI: To keep track of vectorized subexpressions (a guess...)

Definition at line 56 of file fortran90.c.

Referenced by expand_call(), expand_expression(), expand_reference(), and text_loop_90().