/*
$Id$
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 .
*/
#ifdef HAVE_CONFIG_H
#include "pips_config.h"
#endif
/* -----------------------------------------------------------------
*
* BOTTOM-UP ARRAY BOUND CHECK VERSION
*
* -----------------------------------------------------------------
*
* This program takes as input the current module, adds array range checks
* (lower and upper bound checks) to every statement that has one or more
* array accesses. The output is the module with those tests added.
* Assumptions : there is no write effect on the array bound expression.
*
* There was a test for write effect on bound here but I put it away (in
* effect_on_array_bound.c) because it takes time to calculate the effect
* but in fact this case is rare.
*
* NN 20/03/2002: Attention: tests generated for array whose bounds are modified are not correct
* See Validation/ArrayBoundCheck/BU_Effect.f
* Solution : reput the test effect_on_array_bound, instrument the code with
* SUBROUTINE EFFECT(A,N)
* REAL A(N)
* N_PIPS = N
* N = 2*N
* DO I =1,N
* IF (I. GT. N_PIPS .OR I. LT> 1) STOP
* A(I) = I
* ENNDO
*
* Question : other analyses (regions,.. ) are correct ?
*
*
* Version: change the structure of test:
* IF (I.LT.lower) THEN STOP "Bound violation ..."
* IF (I.GT.upper) THEN STOP "Bound violation ..."
* Add statistics
* Version : Modify the Implied-DO process
*/
#include
#include
#include
#include "genC.h"
#include "linear.h"
#include "ri.h"
#include "effects.h"
#include "alias_private.h"
#include "ri-util.h"
#include "prettyprint.h"
#include "effects-util.h"
#include "text-util.h"
#include "database.h"
#include "pipsdbm.h"
#include "resources.h"
#include "misc.h"
#include "control.h"
#include "properties.h"
#include "instrumentation.h"
/* As we create checks with stop error message who tell us there are bound
* violations for which array, on which dimension, which bound (lower or upper),
* the following typedef array_dimension_bound_test permits us to create a
* sequence of tests for each statement more easier.
*
* The functions bottom_up_abc_call,
* bottom_up_abc_reference,
* bottom_up_abc_expression return results of type
* array_dimension_bound_test */
typedef struct array_dimension_bound_test
{
list arr;
list dim;
list bou;
list exp;
} array_dimension_bound_test;
/* Data structure to support abc Implied DO*/
typedef struct Index_range
{
list ind;
list ran;
} Index_range;
/* context data structure for bottom_up_abc newgen recursion */
typedef struct
{
persistant_statement_to_control map;
stack uns;
}
bottom_up_abc_context_t,
* bottom_up_abc_context_p;
#define array_dimension_bound_test_undefined ((array_dimension_bound_test) {NIL,NIL,NIL,NIL} )
#define Index_range_undefined ((Index_range) {NIL,NIL})
/* Statistic variables: */
static int number_of_bound_checks;
static int number_of_added_checks;
static int number_of_bound_violations;
static void initialize_bottom_up_abc_statistics()
{
number_of_bound_checks = 0;
number_of_added_checks = 0;
number_of_bound_violations = 0;
}
static void display_bottom_up_abc_statistics()
{
if (number_of_bound_checks > 0)
{
user_log("* There are %d array bound checks *\n",
number_of_bound_checks*2);
}
if (number_of_added_checks > 0)
user_log("* There %s %d array bound check%s added *\n",
number_of_added_checks > 1 ? "are" : "is",
number_of_added_checks,
number_of_added_checks > 1 ? "s" : "");
if (number_of_bound_violations > 0)
user_log("* There %s %d bound violation%s *\n",
number_of_bound_violations > 1 ? "are" : "is",
number_of_bound_violations,
number_of_bound_violations > 1 ? "s" : "");
}
static bool array_dimension_bound_test_undefined_p(array_dimension_bound_test x)
{
if ((x.arr == NIL) && (x.dim == NIL) && (x.bou == NIL) && (x.exp == NIL))
return true;
return false;
}
string int_to_dimension(int i)
{
switch(i)
{
case 0 :
return "wrt common size";
case 1 :
return "1st dimension";
case 2 :
return "2nd dimension";
case 3 :
return "3rd dimension";
case 4 :
return "4th dimension";
case 5 :
return "5th dimension";
case 6 :
return "6th dimension";
case 7 :
return "7th dimension";
default:
return "Over 7!!!";
}
}
/* This function returns true, if the array needs bound checks
* false, otherwise.
*
* If the arrays are not created by user, for example the arrays
* of Logical Units : LUNS, END_LUNS, ERR_LUNS, ... in the
* IO_EFFECTS_PACKAGE_NAME, we don't have to check array references
* for those arrays.
* Maybe we have to add other kinds of arrays, not only those in _IO_EFFECTS_ */
bool array_need_bound_check_p(entity e)
{
const char* s = entity_module_name(e);
if (strcmp(s,IO_EFFECTS_PACKAGE_NAME)==0)
return false;
return true;
}
static array_dimension_bound_test
make_true_array_dimension_bound_test(entity e, int i, bool low)
{
array_dimension_bound_test retour;
expression exp = make_true_expression();
retour.arr = CONS(ENTITY,e,NIL);
retour.dim = CONS(INT,i,NIL);
retour.bou = CONS(BOOL,low,NIL);
retour.exp = CONS(EXPRESSION,exp,NIL);
return retour;
}
static array_dimension_bound_test
make_array_dimension_bound_test(entity e, int i, bool low, expression exp)
{
array_dimension_bound_test retour = array_dimension_bound_test_undefined;
if (!expression_undefined_p(exp))
{
retour.arr = CONS(ENTITY,e,NIL);
retour.dim = CONS(INT,i,NIL);
retour.bou = CONS(BOOL,low,NIL);
retour.exp = CONS(EXPRESSION,exp,NIL);
}
return retour;
}
static array_dimension_bound_test
add_array_dimension_bound_test(array_dimension_bound_test retour,
array_dimension_bound_test temp)
{
if (!array_dimension_bound_test_undefined_p(temp))
{
if (array_dimension_bound_test_undefined_p(retour))
{
pips_debug(3, "\n Add bound checks for array: %s",entity_local_name(ENTITY(CAR(temp.arr))));
return temp;
}
/* If in temp.exp, there are expressions that exist
in retour.exp, we don't have to add those expressions to retour.exp
If temp.exp is a true expression => add to list to debug several real bound violations*/
while (!ENDP(temp.exp))
{
expression exp = EXPRESSION(CAR(temp.exp));
pips_debug(3, "\n Add bound checks for array: %s",entity_local_name(ENTITY(CAR(temp.arr))));
if (true_expression_p(exp) || !same_expression_in_list_p(exp,retour.exp))
{
retour.arr = gen_nconc(CONS(ENTITY,ENTITY(CAR(temp.arr)),NIL),retour.arr);
retour.dim = gen_nconc(CONS(INT,INT(CAR(temp.dim)),NIL),retour.dim);
retour.bou = gen_nconc(CONS(BOOL,BOOL(CAR(temp.bou)),NIL),retour.bou);
retour.exp = gen_nconc(CONS(EXPRESSION,exp,NIL),retour.exp);
}
else
number_of_added_checks--;
temp.arr = CDR(temp.arr);
temp.dim = CDR(temp.dim);
temp.bou = CDR(temp.bou);
temp.exp = CDR(temp.exp);
}
}
return retour;
}
/*****************************************************************************
This function computes the subscript value of an array element
DIMENSION A(l1:u1,...,ln:un)
subscript_value(A(s1,s2,...,sn)) =
1+(s1-l1)+(s2-l2)*(u1-l1+1)+...+ (sn-ln)*(u1-l1+1)*...*(u(n-1) -l(n-1)+1)
*****************************************************************************/
expression subscript_value(entity arr, list l_inds)
{
expression retour = int_to_expression(1);
if (!ENDP(l_inds))
{
variable var = type_variable(entity_type(arr));
expression prod = expression_undefined;
list l_dims = variable_dimensions(var);
int num_dim = gen_length(l_inds),i;
for (i=1; i<= num_dim; i++)
{
dimension dim_i = find_ith_dimension(l_dims,i);
expression lower_i = dimension_lower(dim_i);
expression sub_i = find_ith_argument(l_inds,i);
expression upper_i = dimension_upper(dim_i);
expression size_i;
if ( expression_constant_p(lower_i) && (expression_to_int(lower_i)==1))
size_i = copy_expression(upper_i);
else
{
size_i = binary_intrinsic_expression(MINUS_OPERATOR_NAME,upper_i,lower_i);
size_i = binary_intrinsic_expression(PLUS_OPERATOR_NAME,
copy_expression(size_i),int_to_expression(1));
}
if (!same_expression_p(sub_i,lower_i))
{
expression sub_low_i = binary_intrinsic_expression(MINUS_OPERATOR_NAME,
sub_i,lower_i);
expression elem_i;
if (expression_undefined_p(prod))
elem_i = copy_expression(sub_low_i);
else
elem_i = binary_intrinsic_expression(MULTIPLY_OPERATOR_NAME,
sub_low_i,prod);
retour = binary_intrinsic_expression(PLUS_OPERATOR_NAME,
retour, elem_i);
}
if (expression_undefined_p(prod))
prod = copy_expression(size_i);
else
prod = binary_intrinsic_expression(MULTIPLY_OPERATOR_NAME,
prod,size_i);
}
}
ifdebug(4)
{
pips_debug(4,"\nSubscript value:");
print_expression(retour);
}
return retour;
}
static array_dimension_bound_test bottom_up_abc_reference(reference r);
static array_dimension_bound_test bottom_up_abc_expression (expression e);
static array_dimension_bound_test bottom_up_abc_call(call cal);
/* The test is: 1 <= offset(e) + subscript_value(r) <= area_size(common)*/
static array_dimension_bound_test abc_with_allocation_size(reference r)
{
array_dimension_bound_test retour = array_dimension_bound_test_undefined;
array_dimension_bound_test temp = array_dimension_bound_test_undefined;
entity e = reference_variable(r);
list inds = reference_indices(r);
ram ra = storage_ram(entity_storage(e));
entity sec = ram_section(ra);
basic b = variable_basic(type_variable(entity_type(e)));
int off = ram_offset(ra)/SizeOfElements(b); /* divided by the element size */
int size = area_size(type_area(entity_type(sec)))/SizeOfElements(b); /* divided by the element size */
int i;
expression subval = subscript_value(e,inds);
expression check = lt_expression(copy_expression(subval),int_to_expression(1-off));
ifdebug(3)
{
pips_debug(3, "\n Lower bound check expression:");
print_expression(check);
}
clean_all_normalized(check);
i = trivial_expression_p(check);
switch(i){
case 1:
{
user_log("\n Bound violation on lower bound of array %s\n",entity_local_name(e));
return make_true_array_dimension_bound_test(e,0,true);
}
case -1:
break;
case 0:
{
number_of_added_checks++;
temp = make_array_dimension_bound_test(e,0,true,check);
retour = add_array_dimension_bound_test(retour,temp);
break;
}
}
check = gt_expression(copy_expression(subval),int_to_expression(size-off));
ifdebug(3)
{
pips_debug(3, "\n Upper bound check expression:");
print_expression(check);
}
clean_all_normalized(check);
i = trivial_expression_p(check);
switch(i){
case 1:
{
user_log("\n Bound violation on upper bound of array %s\n",entity_local_name(e));
return make_true_array_dimension_bound_test(e,0,false);
}
case -1:
break;
case 0:
{
number_of_added_checks++;
temp = make_array_dimension_bound_test(e,0,false,check);
retour = add_array_dimension_bound_test(retour,temp);
break;
}
}
/*if the ith subscript index is also an array reference, we must check this reference*/
for (i=1;i <= (int) gen_length(inds);i++)
{
expression ith = find_ith_argument(inds,i);
number_of_bound_checks++;
temp = bottom_up_abc_expression(ith);
retour = add_array_dimension_bound_test(retour,temp);
}
return retour;
}
static array_dimension_bound_test bottom_up_abc_reference(reference r)
{
array_dimension_bound_test retour = array_dimension_bound_test_undefined;
ifdebug(3)
{
pips_debug(3, "\n Array bound check for reference:");
print_reference(r);
}
if (array_reference_p(r))
{
entity e = reference_variable(r);
if (array_need_bound_check_p(e))
{
/* In practice, bound violations often occur with arrays in a common, with the reason that
the allocated size of the common is not violated :-)))
So this property helps dealing with this kind of bad programming practice*/
if (variable_in_common_p(e) && get_bool_property("ARRAY_BOUND_CHECKING_WITH_ALLOCATION_SIZE"))
retour = abc_with_allocation_size(r);
else
{
list arraydims = variable_dimensions(type_variable(entity_type(e)));
list arrayinds = reference_indices(r);
dimension dimi = dimension_undefined;
expression ith, check = expression_undefined;
int i,k;
array_dimension_bound_test temp = array_dimension_bound_test_undefined;
for (i=1;i <= (int) gen_length(arrayinds);i++)
{
number_of_bound_checks++;
dimi = find_ith_dimension(arraydims,i);
ith = find_ith_argument(arrayinds,i);
check = lt_expression(copy_expression(ith),dimension_lower(copy_dimension(dimi)));
/* Call the function trivial_expression_p(check)
* + If the check expression is always TRUE:
* there is certainly bound violation, we return retour
* immediately: retour = ({e},{i},{bound},{.TRUE.})
* + If the check expression is always false, we don't have to add check to retour.
* + Otherwise, we have to add check to retour.*/
ifdebug(3)
{
pips_debug(3, "\n Lower bound check expression:");
print_expression(check);
}
clean_all_normalized(check);
k = trivial_expression_p(check);
switch(k){
case 1:
{
user_log("\n Bound violation on lower bound of array %s\n",entity_local_name(e));
return make_true_array_dimension_bound_test(e,i,true);
}
case -1:
break;
case 0:
{
number_of_added_checks++;
temp = make_array_dimension_bound_test(e,i,true,check);
retour = add_array_dimension_bound_test(retour,temp);
break;
}
}
/* If the dimension is unbounded , for example T(*), we cannot check the upper bound*/
if (!unbounded_dimension_p(dimi))
{
check = gt_expression(copy_expression(ith),dimension_upper(copy_dimension(dimi)));
ifdebug(3)
{
pips_debug(3, "\n Upper bound check expression:");
print_expression(check);
}
clean_all_normalized(check);
k = trivial_expression_p(check);
switch(k){
case 1:
{
user_log("\n Bound violation on upper bound of array %s\n",entity_local_name(e));
return make_true_array_dimension_bound_test(e,i,false);
}
case -1:
break;
case 0:
{
number_of_added_checks++;
temp = make_array_dimension_bound_test(e,i,false,check);
retour = add_array_dimension_bound_test(retour,temp);
break;
}
}
}
/*if the ith subscript index is also an array reference, we must check this reference*/
temp = bottom_up_abc_expression(ith);
retour = add_array_dimension_bound_test(retour,temp);
}
}
}
}
return retour;
}
static array_dimension_bound_test
bottom_up_abc_base_reference_implied_do(reference re,
expression ind,
range ran)
{
array_dimension_bound_test retour = array_dimension_bound_test_undefined;
entity ent = reference_variable(re);
list arrayinds = reference_indices(re);
list listdims = variable_dimensions(type_variable(entity_type(ent)));
expression low = range_lower(ran);
expression up = range_upper(ran);
expression ith = expression_undefined;
int i;
for (i=1;i <= (int) gen_length(arrayinds);i++)
{
number_of_bound_checks++;
ith = find_ith_argument(arrayinds,i);
if (expression_equal_p(ith,ind))
{
int k;
dimension dimi = find_ith_dimension(listdims,i);
array_dimension_bound_test temp = array_dimension_bound_test_undefined;
expression check = expression_undefined;
// make expression e1.LT.lower
check = lt_expression(low,dimension_lower(copy_dimension(dimi)));
ifdebug(3)
{
pips_debug(3,"\n Lower bound check expression:");
print_expression(check);
}
clean_all_normalized(check);
k = trivial_expression_p(check);
switch(k){
case 1:
{
user_log("\n Bound violation on lower bound of array %s\n",entity_local_name(ent));
return make_true_array_dimension_bound_test(ent,i,true);
}
case -1:
break;
case 0:
{
number_of_added_checks++;
temp = make_array_dimension_bound_test(ent,i,true,check);
retour = add_array_dimension_bound_test(retour,temp);
break;
}
}
if (!unbounded_dimension_p(dimi))
{
check = gt_expression(up,dimension_upper(copy_dimension(dimi)));
ifdebug(3)
{
pips_debug(3, "Upper bound check expression:");
print_expression(check);
}
clean_all_normalized(check);
k = trivial_expression_p(check);
switch(k){
case 1:
{
user_log("\n Bound violation on upper bound of array %s\n",entity_local_name(ent));
return make_true_array_dimension_bound_test(ent,i,false);
}
case -1:
break;
case 0:
{
number_of_added_checks++;
temp = make_array_dimension_bound_test(ent,i,false,check);
retour = add_array_dimension_bound_test(retour,temp);
break;
}
}
}
}
}
return retour;
}
static array_dimension_bound_test
bottom_up_abc_reference_implied_do(expression e, Index_range ir)
{
array_dimension_bound_test retour = array_dimension_bound_test_undefined;
syntax s = expression_syntax(e);
tag t = syntax_tag(s);
switch (t){
case is_syntax_range:
break;
case is_syntax_call:
break;
case is_syntax_reference:
{
/* Treat array reference */
reference re = syntax_reference(s);
if (array_reference_p(re))
{
entity ent = reference_variable(re);
if (array_need_bound_check_p(ent))
{
/* For example, we have array reference A(I,J)
with two indexes I and J and ranges 1:20 and 1:10, respectively*/
list list_index = ir.ind, list_range = ir.ran;
while (!ENDP(list_index))
{
expression ind = EXPRESSION(CAR(list_index));
range ran = RANGE(CAR(list_range));
array_dimension_bound_test temp = array_dimension_bound_test_undefined;
temp = bottom_up_abc_base_reference_implied_do(re,ind,ran);
retour = add_array_dimension_bound_test(retour,temp);
list_index = CDR(list_index);
list_range = CDR(list_range);
}
}
}
break;
}
}
return retour;
}
static array_dimension_bound_test bottom_up_abc_expression_implied_do(expression e, Index_range ir);
static array_dimension_bound_test
bottom_up_abc_expression_implied_do(expression e, Index_range ir)
{
/* An implied-DO is a call to an intrinsic function named IMPLIED-DO;
* the first argument is the implied-DO variable (loop index)
* the second one is a range
* the remaining arguments are expressions to be written or references
* to be read or another implied-DO
* (dlist, i=e1,e2,e3)
*
* We treated only the case where e3=1 (or omitted), the bound tests is
* IF (e1.LT.lower.OR.e2.GT.upper) STOP Bound violation
* for statement READ *,(A(I),I=e1,e2)
*
* An Implied-DO can be occurred in a DATA statement or an input/output
* statement. As DATA statement is in the declaration, not executable,
* we do not need to pay attention to it.*/
array_dimension_bound_test retour = array_dimension_bound_test_undefined;
list args = call_arguments(syntax_call(expression_syntax(e)));
expression arg2 = EXPRESSION(CAR(CDR(args))); /* range e1,e2,e3*/
range r = syntax_range(expression_syntax(arg2));
expression one_exp = int_to_expression(1);
if (same_expression_p(range_increment(r),one_exp))
{
/* The increment is 1 */
expression arg1 = EXPRESSION(CAR(args)); /* Implied-DO index*/
args = CDR(CDR(args));
MAP(EXPRESSION, expr,
{
array_dimension_bound_test temp = array_dimension_bound_test_undefined;
Index_range new_ir;
new_ir.ind = gen_nconc(CONS(EXPRESSION,arg1,NIL),ir.ind);
new_ir.ran = gen_nconc(CONS(RANGE,r,NIL),ir.ran);
if (expression_implied_do_p(expr))
temp = bottom_up_abc_expression_implied_do(expr,new_ir);
else
/* normal expression */
temp = bottom_up_abc_reference_implied_do(expr,new_ir);
retour = add_array_dimension_bound_test(retour,temp);
},args);
}
else
{
/* increment <> 1, we have to put a dynamic test function such as :
* WRITE *, A(checkA(I), e1,e2,e3)
* where checkA is a function that does the range checking for array A.
* because it is not integer, the bound tests :
*
* if (e3.GT.0).AND.(e1.LT.lower.OR.e1+e3x[e2-e1/e3].GT.upper)
* STOP Bound violation
* if (e3.LT.0).AND.(e1.GT.upper.OR.e1+e3x[e1-e2/e3].LT.lower)
* STOP Bound violation */
}
return retour;
}
static array_dimension_bound_test bottom_up_abc_expression (expression e)
{
/* the syntax of an expression can be a reference, a range or a call*/
array_dimension_bound_test retour = array_dimension_bound_test_undefined;
if (expression_implied_do_p(e))
retour = bottom_up_abc_expression_implied_do(e,Index_range_undefined);
else
{
syntax s = expression_syntax(e);
tag t = syntax_tag(s);
switch (t){
case is_syntax_call:
{
retour = bottom_up_abc_call(syntax_call(s));
break;
}
case is_syntax_reference:
{
retour = bottom_up_abc_reference(syntax_reference(s));
break;
}
case is_syntax_range:
/* There is nothing to check here*/
break;
}
}
return retour;
}
static bool expression_in_array_subscript(expression e, list args)
{
MAP(EXPRESSION, exp,
{
syntax s = expression_syntax(exp);
tag t = syntax_tag(s);
switch (t){
case is_syntax_call:
{
/* We have to consider only the case of Implied DO
* if e is in the lower or upper bound of implied DO's range or not */
if (expression_implied_do_p(exp))
{
call c = syntax_call(s);
list cargs = call_arguments(c);
expression arg2 = EXPRESSION(CAR(CDR(cargs))); /* range e1,e2,e3*/
range r = syntax_range(expression_syntax(arg2));
expression e1 = range_lower(r);
expression e2 = range_upper(r);
expression e3 = range_increment(r);
ifdebug(3)
{
fprintf(stderr,"\n Implied DO expression:\n");
print_expression(exp);
}
if (same_expression_p(e,e1)||same_expression_p(e,e2)||same_expression_p(e,e3))
return true;
}
break;
}
case is_syntax_reference:
{
reference ref = syntax_reference(s);
if (array_reference_p(ref))
{
list arrayinds = reference_indices(ref);
if (same_expression_in_list_p(e,arrayinds))
return true;
}
break;
}
case is_syntax_range:
break;
}
},args);
return false;
}
static bool read_statement_with_write_effect_on_array_subscript(call c)
{
entity func = call_function(c);
if (strcmp(entity_local_name(func),READ_FUNCTION_NAME)==0)
{
list args = call_arguments(c);
while (!ENDP(args))
{
expression exp = EXPRESSION(CAR(args));
args = CDR(args);
if (expression_in_array_subscript(exp,args))
return true;
}
}
return false;
}
static array_dimension_bound_test bottom_up_abc_call(call cal)
{
list args = call_arguments(cal);
array_dimension_bound_test retour = array_dimension_bound_test_undefined;
/* We must check a special case:
* The call is a READ statement with array reference whose index is
* read in the same statement.
*
* Example : READ *,N, A(N) or READ *,N,(A(I),I=1,N) (implied DO expression)
*
* In these case, we have to put a dynamic check function such as :
* READ *,N,(A(abc_check(I,1,10)),I=1,N),M
* where abc_check is a function that does the range checking by using its parameters */
if (read_statement_with_write_effect_on_array_subscript(cal))
user_log("\n Warning : READ statement with write effect on array subscript. \n This case has not been treated yet :-( \n");
else
MAP(EXPRESSION, e,
{
array_dimension_bound_test temp = bottom_up_abc_expression(e);
retour = add_array_dimension_bound_test(retour,temp);
},args);
return retour;
}
string print_variables(expression e)
{
syntax s = expression_syntax(e);
tag t = syntax_tag(s);
string retour = "";
switch (t){
case is_syntax_range:
break;
case is_syntax_call:
{
call c = syntax_call(s);
list args = call_arguments(c);
MAP(EXPRESSION,exp,
{
retour = strdup(concatenate(retour,print_variables(exp),NULL));
},args);
break;
}
case is_syntax_reference:
{
reference ref = syntax_reference(s);
retour = strdup(concatenate(retour,", \', ",reference_to_string(ref)," =\',",
reference_to_string(ref),NULL));
break;
}
default:
{
pips_internal_error("Unexpected expression tag %d ", t );
break;
}
}
return retour;
}
statement emit_message_and_stop(string stop_message)
{
statement smt = statement_undefined;
if(fortran_module_p(get_current_module_entity())) {
//return make_stop_statement(message);
smt = make_stop_statement(stop_message);
}
else {
/* Must be the C version */
smt = make_exit_statement(1, stop_message);
}
return smt;
}
static statement make_bottom_up_abc_tests(array_dimension_bound_test adt)
{
list la = adt.arr,ld = adt.dim,lb = adt.bou,le = adt.exp;
statement retour = statement_undefined;
string string_delimiter =
fortran_module_p(get_current_module_entity())?
"\'" : "\"";
while (!ENDP(la))
{
entity a = ENTITY(CAR(la));
int d = INT(CAR(ld));
bool b = BOOL(CAR(lb));
expression e = EXPRESSION(CAR(le));
string stop_message =
strdup(concatenate(string_delimiter,
"Bound violation: array \"",
entity_user_name(a),"\", ",
int_to_dimension(d),bool_to_bound(b),
string_delimiter, NULL));
string print_message =
strdup(concatenate(string_delimiter,
"BV array \"",entity_user_name(a),"\", ",
int_to_dimension(d),bool_to_bound(b),"with ",
expression_to_string(e),
string_delimiter,
print_variables(e), NULL));
statement smt = statement_undefined;
if (true_expression_p(e))
{
number_of_bound_violations++;
/* There is a bound violation, we can return a stop statement immediately,
but for debugging purpose, it is better to display all bound violations */
if (get_bool_property("PROGRAM_VERIFICATION_WITH_PRINT_MESSAGE"))
//return make_print_statement(message);
smt = make_any_print_statement(print_message);
else {
smt = emit_message_and_stop(stop_message);
}
}
else
{
if (get_bool_property("PROGRAM_VERIFICATION_WITH_PRINT_MESSAGE"))
smt = test_to_statement(make_test(e, make_print_statement(print_message),
make_block_statement(NIL)));
else
smt = test_to_statement(make_test(e, emit_message_and_stop(stop_message),
make_block_statement(NIL)));
}
if (statement_undefined_p(retour))
retour = copy_statement(smt);
else
// always structured case
insert_statement(retour,copy_statement(smt),false);
la = CDR(la);
ld = CDR(ld);
lb = CDR(lb);
le = CDR(le);
}
ifdebug(2)
{
pips_debug(2,"\n With array bound checks:");
print_statement(retour);
}
return retour;
}
static void bottom_up_abc_insert_before_statement(statement s, statement s1,
bottom_up_abc_context_p context)
{
/* If s is in an unstructured instruction, we must pay attention
when inserting s1 before s. */
if (bound_persistant_statement_to_control_p(context->map, s))
{
/* take the control that has s as its statement */
control c = apply_persistant_statement_to_control(context->map, s);
if (stack_size(context->uns)>0)
{
/* take the unstructured correspond to the control c */
unstructured u = (unstructured) stack_head(context->uns);
control newc;
ifdebug(5)
{
pips_debug(5,"Unstructured case: \n");
print_statement(s);
}
/* for a consistent unstructured, a test must have 2 successors,
so if s1 is a test, we transform it into sequence in order
to avoid this constraint.
Then we create a new control for it, with the predecessors
are those of c and the only one successor is c.
The new predecessors of c are only the new control*/
if (statement_test_p(s1))
{
list seq = CONS(STATEMENT,s1,NIL);
statement s2=instruction_to_statement(make_instruction(is_instruction_sequence,
make_sequence(seq)));
ifdebug(5)
{
pips_debug(5, "Unstructured case, insert a test:\n");
print_statement(s1);
print_statement(s2);
}
newc = make_control(s2, control_predecessors(c), CONS(CONTROL, c, NIL));
}
else
newc = make_control(s1, control_predecessors(c), CONS(CONTROL, c, NIL));
// replace c by newc as successor of each predecessor of c
MAP(CONTROL, co,
{
MAPL(lc,
{
if (CONTROL(CAR(lc))==c) CONTROL_(CAR(lc)) = newc;
}, control_successors(co));
},control_predecessors(c));
control_predecessors(c) = CONS(CONTROL,newc,NIL);
/* if c is the entry node of the correspond unstructured u,
the newc will become the new entry node of u */
if (unstructured_entry(u)==c)
unstructured_entry(u) = newc;
}
else
// there is no unstructured (?)
insert_statement(s,s1,true);
}
else
// structured case
insert_statement(s,s1,true);
}
/* forward declaration */
static statement cstr_args_check(statement);
static void bottom_up_abc_statement_rwt(
statement s,
bottom_up_abc_context_p context)
{
instruction i = statement_instruction(s);
tag t = instruction_tag(i);
statement stmt2;
ifdebug(2)
{
pips_debug(2, "\n Current statement");
print_statement(s);
}
switch(t)
{
case is_instruction_call:
{
call cal = instruction_call(i);
array_dimension_bound_test adt;
if ((stmt2 = cstr_args_check(s)) != statement_undefined) {
printf("Insertion d'un statement ---->\n");
bottom_up_abc_insert_before_statement(s, stmt2, context);
}
adt = bottom_up_abc_call(cal);
if (!array_dimension_bound_test_undefined_p(adt))
{
statement seq = make_bottom_up_abc_tests(adt);
bottom_up_abc_insert_before_statement(s,seq,context);
}
break;
}
case is_instruction_whileloop:
{
whileloop wl = instruction_whileloop(i);
// array bound check of while loop condition
expression e1 = whileloop_condition(wl);
array_dimension_bound_test adt = bottom_up_abc_expression(e1);
if (!array_dimension_bound_test_undefined_p(adt))
{
statement seq = make_bottom_up_abc_tests(adt);
bottom_up_abc_insert_before_statement(s,seq,context);
}
break;
}
case is_instruction_test:
{
test it = instruction_test(i);
// array bound check of the test condition
expression e1 = test_condition(it);
array_dimension_bound_test adt = bottom_up_abc_expression(e1);
if (!array_dimension_bound_test_undefined_p(adt))
{
statement seq = make_bottom_up_abc_tests(adt);
bottom_up_abc_insert_before_statement(s,seq,context);
}
break;
}
case is_instruction_sequence:
case is_instruction_loop:
// suppose that there are not array references in loop's range in norm
case is_instruction_forloop:
// suppose that there are not array references in loop's range in norm
case is_instruction_unstructured:
/* because we use gen_recurse with statement domain,
* we don't have to check unstructured instruction here*/
break;
default:
pips_internal_error("Unexpected instruction tag %d ", t );
break;
}
}
static bool store_mapping(control c, bottom_up_abc_context_p context)
{
extend_persistant_statement_to_control(context->map,
control_statement(c), c);
return true;
}
static bool push_uns(unstructured u, bottom_up_abc_context_p context)
{
stack_push((char *) u, context->uns);
return true;
}
static void pop_uns(unstructured u, bottom_up_abc_context_p context)
{
pips_assert("true", u==u && context==context);
stack_pop(context->uns);
}
static void bottom_up_abc_statement(statement module_statement)
{
bottom_up_abc_context_t context;
context.map = make_persistant_statement_to_control();
context.uns = stack_make(unstructured_domain,0,0);
gen_context_multi_recurse(module_statement, &context,
unstructured_domain, push_uns, pop_uns,
control_domain, store_mapping, gen_null,
statement_domain, gen_true,bottom_up_abc_statement_rwt,
NULL);
free_persistant_statement_to_control(context.map);
stack_free(&context.uns);
}
bool array_bound_check_bottom_up(const char* module_name)
{
statement module_statement;
set_current_module_entity(local_name_to_top_level_entity(module_name));
/* Begin the dynamic array bound checking phase.
* Get the code from dbm (true resource) */
module_statement= (statement) db_get_memory_resource(DBR_CODE, module_name, true);
set_current_module_statement(module_statement);
set_ordering_to_statement(module_statement);
debug_on("ARRAY_BOUND_CHECK_BOTTOM_UP_DEBUG_LEVEL");
ifdebug(1)
{
debug(1, "Array bound check","Begin for %s\n", module_name);
pips_assert("Statement is consistent ...", statement_consistent_p(module_statement));
}
initialize_bottom_up_abc_statistics();
bottom_up_abc_statement(module_statement);
display_bottom_up_abc_statistics();
/* Reorder the module, because the bound checks have been added */
module_reorder(module_statement);
ifdebug(1)
{
pips_assert("Statement is consistent ...", statement_consistent_p(module_statement));
debug(1, "array bound check","End for %s\n", module_name);
}
debug_off();
DB_PUT_MEMORY_RESOURCE(DBR_CODE,module_name,module_statement);
reset_ordering_to_statement();
reset_current_module_statement();
reset_current_module_entity();
return true;
}
/*
* Insert checks for C string manipulation functions (str*).
*/
#define cf_ge_expression(e1, e2) \
( 1 ? binary_intrinsic_expression(">=", e1, e2) : ge_expression(e1, e2) )
#define cf_gt_expression(e1, e2) \
( 1 ? binary_intrinsic_expression(">", e1, e2) : gt_expression(e1, e2) )
#define cf_lt_expression(e1, e2) \
( 1 ? binary_intrinsic_expression("<", e1, e2) : lt_expression(e1, e2) )
#define cf_and_expression(e1, e2) \
( 1 ? binary_intrinsic_expression("&&", e1, e2) : and_expression(e1, e2) )
#define cf_or_expression(e1, e2) \
( 1 ? binary_intrinsic_expression("||", e1, e2) : or_expression(e1, e2) )
static expression
make_bin_expression(string name, expression e1, expression e2)
{
entity add_ent = gen_find_entity(name);
return make_call_expression(add_ent,
CONS(EXPRESSION, e1, CONS(EXPRESSION, e2, NIL)));
}
#define make_add_expression(e1, e2) make_bin_expression("TOP-LEVEL:+", e1, e2)
#define make_sub_expression(e1, e2) make_bin_expression("TOP-LEVEL:-", e1, e2)
#define make_mul_expression(e1, e2) make_bin_expression("TOP-LEVEL:*", e1, e2)
static expression
make_strlen_expression(expression arg)
{
entity strlen_ent;
strlen_ent = FindOrCreateTopLevelEntity("strlen");
return make_call_expression(strlen_ent, CONS(EXPRESSION, arg, NIL));
}
static statement
make_c_stop_statement(int abort_program)
{
pips_assert("true", abort_program==abort_program);
/*
* XXX 'entity_intrinsic' not verified ...
* Pourtant exit() et abort() sont d�clar�s ds bootstrap.c
*/
#if 0
list l = NIL;
string stop_func;
if (abort_program)
stop_func = "TOP-LEVEL:abort";
else
stop_func = "TOP-LEVEL:exit";
l = CONS(STATEMENT, make_call_statement(stop_func,
CONS(EXPRESSION, int_to_expression(1), NIL),
entity_undefined, ""),
l);
/*
if (get_bool_property("PROGRAM_VERIFICATION_WITH_PRINT_MESSAGE")) {
l = CONS(STATEMENT, make_call_statement("TOP-LEVEL:printf",
CONS(EXPRESSION, string_to_expression(), NIL)
entity_undefined, ""),
l);
}
*/
return make_block_statement(l);
#endif
return emit_message_and_stop("Buffer overflow!");
}
/*
* entity_constant_string_size:
*
* If the given entity is representing a constant string, this
* function will return it's length as a positive integer, else
* -1 will be returned.
*/
static int
entity_constant_string_size(entity e)
{
basic b;
type t, result;
value v;
constant c;
t = entity_type(e);
if (type_functional_p(t)
&& type_variable_p((result = functional_result(type_functional(t))))
&& basic_string_p((b = variable_basic(type_variable(result))))
&& value_constant_p((v = basic_string(b)))
&& constant_int_p((c = value_constant(v))))
return constant_int(c);
return -1;
}
/*
* entity_size_uname:
*
* Return a string usable as a unique global variable name for
* the given entity.
*/
static string
entity_size_uname(entity e)
{
static const char prefix []= "PIPS_size_";
string name = entity_name(e);
string uname;
int i, len = strlen(name);
if ((uname = malloc(len + 1 + sizeof(prefix))) == NULL) {
perror("malloc");
exit(1);
}
sprintf(uname, "%s%s",prefix, name);
len = strlen(uname);
for (i = 0; i < len; i++) {
if (uname[i] == ':' || uname[i] == '-') {
uname[i] = '_';
}
}
return uname;
}
/*
* expression_try_find_size:
*
* Try to find the storage size available for the given expression.
*/
static expression
expression_try_find_size(expression expr)
{
syntax syn = expression_syntax(expr);
/*
* Case of a reference.
*
* Try to find the size of the corresponding buffer.
*/
if (expression_reference_p(expr)) {
reference ref = syntax_reference(syn);
entity e = reference_variable(ref);
int s;
if (type_variable_p(entity_type(e))) {
variable var = type_variable(entity_type(e));
entity size_holder;
string e_uname;
list dims = variable_dimensions(var);
list acc = reference_indices(ref);
while (1) {
if (ENDP(acc) && !ENDP(dims)) {
/*
* We found the upper bound of the given
* expression, we need to add one to get the
* size of the buffer
*/
expression upper_bound =
dimension_upper(DIMENSION(CAR(dims)));
if (expression_constant_p(upper_bound)) {
return int_to_expression(1
+ expression_to_int(upper_bound));
} else
return make_add_expression(upper_bound,
int_to_expression(1));
} else if (!ENDP(acc) && !ENDP(dims)) {
acc = CDR(acc);
dims = CDR(dims);
}
else
break;
}
/*
* The memory pointed by the variable was probably
* allocated by malloc() (or a similar function).
*/
e_uname = entity_size_uname(e);
size_holder = FindOrCreateEntity("main",e_uname);
free(e_uname);
if (size_holder == entity_undefined)
return expression_undefined;
else
return make_entity_expression(size_holder, NIL);
}
/* The expression is a string constant */
else if ((s = entity_constant_string_size(e)) >= 0)
return int_to_expression(s);
}
/*
* The expression is a function call.
*
* Only two forms are acceptable here: base + x, or base - y.
*/
else if (expression_call_p(expr)) {
call cal = syntax_call(syn);
entity fun = call_function(cal);
string fun_name = entity_name(fun);
list args = call_arguments(cal);
expression base, base_size, x;
if (strcmp(fun_name, "TOP-LEVEL:+C") == 0) {
base = EXPRESSION(CAR(args));
x = EXPRESSION(CAR(CDR(args)));
base_size = expression_try_find_size(base);
if (base_size == expression_undefined)
return expression_undefined;
else
return make_sub_expression(base_size, x);
} else // XXX traiter le cas de fonctions imbriqu�es !
return expression_undefined;
}
return expression_undefined;
}
/*
* expression_try_find_string_size:
*
* Try to find the size of the string pointed by the given
* expression. The function will return an expression holding
* the length of the string in the case of a constant string or
* a call to the strlen() function in the other cases.
*
* The size returned does not include the trailing NUL
* character.
*/
static expression
expression_try_find_string_size(expression expr)
{
entity e;
int s;
e = reference_variable(expression_reference(expr));
if (e != entity_undefined && (s = entity_constant_string_size(e)) >= 0)
return int_to_expression(s);
else
return make_strlen_expression(expr);
}
static expression
array_indices_check(expression expr)
{
reference ref;
entity e;
variable var;
list dims, acc;
expression check = expression_undefined, checktmp, indice;
if (!expression_reference_p(expr))
return expression_undefined;
else {
ref = syntax_reference(expression_syntax(expr));
e = reference_variable(ref);
if (!type_variable_p(entity_type(e)))
return expression_undefined;
}
var = type_variable(entity_type(e));
dims = variable_dimensions(var);
acc = reference_indices(ref);
while (1) {
if (!ENDP(acc) && !ENDP(dims)) {
/*
* We found the upper bound of the given
* expression, we need to add one to get the
* size of the buffer
*/
expression upper_bound =
dimension_upper(DIMENSION(CAR(dims)));
if (expression_constant_p(upper_bound)) {
upper_bound = int_to_expression(1
+ expression_to_int(upper_bound));
} else
upper_bound = make_add_expression(upper_bound,
int_to_expression(1));
/*
* Create the check for the current dimension (checktmp):
* indice < upper_bound
* Add it to the global check:
* check := check && checktmp
*/
indice = EXPRESSION(CAR(acc));
checktmp = cf_lt_expression(indice, upper_bound);
if (check == expression_undefined)
check = checktmp;
else
check = cf_and_expression(check, checktmp);
acc = CDR(acc);
dims = CDR(dims);
} else
break;
}
return check;
}
static expression
array_check_add(expression array_expr, expression expr)
{
expression check;
if ((check = array_indices_check(array_expr)) == expression_undefined)
return expr;
else
return cf_and_expression(check, expr);
}
#define CHECK_NARGS(n) if (nargs != (n)) return expression_undefined
/*
* Check for memcpy(dst, src, n):
*
* n > size(src) || n > size(dst)
*/
static expression
memcpy_check_expression(expression args[], int nargs)
{
expression arg0_size_expr, arg1_size_expr;
CHECK_NARGS(3);
arg0_size_expr = expression_try_find_size(args[0]);
arg1_size_expr = expression_try_find_size(args[1]);
if (arg0_size_expr == expression_undefined
|| arg1_size_expr == expression_undefined)
return expression_undefined;
return cf_or_expression(
cf_gt_expression(args[2], arg1_size_expr),
cf_gt_expression(args[2], arg0_size_expr));
}
/*
* Check for bcopy(src, dst, n):
*
* n > size(src) || n > size(dst) => same as memcpy()
*/
static expression
bcopy_check_expression(expression args[], int nargs)
{
CHECK_NARGS(3);
// The arguments order (for the two first) doesn't matter
return memcpy_check_expression(args, nargs);
}
/*
* Check for bcmp(b1, b2, n):
*
* n > size(b1) || n > size(b2) => same as memcpy()
*/
static expression
bcmp_check_expression(expression args[], int nargs)
{
CHECK_NARGS(3);
return memcpy_check_expression(args, nargs);
}
/*
* Check for bzero(dst, n):
*
* n > size(dst)
*/
static expression
bzero_check_expression(expression args[], int nargs)
{
expression arg0_size_expr;
CHECK_NARGS(2);
arg0_size_expr = expression_try_find_size(args[0]);
if (arg0_size_expr == expression_undefined)
return expression_undefined;
return cf_gt_expression(args[1], arg0_size_expr);
}
/*
* Check for memcmp(b1, b2, n):
*
* n > size(b1) || n > size(b2) => same as memcpy()
*/
static expression
memcmp_check_expression(expression args[], int nargs)
{
CHECK_NARGS(3);
return memcpy_check_expression(args, nargs);
}
/*
* Check for memmove(dst, src, n):
*
* n > size(src) || n > size(dst) || abs(dst - src) < n
* => same as bcopy(src, dst, n)
*/
static expression
memmove_check_expression(expression args[], int nargs)
{
expression tmp;
CHECK_NARGS(3);
/* Convert memmove(dst, src, n) -> bcopy(src, dest, n) */
tmp = args[0];
args[0] = args[1];
args[1] = tmp;
return bcopy_check_expression(args, nargs);
}
/*
* Check for memset(dst, val, n):
*
* n > size(dst) => same as bzero().
*/
static expression
memset_check_expression(expression args[], int nargs)
{
CHECK_NARGS(3);
/* Convert memset(dst, b, n) -> bzero(dst, n) */
args[1] = args[2];
return bzero_check_expression(args, 2);
}
/*
* Check for strcpy(dst, src):
*
* strlen(src) >= size(dst)
*/
static expression
strcpy_check_expression(expression args[], int nargs)
{
//statement smt;
expression arg1_size_expr ;
CHECK_NARGS(2);
arg1_size_expr = expression_try_find_size(args[0]);
if (arg1_size_expr == expression_undefined)
return expression_undefined;
/*
expression arg2_size_expr;
int arg2size;
entity arg2ent;
arg2ent = reference_variable(expression_reference(args[1]));
if ((arg2size = entity_constant_string_size(arg2ent)) >= 0)
arg2_size_expr = int_to_expression(arg2size);
else
arg2_size_expr = make_strlen_expression(args[1]);
*/
return cf_ge_expression(expression_try_find_string_size(args[1]), arg1_size_expr);
}
/*
* Check for strncpy(dst, src, n):
*
* n >= size(dst)
*/
static expression
strncpy_check_expression(expression args[], int nargs)
{
expression arg1_size_expr;
CHECK_NARGS(3);
arg1_size_expr = expression_try_find_size(args[0]);
if (arg1_size_expr == expression_undefined)
return expression_undefined;
return cf_ge_expression(args[2], arg1_size_expr);
}
/*
* Check for strcat(dst, src):
*
* strlen(dst) + strlen(src) >= size(dst)
*/
static expression
strcat_check_expression(expression args[], int nargs)
{
expression dst_size;
CHECK_NARGS(2);
dst_size = expression_try_find_size(args[0]);
if (dst_size == expression_undefined)
return expression_undefined;
return cf_ge_expression(
make_add_expression(expression_try_find_string_size(args[0]),
expression_try_find_string_size(args[1])),
dst_size);
}
/*
* Check for strncat(dst, src, n):
*
* n >= size(dst) - strlen(dst)
*/
static expression
strncat_check_expression(expression args[], int nargs)
{
expression dst_size;
CHECK_NARGS(3);
dst_size = expression_try_find_size(args[0]);
if (dst_size == expression_undefined)
return expression_undefined;
return cf_ge_expression(args[2], make_sub_expression(dst_size,
expression_try_find_string_size(args[0])));
}
/*
* Check for sprintf(dst, fmt, ...):
*
* snprintf(PIPS_tmpbuf, 1, fmt, ...) > size(dst)
*
* (snprintf return the size that would have been written in the
* case of an infinite buffer).
*/
static expression
sprintf_check_expression(expression args[], int nargs)
{
int k;
list snprintf_args = NIL;
expression dst_size=expression_undefined, tmpbuf_expr;
entity snprintf_ent, tmpbuf_ent;
if (nargs < 2)
return expression_undefined;
if ((snprintf_ent = FindEntity(TOP_LEVEL_MODULE_NAME,"snprintf"))
== entity_undefined)
return expression_undefined;
if ((tmpbuf_ent = FindEntity("main","PIPS_tmpbuf")) == entity_undefined)
// XXX module "main" non correct
tmpbuf_ent = make_scalar_entity("PIPS_tmpbuf", "main",
make_basic_int(1));
// XXX Il faut &PIPS_tmpbuf
tmpbuf_expr = make_entity_expression(tmpbuf_ent, NIL);
for (k = nargs - 1; k >= 2; k--)
snprintf_args = CONS(EXPRESSION, args[k], snprintf_args);
snprintf_args = CONS(EXPRESSION, tmpbuf_expr,
CONS(EXPRESSION, int_to_expression(1), snprintf_args));
return cf_gt_expression(make_call_expression(snprintf_ent, snprintf_args),
dst_size);
}
/*
* Check for snprintf(dst, n, fmt, ...):
*
* n >= size(dst) => same as strncpy(dst, src, n)
*/
static expression
snprintf_check_expression(expression args[], int nargs)
{
if (nargs < 3)
return expression_undefined;
args[2] = args[1];
return strncpy_check_expression(args, 3);
}
#undef CHECK_NARGS
static struct checkfn {
string function;
expression (*check_statement)(expression *, int);
} checkfns[] = {
{ "bcopy", bcopy_check_expression },
{ "bcmp", bcmp_check_expression },
{ "bzero", bzero_check_expression },
{ "memcmp", memcmp_check_expression },
{ "memcpy", memcpy_check_expression },
{ "memmove", memmove_check_expression },
{ "memset", memset_check_expression },
{ "strcpy", strcpy_check_expression },
{ "strncpy", strncpy_check_expression },
{ "strcat", strcat_check_expression },
{ "strncat", strncat_check_expression },
{ "sprintf", sprintf_check_expression },
{ "snprintf", snprintf_check_expression },
{ NULL, NULL }
};
/*
* Add instrumentation to memory allocation instructions:
*
* m = malloc(n); => m = malloc(n);
* PIPS_size_m = n;
*
* The relevant functions are:
* malloc(), calloc(), memalign(), realloc()
*/
static statement
alloc_instrumentation(expression args[], int nargs)
{
expression size_expr, size_holder;
entity ptr, size_holder_ent;
string func_name, size_holder_name;
call func_call;
list func_args;
reference ref;
int func_nargs;
if (nargs != 2) {
return statement_undefined;
}
if (!expression_reference_p(args[0]) || !expression_call_p(args[1]))
return statement_undefined;
ref = syntax_reference(expression_syntax(args[0]));
ptr = reference_variable(ref);
/*
* Don't try to instrument if the pointer is an array access.
*/
if (reference_indices(ref) != NIL)
return statement_undefined;
func_call = syntax_call(expression_syntax(args[1]));
func_name = entity_name(call_function(func_call));
func_args = call_arguments(func_call);
func_nargs = gen_length(func_args);
if (strcmp(func_name, "TOP-LEVEL:malloc") == 0) {
if (func_nargs != 1)
return statement_undefined;
size_expr = EXPRESSION(CAR(func_args));
} else if (strcmp(func_name, "TOP-LEVEL:realloc") == 0
|| strcmp(func_name, "TOP-LEVEL:memalign") == 0) {
if (func_nargs != 2)
return statement_undefined;
size_expr = EXPRESSION(CAR(CDR(func_args)));
} else if (strcmp(func_name, "TOP-LEVEL:calloc") == 0) {
if (func_nargs != 2)
return statement_undefined;
size_expr = make_call_expression(entity_intrinsic(MULTIPLY_OPERATOR_NAME),
func_args);
} else
return statement_undefined;
/*
* Create a new variable to hold the size of the allocated
* memory.
*/
size_holder_name = entity_size_uname(ptr);
size_holder_ent = FindEntity("main",
size_holder_name);
if (size_holder_ent == entity_undefined) {
size_holder_ent =
make_scalar_entity(size_holder_name,
// XXX ?? marche pas ...
//STATIC_AREA_LOCAL_NAME, make_basic_int(4));
"main", make_basic_int(4));
}
size_holder = make_entity_expression(size_holder_ent, NIL);
return make_assign_statement(size_holder, size_expr);
}
static statement
cstr_args_check(statement s)
{
instruction i = statement_instruction(s);
statement astmt;
expression expr, *argstab;
call cal;
list args;
string func_name;
int nargs = 0, k;
struct checkfn *p;
pips_assert("Statement is a call statmt.",
instruction_tag(i) == is_instruction_call);
cal = instruction_call(i);
func_name = entity_name(call_function(cal));
pips_debug(1, "FONCTION: %s\n", func_name);
/* Convert the arguments list into an array */
args = call_arguments(cal);
nargs = gen_length(args);
argstab = malloc(sizeof(expression) * nargs);
for (k = 0; k < nargs; k++) {
argstab[k] = EXPRESSION(CAR(args));
args = CDR(args);
}
/* Add malloc(), free(), etc. instrumentation */
if (strcmp(func_name, "TOP-LEVEL:=") == 0
&& (astmt = alloc_instrumentation(argstab, nargs)) != statement_undefined) {
free(argstab);
return astmt;
/*
* free(m); => PIPS_size_m = 0;
* free(m);
*/
} else if (strcmp(func_name, "TOP-LEVEL:free") == 0) {
entity arg_ent, size_holder;
string e_uname;
if (!expression_reference_p(argstab[0])) {
free(argstab);
return statement_undefined;
}
else {
arg_ent = reference_variable(syntax_reference(
expression_syntax(argstab[0])));
free(argstab);
if (!type_variable_p(entity_type(arg_ent)))
return statement_undefined;
}
e_uname = entity_size_uname(arg_ent);
size_holder = FindEntity("main", e_uname);
free(e_uname);
if (size_holder == entity_undefined)
return statement_undefined;
return make_assign_statement(make_entity_expression(size_holder, NIL),
int_to_expression(0));
}
if (strncmp(func_name, "TOP-LEVEL:", 10) != 0) {
free(argstab);
return statement_undefined;
}
expr = expression_undefined;
for (p = checkfns; p->function != NULL; p++) {
if (strcmp(p->function, func_name + 10) == 0) {
expr = (p->check_statement)(argstab, nargs);
break;
}
}
if (expr == expression_undefined) {
/* The target languague is unknown: C or Fortran, NL at the
end or not? It will be up to the prettyprinter (FI).
FI+LD 21-Oct-2009 : added NL, apparently needed in Fortran too.
*/
put_a_comment_on_a_statement(s, strdup("CHECK WAS NOT CREATED\n"));
return statement_undefined;
}
/*
* Add checks for array indices when necessary.
*/
for (k = 0; k < nargs; k++)
expr = array_check_add(argstab[k], expr);
free(argstab);
return test_to_statement(make_test(expr,
make_c_stop_statement(0),
make_block_statement(NIL)));
}