utils.c

Go to the documentation of this file.

/*
 
  $Id: utils.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
 
/* Name     : utils.c
 * Package  : paf-util
 * Author   : Alexis Platonoff
 * Date     : july 1993
 *
 * Historic :
 * - 16 jul 93, change in paf_ri, AP
 * - 23 sep 93, remove some functions from paf_ri to placement, AP
 * - 29 sep 93, remove prefixes when they are not needed (adg, plc, ...), AP
 * - 9  nov 93, add merge_sort() and meld(), AP
 * - 9  dec 93, add rational_op_exp(), AP
 * - 21 fev 94, add prototype_var_subst(), AP
 * - 21 fev 94, add vecteur_mult(), AP
 * - 25 fev 94, add prototype_factorize(), modify vecteur_to_polynome(), AP
 * - 11 mar 94, modify polynome_to_sc(), AP
 * - 7  apr 94, add pu_constraints_with_sym_cst_to_matrices() and
 *              pu_matrices_to_constraints_with_sym_cst(), AP
 * - 29 jun 94, add simplify_minmax(), AP
 * -  9 nov 94, modify name : merge_sort() --> general_merge_sort()
 *              because it already exists in C3, AP
 * - 14 nov 94, add find_implicit_equation(), taken from prgm_mapping, AP
 * - 20 dec 94, add functions for the static control map, AP
 * - 19 jan 95, move make_rational_vect() in this file from scheduling and
 *              reindexing packages, AP
 * - 25 sep 95, moved stco_common_loops_of_statements() in this file from
 *              static_controlise/utils.c, AP
 *
 * Documents:
 *
 * Comments : This file contains useful functions used for the computation of
 * paf_ri.
 */
 
/* Ansi includes        */
#include <stdio.h>
#include <string.h>
/* #include <varargs.h> */ /* (not ANSI but SUN:-) */
 
/* Newgen includes      */
#include "genC.h"
 
/* C3 includes          */
#include "boolean.h"
#include "arithmetique.h"
#include "vecteur.h"
#include "contrainte.h"
#include "ray_dte.h"
#include "sommet.h"
#include "sg.h"
#include "sc.h"
#include "polyedre.h"
#include "matrix.h"
 
/* Pips includes        */
#include "linear.h"
#include "ri.h"
#include "ri-util.h"
#include "prettyprint.h"
#include "constants.h"
#include "paf_ri.h"
typedef dfg_arc_label arc_label;
typedef dfg_vertex_label vertex_label;
#include "graph.h"
#include "dg.h"
#include "text.h"
#include "text-util.h"
#include "misc.h"
#include "paf-util.h"
#include "static_controlize.h"
 
// Forward declaration to survive races in the compilation process
statement_mapping get_current_stco_map(void);
 
/* Macro functions      */
#define STRING_FOUR_OPERATION_P(s) ( \
                                    (strcmp(s,PLUS_OPERATOR_NAME) == 0) || \
                                    (strcmp(s,MINUS_OPERATOR_NAME) == 0) || \
                                    (strcmp(s,MULTIPLY_OPERATOR_NAME) == 0) || \
                                    (strcmp(s,DIVIDE_OPERATOR_NAME) == 0) )
#define ENTITY_FOUR_OPERATION_P(s) (ENTITY_PLUS_P(s) || ENTITY_MINUS_P(s) || ENTITY_MULTIPLY_P(s) || ENTITY_DIVIDE_P(s))
 
/* Global variables     */
 
/* Internal variables   */
 
/* Local defines: FI, they are needed earlier in the file because
   newgen is now fully typed statically */
/*
typedef dfg_arc_label arc_label;
typedef dfg_vertex_label vertex_label;
*/
 
/* begin MATRIX functions */
 
/*=========================================================================*/
/*
 * void matrix_scalar_multiply(A, nb)
 *
 * multiplies all elements of matrix A by the number nb.
 *
 */
/* never called
void matrix_scalar_multiply(A, nb)
Pmatrix   A;
int      nb;
{
  int i, j, m, n, d, p;
 
  m = MATRIX_NB_LINES(A);
  n = MATRIX_NB_COLUMNS(A);
  d = MATRIX_DENOMINATOR(A);
  p = pgcd(d, nb);
 
  MATRIX_DENOMINATOR(A) = d/p;
  for (i = 1; i <= m; i++)
    for (j = 1; j <= n; j++)
      MATRIX_ELEM(A,i,j) = (nb/p) * MATRIX_ELEM(A,i,j);
}
*/
 
/*=====================================================================*/
/*
 * void matrix_add(Pmatrix a, Pmatrix b, Pmatrix c)
 *
 * add rational matrix c to rational matrix b and store result
 * in matrix a
 *
 *      a is a (nxm) matrix, b a (nxm) and c a (nxm)
 *
 *      a = b + c ;
 *
 * Algorithm used is directly from definition, and space has to be
 * provided for output matrix a by caller. Matrix a is not necessarily
 * normalized: its denominator may divide all its elements
 * (see matrix_normalize()).
 *
 * Precondition:        n > 0; m > 0;
 * Note: aliasing between a and b or c is supported
 */
/* never called
void pu_matrix_add(a,b,c)
Pmatrix a;
Pmatrix b, c;
{
  int d1, d2, i, j, n, m;
 
  n = MATRIX_NB_LINES(a);
  m = MATRIX_NB_COLUMNS(a);
  pips_assert("matrix_add", (n > 0) && (m > 0));
 
  d1 = MATRIX_DENOMINATOR(b);
  d2 = MATRIX_DENOMINATOR(c);
  if (d1 == d2) {
    for (i = 1; i <= n; i++)
      for (j = 1; j <= m; j++)
        MATRIX_ELEM(a,i,j)=MATRIX_ELEM(b,i,j)+MATRIX_ELEM(c,i,j);
    MATRIX_DENOMINATOR(a) = d1;
  }
  else {
    int lcm = ppcm(d1,d2);
    d1 = lcm/d1;
    d2 = lcm/d2;
    for (i = 1; i <= n; i++)
      for (j = 1; j <= m; j++)
        MATRIX_ELEM(a,i,j)=MATRIX_ELEM(b,i,j)*d1+MATRIX_ELEM(c,i,j)*d2;
    MATRIX_DENOMINATOR(a) = lcm;
  }
}
*/
 
/* ======================================================================= */
/*
 * void constraints_with_sym_cst_to_matrices(Pcontrainte pc, Pbase ib, cb,
 *                                           Pmatrix A B)
 *
 * constructs the matrices "A" and "B" corresponding to the linear
 * constraints "pc", so: A.ib + B1.cb + B2 = 0 <=> pc(ib, cb) = 0
 *
 *      B = ( B1 | B2 ), B2 of dimension (n,1).
 *
 * The basis "ib" gives the variables of the linear system.
 * The basis "cb" gives the symbolic constants of the linear system.
 *
 * WARNING: "cb" should not contain TCST.
 *
 * The matrices "A" and "B" are supposed to have been already allocated in
 * memory, respectively of dimension (n, m1) and (n, m2):
 *
 * n must be the exact number of constraints in "pc".
 * m1 must be the exact number of variables in "ib".
 * m2 must be the exact number of variables in "cb" PLUS ONE (TCST).
 */
/* never called
void pu_constraints_with_sym_cst_to_matrices(pc,ib,cb,A,B)
Pcontrainte pc;
Pbase ib,cb;
Pmatrix A, B;
{
    int i,j;
    Pcontrainte eq;
    Pvecteur pv;
    int n, m1, m2;
 
    for (eq = pc, n = 0; !CONTRAINTE_UNDEFINED_P(eq); eq=eq->succ) { n++; }
    m1 = vect_size(ib);
    m2 = vect_size(cb) + 1;
 
    pips_assert("constraints_with_sym_cst_to_matrices",
                (MATRIX_NB_LINES(A) == n) && (MATRIX_NB_COLUMNS(A) == m1) &&
                (MATRIX_NB_LINES(B) == n) && (MATRIX_NB_COLUMNS(B) == m2));
 
    matrix_nulle(B);
    matrix_nulle(A);
 
    for (eq = pc,i=1; !CONTRAINTE_UNDEFINED_P(eq); eq=eq->succ,i++) {
        for(pv = ib, j=1; pv != NULL; pv = pv->succ, j++){
            MATRIX_ELEM(A,i,j) = vect_coeff(vecteur_var(pv),eq->vecteur);
        }
        for(pv = cb, j=1; pv != NULL; pv = pv->succ, j++){
            MATRIX_ELEM(B,i,j) = vect_coeff(vecteur_var(pv),eq->vecteur);
        }
        MATRIX_ELEM(B,i,m2) = vect_coeff(TCST,eq->vecteur);
    }
}
*/
 
/* ======================================================================= */
/*
 * void matrices_to_constraints_with_sym_cst(Pcontrainte *pc, Pbase ib, cb,
 *                                           Pmatrix A, B)
 *
 * constructs the constraints "pc" corresponding to the matrices "A" and "B"
 * so: pc(ib, cb) = 0 <=> A.ib + B1.cb + B2 = 0
 *
 *      B = ( B1 | B2 ), B2 of dimension (n,1).
 *
 * The basis "ib" gives the variables of the linear system.
 * The basis "cb" gives the symbolic constants of the linear system.
 *
 * Matrices "A" and "B" are supposed to have been already allocated in
 * memory, respectively of dimension (n, m1) and (n, m2).
 *
 * n must be the exact number of constraints in "pc".
 * m1 must be the exact number of variables in "ib".
 * m2 must be the exact number of variables in "cb" PLUS ONE (TCST).
 *
 * "A" and "B" may be rationnal. In such case, we compute the least common
 * multiple of their denominators and multiply the system by it:
 *
 * Note: the formal parameter pc is a "Pcontrainte *". Instead, the resulting
 * Pcontrainte could have been returned as the result of this function.
 */
/* never called
void pu_matrices_to_constraints_with_sym_cst(pc,ib,cb,A,B)
Pcontrainte *pc;
Pbase ib,cb;
Pmatrix A, B;
{
    Pcontrainte newpc = NULL;
    int i, j, coeff, dena, denb, n, m1, m2, lcm;
 
    n  = MATRIX_NB_LINES(A);
    m1 = MATRIX_NB_COLUMNS(A);
    m2 = MATRIX_NB_COLUMNS(B);
 
    pips_assert("constraints_with_sym_cst_to_matrices",
                (MATRIX_NB_LINES(B) == n) &&
                (vect_size(ib) == m1) && ((vect_size(cb) + 1) == m2));
 
    dena = MATRIX_DENOMINATOR(A);
    denb = MATRIX_DENOMINATOR(B);
    lcm = ppcm(dena, denb);
 
    for (i=n;i>=1; i--) {
        bool found = false;
        Pcontrainte cp = contrainte_new();
        Pvecteur vect, pv = NULL;
 
        if ((coeff = MATRIX_ELEM(B,i,m2)) != 0) {
            pv = vect_new(TCST,  (lcm/denb) * coeff);
            found = true;
        }
        for (j=1, vect=ib;j<=m1;vect=vect->succ,j++) {
            if ((coeff = MATRIX_ELEM(A,i,j)) != 0)
                if (found)
                    vect_chg_coeff(&pv, vecteur_var(vect),(lcm/dena) * coeff);
                else {
                    pv = vect_new(vecteur_var(vect), (lcm/dena) * coeff);
                    found = true;
                }
        }
        for (j=1, vect=cb;j<=m2-1;vect=vect->succ,j++) {
            if ((coeff = MATRIX_ELEM(B,i,j)) != 0)
                if (found)
                    vect_chg_coeff(&pv, vecteur_var(vect),(lcm/denb) * coeff);
                else {
                    pv = vect_new(vecteur_var(vect), (lcm/denb) * coeff);
                    found = true;
                }
        }
        cp->vecteur = pv;
        cp->succ = newpc;
        newpc = cp;
    }
    *pc = newpc;
}
*/
 
/*============================================================================*/
/* void pu_matrices_to_contraintes(Pcontrainte *pc, Pbase b, matrice A B,
 *                                 int n m):
 * constructs the constraints "pc" corresponding to the matrices "A" and "B"
 * so: pc(b) <=> Ab + B
 *
 * B represents the constant term.
 *
 * The base "b" gives the variables of the linear system.
 * The matrices "A" and "B" are respectively of dimension (n, m) and (n, 1).
 *
 * "n" will be the exact number of constraints contained in "pc".
 * "m" must be the exact number of variables contained in "b".
 */
void pu_matrices_to_contraintes(pc, b, A, B, n, m)
Pcontrainte *pc;
Pbase b;
matrice A, B;
int n, m;
{
  Pvecteur vect,pv=NULL;
  Pcontrainte cp, newpc= NULL;
  int i,j;
  Value cst,coeff,dena,denb;
  bool trouve ;
 
  dena = DENOMINATOR(A);
  denb = DENOMINATOR(B);
 
  for (i=n;i>=1; i--) {
    trouve = false;
    cp = contrainte_new();
 
    /* build the constant terme if it is null */
    if (value_notzero_p(cst = ACCESS(B,n,i,1))) {
      pv = vect_new(TCST,  value_mult(dena,cst));
      trouve = true;
    }
 
    for (vect = b,j=1;j<=m;vect=vect->succ,j++) {
      if (value_notzero_p(coeff = ACCESS(A,n,i,j))) {
        if (trouve)
          vect_chg_coeff(&pv, vecteur_var(vect),
                         value_mult(denb,coeff));
        else {
          /* build a new vecteur if there is a null constant term */
          pv = vect_new(vecteur_var(vect), value_mult(denb,coeff));
          trouve = true;
        }
      }
    }
    cp->vecteur = pv;
    cp->succ =  newpc;
    newpc = cp;
  }
  *pc = newpc;
}
 
/*============================================================================*/
/* void pu_contraintes_to_matrices(Pcontrainte pc, Pbase b, matrice A B,
 *                                 int n m):
 * constructs the matrices "A" and "B" corresponding to the linear
 * constraints "pc", so: Ab + B <=> pc(b).
 *
 * The base "b" gives the variables of the linear system.
 *
 * The matrices "A" and "B" are supposed to have been already allocated in
 * memory, respectively of dimension (n, m) and (n, 1).
 *
 * "n" must be the exact number of constraints contained in "pc".
 * "m" must be the exact number of variables contained in "b".
 */
void pu_contraintes_to_matrices(pc, b, A, B, n, m)
Pcontrainte pc;
Pbase b;
matrice A, B;
int n;
int m;
{
  int i,j;
  Pvecteur pv;
  Pcontrainte eq;
  matrice_nulle(B,n,1);
  matrice_nulle(A,n,m);
 
  for(eq = pc,i=1; !CONTRAINTE_UNDEFINED_P(eq); eq=eq->succ,i++) {
    for(pv = b, j=1; pv != NULL; pv = pv->succ, j++){
      ACCESS(A,n,i,j) = vect_coeff(vecteur_var(pv),eq->vecteur);
    }
    ACCESS(B,n,i,1) = vect_coeff(0,eq->vecteur);
  }
}
 
 
/* Creation de la matrice A correspondant au systeme lineaire et de la matrice
 * correspondant a la partie constante B
 * Le systeme peut contenir des constantes symboliques. Dans ce cas, la base
 * index_base ne doit contenir que les variables etant des indices de boucles
 * et la base  const_base les constantes symboliques. La matrice B
 * represente toutes les contraintes sur les constantes.
 *
 *  Les parametres de la fonction :
 *
 * Psysteme ps  : systeme lineaire
 *!int  A[]     :  matrice
 *!int  B[]     :  matrice
 * int  n       : nombre de lignes de la matrice
 * int  m       : nombre de colonnes de la matrice
 */
 
void contraintes_with_sym_cst_to_matrices(pc,index_base,const_base,A,B,n,m1,m2)
Pcontrainte pc;
Pbase index_base,const_base;
matrice A;
matrice B;
int n,m1,m2;
{
 
    int i,j;
    Pcontrainte eq;
    Pvecteur pv;
 
    matrice_nulle(B,n,m2);
    matrice_nulle(A,n,m1);
 
    for (eq = pc,i=1; !CONTRAINTE_UNDEFINED_P(eq); eq=eq->succ,i++) {
        for(pv = index_base, j=1; pv != NULL; pv = pv->succ, j++){
            ACCESS(A,n,i,j) = vect_coeff(vecteur_var(pv),eq->vecteur);
        }
        for(pv = const_base, j=1; pv != NULL; pv = pv->succ, j++){
            ACCESS(B,n,i,j) = vect_coeff(vecteur_var(pv),eq->vecteur);
        }
        ACCESS(B,n,i,m2) = vect_coeff(TCST,eq->vecteur);
    }
 
}
 
 
/*
 * Creation d'un systeme lineaire  a partir de deux matrices. La matrice B
 * correspond aux termes constants de chacune des inequations appartenant
 * au systeme. La matrice A correspond a la partie lineaire  des expressions
 * des inequations le  composant.
 *
 * Le systeme peut contenir des constantes symboliques. Dans ce cas, la
 * matrice B represente toutes les contraintes sur les constantes.
 * La base index_base ne  contiendra que les variables etant des indices de
 * boucles et la base  const_base les constantes symboliques.
 *
 * L'ensemble des variables du nouveau systeme est initialise avec une base
 * d'indices que l'on donne en argument. Cette base peut etre vide (NULL).
 *
 * Des nouvelles variables sont creees si necessaire  si il n'y a pas assez
 * de variables dans la base fournie.
 *
 *  La matrice A correspond a la partie non constante du systeme lineaire.
 *  La matrice B correspond a la partie constante.
 *  Le syteme lineaire s'ecrit    A.x <= B.
 *
 *  Les parametres de la fonction :
 *
 *!Psysteme ps  : systeme lineaire
 * int  A[]     : matrice  de dimension (n,m)
 * int  B[]     : matrice  de dimension (n,m2)
 * int  n       : nombre de lignes de la matrice
 * int  m       : nombre de colonnes de la matrice A
 */
void matrices_to_contraintes_with_sym_cst(pc,index_base,const_base,A,B,n,m1,m2)
Pcontrainte *pc;
Pbase index_base,const_base;
matrice A,B;
int n,m1,m2;
{
  Pvecteur vect,pv=NULL;
  Pcontrainte cp,newpc= NULL;
  int i,j;
  Value cst,coeff,dena,denb;
  bool trouve ;
 
  dena = DENOMINATOR(A);
  denb = DENOMINATOR(B);
 
  for (i=n;i>=1; i--) {
    trouve = false;
    cp = contrainte_new();
 
    /* build the constant terme if it exists */
    if (value_notzero_p(cst = ACCESS(B,n,i,m2))) {
      pv = vect_new(TCST,  value_mult(dena,cst));
      trouve = true;
    }
 
    for (vect = base_union(index_base, const_base),j=1;
         j<=m1;vect=vect->succ,j++) {
      if (value_notzero_p(coeff = ACCESS(A,n,i,j))) {
        if (trouve) {
          vect_chg_coeff(&pv, vecteur_var(vect),
                         value_mult(denb, coeff));
        }
        else {
          /* build a new vecteur if there is not constant term */
          pv = vect_new(vecteur_var(vect), value_mult(denb, coeff));
          trouve = true;
        }
      }
    }
 
    for (j=1;j<=m2-1;vect=vect->succ,j++) {
      if (value_notzero_p(coeff = ACCESS(B,n,i,j))) {
        if (trouve) {
          vect_chg_coeff(&pv, vecteur_var(vect),
                         value_mult(denb, coeff));
        }
        else {
          /* build a new vecteur if there is not constant term */
          pv = vect_new(vecteur_var(vect),
                        value_mult(denb, coeff));
          trouve = true;
        }
      }
    }
 
    cp->vecteur = pv;
    cp->succ = newpc;
    newpc = cp;
  }
  *pc = newpc;
}
 
 
/*============================================================================*/
/* void pu_egalites_to_matrice(matrice a, int n m, Pcontrainte leg, Pbase b):
 * constructs the matrix "a" with the equalities contained in "leg". The base
 * "b" gives the column number of each variable. The first element of the
 * matrix is a(1,1), the ACCESS macro makes the conversion to the C array
 * numbering which begins at (0,0).
 *
 * The constant term is not included. The matrix "a" is supposed to have been
 * already allocated in memory.
 *
 * "n" must be the exact number of equalities contained in "leg".
 * "m" must be the exact number of variables contained in "b".
 */
/* never called
void pu_egalites_to_matrice(a, n, m, leg, b)
matrice a;
int n;
int m;
Pcontrainte leg;
Pbase b;
{
  Pvecteur v;
  Pcontrainte peq;
  int ligne = 1;
 
  matrice_nulle(a, n, m);
 
  for(peq = leg; peq != NULL; peq = peq->succ, ligne++) {
    pips_assert("pu_egalites_to_matrice",ligne<=n);
 
    for(v = peq->vecteur; !VECTEUR_UNDEFINED_P(v); v = v->succ) {
      int rank;
      if(vecteur_var(v) != TCST) {
         rank = base_find_variable_rank(base_dup(b), vecteur_var(v),
                                        pu_variable_name);
         pips_assert("pu_egalites_to_matrice", rank <= m);
 
         ACCESS(a, n, ligne, rank) = vecteur_val(v);
      }
    }
  }
}
*/
/* end MATRIX functions */
 
 
 
/*=======================================================================*/
/* vertex  in_dfg_vertex_list( (list) l, (vertex) v )            AL 30/06/93
 * Input  : A list l of vertices.
 *          A vertex v of a dependence graph.
 * Returns vertex_undefined if v is not in list l.
 * Returns v' that has the same statement_ordering than v.
 */
vertex in_dfg_vertex_list(list l, vertex v)
{
        vertex          ver;
        int             in;
 
        pips_debug(9, "doing \n");
 
        in = dfg_vertex_label_statement( (dfg_vertex_label)
                                        vertex_vertex_label(v) );
        for(;!ENDP(l); POP(l)) {
                int prov_i;
                ver = VERTEX(CAR( l ));
                prov_i = dfg_vertex_label_statement( (dfg_vertex_label)
                                        vertex_vertex_label(ver) );
                if ( prov_i == in ) return( ver );
        }
 
        return vertex_undefined;
}
 
/*=======================================================================*/
/* vertex  in_dg_vertex_list( (list) l, (vertex) v )            AL 30/06/93
 * Input  : A list l of vertices.
 *          A vertex v of a dependence graph.
 * Returns vertex_undefined if v is not in list l.
 * Returns v' that has the same statement_ordering than v.
 */
vertex in_dg_vertex_list(list l, vertex v)
{
        vertex          ver;
        int             in;
 
        pips_debug(9, "doing \n");
 
        in = dg_vertex_label_statement( (dg_vertex_label)
                                        vertex_vertex_label(v) );
        for(;!ENDP(l); POP(l)) {
                int prov_i;
                ver = VERTEX(CAR( l ));
                prov_i = dg_vertex_label_statement( (dg_vertex_label)
                                        vertex_vertex_label(ver) );
                if ( prov_i == in ) return( ver );
        }
 
        return vertex_undefined;
}
 
/*============================================================================*/
/* expression make_id_expression(string s): makes an expression with the
 * name of a variable. For this variable, we create a new entity if it does not
 * exist yet.
 */
expression make_id_expression(string s)
{
 entity new_ent;
 string exp_full_name;
 
 exp_full_name = strdup(concatenate(DFG_MODULE_NAME, MODULE_SEP_STRING,
                                    s, (char *) NULL));
 
 new_ent = gen_find_tabulated(exp_full_name, entity_domain);
 
 if(new_ent == entity_undefined)
    new_ent = make_entity(exp_full_name,
                          make_type(is_type_variable,
                                    make_variable(make_basic_int(4/*UU*/),
                                                  NIL, NIL)),
                          make_storage(is_storage_ram, ram_undefined),
                          make_value_unknown());
 
 return(make_expression(make_syntax(is_syntax_reference,
                                    make_reference(new_ent,NIL)),
                        normalized_undefined));
}
 
/*============================================================================*/
/* expression make_array_ref(list l): returns an expression which is a
 * reference to an array. The list "l" is composed of expressions, the first
 * one is the array itself and the others are the indices. In order to create
 * the desire expression, we only have to put the CDR of "l" into the list of
 * indices of the reference contained in the first expression of "l".
 */
expression make_array_ref(list l)
{
  expression new_exp;
  list array_inds;
 
  if(l == NIL)
    pips_internal_error("No args for array ref");
 
  new_exp = EXPRESSION(CAR(l));
  array_inds = CDR(l);
 
  if(! syntax_reference_p(expression_syntax(new_exp)))
    pips_internal_error("Array ref is not a reference");
 
  reference_indices(syntax_reference(expression_syntax(new_exp))) = array_inds;
 
  return(new_exp);
}
 
/*============================================================================*/
/* expression make_func_op(string func_name, list args): returns an expression
 * that represent the call to "func_name" with "args" as arguments.
 */
expression make_func_op(func_name, args)
string func_name;
list args;
{
 entity func_ent;
 
 func_ent = gen_find_tabulated(make_entity_fullname(TOP_LEVEL_MODULE_NAME,
                                                    func_name), entity_domain);
 
 if(func_ent == entity_undefined)
    pips_internal_error("Function unknown : %s", func_name);
 
 return(make_expression(make_syntax(is_syntax_call,
                                    make_call(func_ent, args)),
                        normalized_undefined));
}
 
/*============================================================================*/
/* expression lisp_exp_to_ri_exp(lisp_expression le): returns the
 * expression that represent the lisp_expression given in argument ("le"). A
 * lisp_expression is a Newgen structure that defines an expression as a list
 * with the operator as the first object and the arguments as the rest of the
 * list.
 *
 * There are a few cases. If the operator is "aref" or "aset" then this lisp
 * expression is a reference to an array. We use make_array_ref().
 * If the operator is not one of the four operations (+,-,*,/), then we use
 * make_func_op().
 * Else (the operator is one of the four operation) we use rational_op_exp().
 */
expression lisp_exp_to_ri_exp(le)
lisp_expression le;
{
 expression exp1, exp2;
 string exp_op = lisp_expression_operation(le);
 list exp_args = lisp_expression_args(le);
 
 if( (strncmp(exp_op, "aref", 4) == 0) || (strncmp(exp_op, "aset", 4) == 0) )
    return(make_array_ref(exp_args));
 
 if(! STRING_FOUR_OPERATION_P(exp_op))
    return(make_func_op(exp_op, exp_args));
 
 exp1 = EXPRESSION(CAR(exp_args));
 exp_args = CDR(exp_args);
 
 if(exp_args == NIL)
    pips_internal_error("Only 1 argument for a binary (or more) operation");
 
 for(; exp_args != NIL; exp_args = CDR(exp_args))
   {
    exp2 = EXPRESSION(CAR(exp_args));
 
    exp1 = rational_op_exp(exp_op, exp1, exp2);
   }
 return(exp1);
}
 
 
/*============================================================================*/
/* expression negate_expression(expression exp): returns the negation of
 * the expression given in argument "exp".
 *
 * In fact this computation is done only if the expression is linear with
 * integer coefficients. If so, we use the Pvecteur form. Else, we return the
 * duplication of the expression.
 */
expression negate_expression(exp)
expression exp;
{
 expression neg_exp;
 normalized nexp;
 
 nexp = NORMALIZE_EXPRESSION(exp);
 
 if(normalized_complex_p(nexp))
    neg_exp = copy_expression(exp);
 else
   {
    Pvecteur vexp, new_vec;
 
    vexp = (Pvecteur) normalized_linear(nexp);
    new_vec = vect_dup(vexp);
    vect_chg_sgn(new_vec);
 
    neg_exp = make_vecteur_expression(new_vec);
   }
 
 return(neg_exp);
}
 
/*============================================================================*/
/* predicate expressions_to_predicate(list exp_l): returns the predicate
 * that has the inequalities given as expressions in "exp_l". For example:
 * if A is an expresion of "exp_l" then we'll have the inequality A <= 0 in the
 * predicate.
 *
 * If an expression is not linear, we warn the user.
 *
 * Note: if "exp_l" is empty then we return an undefined predicate.
 */
predicate expressions_to_predicate(exp_l)
list exp_l;
{
 predicate new_pred;
 Psysteme new_sc;
 list l;
 
 if(exp_l == NIL)
    return(predicate_undefined);
 
 new_sc = sc_new();
 
 for(l = exp_l; l != NIL; l = CDR(l))
   {
    expression exp = EXPRESSION(CAR(l));
    normalized nexp = NORMALIZE_EXPRESSION(exp);
 
    if(normalized_linear_p(nexp))
      {
       Pvecteur new_vec = (Pvecteur) normalized_linear(nexp);
       sc_add_inegalite(new_sc, contrainte_make(new_vec));
      }
    else
      {
       printf("\nNon linear expression :");
       printf(" %s\n", expression_to_string(exp));
      }
   }
 
 sc_creer_base(new_sc);
 new_pred = make_predicate(new_sc);
 
 return(new_pred);
}
 
 
/*============================================================================*/
/* int vertex_int_stmt(vertex v): returns the statement number contained
 * in the vertex. It is a "dfg" vertex.
 */
int vertex_int_stmt(v)
vertex v;
{
return(dfg_vertex_label_statement((dfg_vertex_label) vertex_vertex_label((v))));
}
 
 
/*============================================================================*/
/* void comp_exec_domain(graph g, STS): computes the execution domain of
 * each statement. The englobing loops are obtained through the static
 * control map. */
void comp_exec_domain(g, STS)
graph g;
hash_table STS;
{
  int stmt;
  list loop_l, dfg_edge_l;
 
  /* We update the graph global variable with the exec domain. */
  dfg_edge_l = graph_vertices(g);
  for(; dfg_edge_l != NIL; dfg_edge_l = CDR(dfg_edge_l)) {
    vertex v = VERTEX(CAR(dfg_edge_l));
    dfg_vertex_label dvl;
    Psysteme new_sc = sc_new();
 
    dvl = (dfg_vertex_label) vertex_vertex_label(v);
    stmt = vertex_int_stmt(v);
    loop_l = static_control_loops((static_control) hash_get(STS,
                                                            (char *) ((long)stmt)));
 
    for( ; loop_l != NIL; loop_l = CDR(loop_l))
      {
       Pvecteur vect_index, vect;
       normalized nub, nlb;
       /* loop aux_loop = ENTITY(CAR(loop_l)); */
       loop aux_loop = LOOP(CAR(loop_l));
       entity index_ent = loop_index(aux_loop);
 
       vect_index = vect_new((char *) index_ent, VALUE_ONE);
       nlb = NORMALIZE_EXPRESSION(range_lower(loop_range(aux_loop)));
       nub = NORMALIZE_EXPRESSION(range_upper(loop_range(aux_loop)));
 
       if (normalized_linear_p(nlb))
         {
          vect = vect_substract((Pvecteur) normalized_linear(nlb), vect_index);
          if(!VECTEUR_NUL_P(vect))
             sc_add_inegalite(new_sc, contrainte_make(vect));
         }
       if (normalized_linear_p(nub))
         {
          vect = vect_substract(vect_index, (Pvecteur) normalized_linear(nub));
          if(!VECTEUR_NUL_P(vect))
             sc_add_inegalite(new_sc, contrainte_make(vect));
         }
      }
    sc_creer_base(new_sc);
 
    dfg_vertex_label_exec_domain(dvl) = make_predicate(new_sc);
   }
}
 
/*============================================================================*/
/* Psysteme make_expression_equalities(list le): returns a Psysteme that
 * has equalities computed from "le", a list of expressions.
 */
Psysteme make_expression_equalities(list le)
{
 Psysteme new_sc;
 list l;
 
 new_sc = sc_new();
 
 for(l = le; l != NIL; l = CDR(l))
   {
    expression exp = EXPRESSION(CAR(l));
    normalized nexp = NORMALIZE_EXPRESSION(exp);
 
    if(normalized_linear_p(nexp))
      {
       Pvecteur new_vec = (Pvecteur) normalized_linear(nexp);
       sc_add_egalite(new_sc, contrainte_make(new_vec));
      }
    else
      {
       printf("\nNon linear expression :");
       printf(" %s\n", expression_to_string(exp));
      }
   }
 sc_creer_base(new_sc);
 return(new_sc);
}
 
/*============================================================================*/
/* static list find_el_with_num(int stmt): returns the englobing loops list
 * corresponding to the statement number "stmt".
 *
 * This function uses an hash table, which contains the static_control
 * associated to each statement.  */
static list find_el_with_num(int stmt)
{
 hash_table scm = get_current_stco_map();
 
 static_control stct = (static_control) hash_get(scm, (char *) ((long)stmt));
 
 return(static_control_loops(stct));
}
 
/*============================================================================*/
/* Pbase make_base_of_nest(int stmt): returns the Pbase that contains the
 * indices of the englobing loops of "stmt".
 */
Pbase make_base_of_nest(int stmt)
{
 Pbase new_b = NULL;
 list el_l;
 
 for(el_l = find_el_with_num(stmt) ; el_l != NIL; el_l = CDR(el_l))
   vect_add_elem((Pvecteur *) &new_b,
                 (Variable) loop_index(LOOP(CAR(el_l))),
                 VALUE_ONE);
 
 return(new_b);
}
 
/*============================================================================*/
/* successor first_succ_of_vertex(vertex v): returns the first successor of
 * "v".
 */
successor first_succ_of_vertex(vertex v)
{
 return(SUCCESSOR(CAR(vertex_successors(v))));
}
 
 
/*============================================================================*/
/* dataflow first_df_of_succ(successor s): returns the first dataflow of
 * "s".
 */
dataflow first_df_of_succ(s)
successor s;
{
 return(DATAFLOW(CAR(dfg_arc_label_dataflows((dfg_arc_label)
successor_arc_label(s)))));
}
 
/*============================================================================*/
/* loop loop_dup(loop l): returns the duplication of "l".
 */
loop loop_dup(loop l)
{
  /*
 loop new_loop;
 
 new_loop = make_loop(loop_index(l), range_dup(loop_range(l)), loop_body(l),
                      loop_label(l), loop_execution(l), loop_locals(l));
 
 return(new_loop);
  */
  return copy_loop(l);
}
 
 
 /* package mapping : Alexis Platonoff, july 1993 */
 
/*============================================================================*/
/* list static_control_to_indices(static_control stct): returns the list of
 * the loop indices (entities) corresponding to the list of loops contained in
 * "stct". The list of indices is in the same order than the list of loop, i.e.
 * for example, if "stct" contains a list of loops like (LOOP1, LOOP3, LOOP5,
 * LOOP2) then the list of indices will be (I1, I3, I5, I2).
 */
list static_control_to_indices(stct)
static_control stct;
{
 list lo_l = static_control_loops(stct);
 list ind_l = NIL;
 
 for( ; lo_l != NIL; lo_l = CDR(lo_l))
   {
    loop lo = LOOP(CAR(lo_l));
 
    /* We keep the same order. */
    ind_l = gen_nconc(ind_l, CONS(ENTITY, loop_index(lo), NIL));
   }
 return(ind_l);
}
 
 
 
 
/* ======================================================================== */
/*
 * Pvecteur polynome_to_vecteur(Ppolynome pp)
 *
 * Translates a polynome "pp" into a vector. This is only possible if "pp"
 * is of degree one (1).
 */
Pvecteur polynome_to_vecteur(Ppolynome pp)
{
  Pvecteur new_pv = VECTEUR_NUL;
  Ppolynome ppp;
 
  for(ppp = pp; ppp != NULL; ppp = ppp->succ) {
    entity var;
    Value val;
    Pvecteur pv = (ppp->monome)->term;
 
    if(VECTEUR_NUL_P(pv))
      pips_internal_error("A null vector in a monome");
    else if(pv->succ != NULL)
      pips_internal_error("Polynome is not of degree one");
 
    var = (entity) pv->var;
    val = float_to_value((ppp->monome)->coeff);
    vect_add_elem(&new_pv, (Variable) var, val);
  }
  return(new_pv);
}
 
/* ======================================================================== */
/*
 * Pcontrainte polynome_to_contrainte(Ppolynome pp)
 *
 * Translates a polynome "pp" into a constraint (inequality or equality,
 * depends on its usage). This is only possible if "pp" is of degree one (1)
 * because we tranform it into a Pvecteur.
 *
 * If you want an inequality, it will be: pp <= 0
 */
Pcontrainte polynome_to_contrainte(pp)
Ppolynome pp;
{
 return(contrainte_make(polynome_to_vecteur(pp)));
}
 
 
/*============================================================================*/
/* Psysteme polynome_to_sc(Ppolynome pp, list l): returns a system of
 * equalities ("new_ps") computed from a polynome "pp" and a list of variables
 * "l".
 *
 * This list gives the variables of the polynome for which we need to nullify
 * the factor. Thus, the resulting system contains the equations that nullify
 * these factors (the degree of the polynome must be less or equal to two).
 *
 * When all these equations are computed, the remaining polynome, from each we
 * have removed all the occurences of these variables, is also nullify and the
 * equation added to the system (then, this remnant must be of degree 1).
 */
Psysteme old_polynome_to_sc(pp, l)
Ppolynome pp;
list l;
{
 Ppolynome aux_pp = polynome_dup(pp);
 Psysteme new_ps = sc_new();
 
 /* For each variable, we nullify its factor in the polynome. */
 for( ; l != NIL; l = CDR(l))
   {
    /* We get the current variable. */
    entity var = ENTITY(CAR(l));
 
    /* We get its factor in the polynome. */
    Ppolynome pp_fac = polynome_factorize(aux_pp, (Variable) var, 1);
 
    /* We add a new equality in the system. */
    sc_add_egalite(new_ps, polynome_to_contrainte(pp_fac));
 
    /* We delete the occurences of this variable in the polynome. */
    aux_pp = prototype_var_subst(aux_pp, (Variable) var, POLYNOME_NUL);
   }
 /* The remnant is added to the system. */
 sc_add_egalite(new_ps, polynome_to_contrainte(aux_pp));
 
 sc_creer_base(new_ps);
 return(new_ps);
}
 
 
/*============================================================================*/
/* Psysteme new_polynome_to_sc(Ppolynome pp, list l): returns a system of
 * equalities ("new_ps") computed from a polynome "pp" and a list of variables
 * "l".
 *
 * This list gives the variables of the polynome for which we need to nullify
 * the factor. Thus, the resulting system contains the equations that nullify
 * these factors (the degree of the polynome must be less or equal to two).
 *
 * When all these equations are computed, the remaining polynome, from each we
 * have removed all the occurences of these variables, is also nullify and the
 * equation added to the system (then, this remnant must be of degree 1).
 */
Psysteme polynome_to_sc(pp, l)
Ppolynome pp;
list l;
{
 Ppolynome aux_pp = polynome_dup(pp);
 Psysteme new_ps = sc_new();
 
 /* For each variable, we nullify its factor in the polynome. */
 for( ; l != NIL; l = CDR(l))
   {
    /* We get the current variable. */
    entity var = ENTITY(CAR(l));
 
    /* We get its factor in the polynome. */
    Pvecteur pv_fac = prototype_factorize(aux_pp, (Variable) var);
 
    if(!VECTEUR_NUL_P(pv_fac)) {
      sc_add_egalite(new_ps, contrainte_make(pv_fac));
 
      /* We delete the occurences of this variable in the polynome. */
      aux_pp = prototype_var_subst(aux_pp, (Variable) var, POLYNOME_NUL);
    }
   }
 /* The remnant is added to the system. */
 sc_add_egalite(new_ps, polynome_to_contrainte(aux_pp));
 
 sc_creer_base(new_ps);
 return(new_ps);
}
 
 
/*============================================================================*/
/* void substitute_var_with_vec(Psysteme ps, entity var, int val, Pvecteur vec):
 * Substitutes in a system ("ps") a variable ("var"), factor of a positive
 * value ("val"), by an expression ("vec").
 *
 * This substitution is done on all assertions of the system (equalities and
 * inequalities). For each assertion (represented by a vector Vold) we have:
 *
 *      Vold = c*var + Vaux
 *      val*var = vec
 *
 * Vnew represents the new assertion.  With: p = pgcd(c, val) >= 1, we have:
 *
 *      Vnew = (c/p)*vec + (val/p)*Vaux = (c/p)*vec + (val/p)*(Vold - c*var)
 *
 * Note: we have: Vold == 0 <=> (val/p)*Vold == 0
 *                Vold > 0 <=> (val/p)*Vold > 0
 *                ...
 *
 * because "val" is positive.
 */
void substitute_var_with_vec(ps, var, val, vec)
Psysteme ps;
entity var;
Value val;
Pvecteur vec;
{
 Variable Var = (Variable) var;
 Pcontrainte assert;
 
 ifdebug(7) {
fprintf(stdout, "\t\t\tAvant Sub: \n");
fprint_psysteme(stdout, ps);
fprintf(stdout, "\n");
 }
 
  /* "val" must be positive. */
  if(value_neg_p(val)) {
      value_oppose(val);
      vect_chg_sgn(vec);
  }
 
  /* Vnew = (c/p)*vec + (val/p)*Vaux = (c/p)*vec + (val/p)*(Vold - c*var) */
  for(assert = ps->egalites; assert != NULL; assert = assert->succ) {
    Pvecteur v_old = assert->vecteur;
    Value coeff = vect_coeff(Var, v_old);
    if(value_notzero_p(coeff)) {
        Value p = pgcd_slow(coeff, val);
 
        assert->vecteur = vect_cl2_ofl_ctrl
            (value_div(coeff,p), vec,
             value_div(val,p),
             vect_cl2_ofl_ctrl(VALUE_ONE, v_old, VALUE_MONE,
                               vect_new(Var, coeff),
                               NO_OFL_CTRL),
             NO_OFL_CTRL);
    }
  }
  for(assert = ps->inegalites; assert != NULL; assert = assert->succ) {
    Pvecteur v_old = assert->vecteur;
    Value coeff = vect_coeff(Var, v_old);
    if(value_notzero_p(coeff)) {
        Value p = pgcd_slow(coeff, val);
 
      assert->vecteur = vect_cl2_ofl_ctrl
          (value_div(coeff,p), vec,
           value_div(val,p),
           vect_cl2_ofl_ctrl(VALUE_ONE, v_old, VALUE_MONE,
                             vect_new(Var, coeff),
                             NO_OFL_CTRL),
           NO_OFL_CTRL);
    }
  }
  vect_rm((Pvecteur) ps->base);
  ps->base = (Pbase) NULL;
  sc_creer_base(ps);
 
  ifdebug(7) {
     fprintf(stdout, "\t\t\tApres Sub: \n");
     fprint_psysteme(stdout, ps);
     fprintf(stdout, "\n");
 }
 
}
 
 
/*============================================================================*/
/* bool is_entity_in_list_p(entity e, list l): returns true if entity "e" is
 * in the list of entities "l", false otherwise.
 */
/* FI: many similar functions. See ri-util/arguments.c which deals
   with entity lists, i.e. entities. */
bool is_entity_in_list_p(entity e, list l)
{
 bool is_in_list = false;
 for( ; (l != NIL) && (! is_in_list); l = CDR(l))
    if(same_entity_p(e, ENTITY(CAR(l))))
       is_in_list = true;
 return(is_in_list);
}
 
/*============================================================================*/
/* Psysteme elim_var_with_eg(Psysteme ps, list *init_l, list *elim_l):
 * Computes the elimination of variables in the system "ps" using its
 * equalities. All the used equalities are removed directly from "ps".
 *
 * However, we keep all these "used" equalities in "sc_elim". The return value
 * of this function is this system.
 *
 * Initially, "init_l" gives the list of variables that can be eliminated and
 * "elim_l" is empty. At the end, "init_l" contains the variables that are
 * not eliminated and "elim_l" contains the variables that are eliminated.
 *
 * At the end, to each equality of "sc_elim" will be associated a variable
 * of "elim_l". These lists are built so as to be able to match them directly.
 * Each variable of "elim_l" appears in one constraint of "sc_elim" and only
 * one. There will be as many equalities in "sc_elim" as variables in "elim_l"
 *
 * A variable can be eliminated using a given equality if it appears in this
 * equality, i.e. its associated coefficient is not equal to zero. Moreover, it
 * is easier to eliminate a variable with a value of 1 or -1. So, first we
 * try to find such a variable.
 *
 * Algo:
 * ----
 * BEGIN
 * vl = init_l;
 * el = NIL;
 * eqs = list of equalities of ps
 * sc_elim = system with no constraints
 * while eqs is not empty
 *   init_vec = vector of the first equality of eqs
 *   var_not_found = TRUE
 *   coeff_one_not_found = TRUE
 *   l = vl
 *   while coeff_one_not_found and l is not empty
 *     crt_var = first variable of l
 *     crt_val = its value in init_vec
 *     if crt_val is 1 or -1
 *       coeff_one_not_found = FALSE
 *       var_not_found = FALSE
 *       (var, val) = (crt_var, crt_val)
 *     else if crt_val is not 0 and var_not_found
 *       var_not_found = FALSE
 *       (var, val) = (crt_var, crt_val)
 *     end if
 *     l = CDR(l)
 *   end while
 *   if var_not_found is false (means that a variable has been found)
 *     (var, val) = variable and its value to eliminate in init_vec
 *     remove var from vl
 *     add var to el
 *     pv_elim = val*var - init_vec
 *     substitute val*var by pv_elim in ps
 *     substitute val*var by pv_elim in sc_elim
 *     add init_vec to sc_elim
 *     eqs = new list of equalities of ps
 *   else
 *     eqs = CDR(eqs)
 *   end if
 * end while
 * init_l = vl
 * elim_l = el
 * END
 *
 * Note: the substitution of val*var by pv_elim in a vector V uses the gcd:
 *      V = c*var + Vaux
 *      p = gcd(val,c)
 *      Vnew = (c/p)*pv_elim + (val/p)*Vaux
 *
 * BUG: reuse of freed memory.
 */
Psysteme elim_var_with_eg(Psysteme ps, list * init_l, list * elim_l)
{
    Psysteme sc_elim = sc_new();
    Pcontrainte eqs;
    list vl = *init_l,  /* We use "vl" during the computation, not *init_l */
    el = NIL,   /* We use "el" during the computation, not *elim_l */
    l;
 
    /* Nothing do if there is no variable to eliminate */
    if(!ENDP(vl)) {
        /* This elimination works only on equalities. While there remains
         * equalities, we can eliminate variables.  */
        eqs = ps->egalites;
        while(eqs != NULL)
        {
            bool coeff_one_not_found, var_found;
            entity var = entity_undefined;
            Value val = VALUE_ZERO;
            Pvecteur init_vec, pv_elim;
            Pcontrainte next = eqs->succ;
 
            init_vec = vect_dup(eqs->vecteur);
 
            /* We look, in vl (i.e. init_l), for a variable that we can
             * eliminate in init_vec, i.e. with a coefficient not equal to
             * 0. We prefer a coefficient * equal to 1 or -1, so we scan
             * all the equality. We take the first * variable of "init_l"
             * that has a coeff of 1 or -1. If there is no such *
             * variable, we take the first with a coeff not equal to zero.
             */
            var_found = false;
            coeff_one_not_found = true;
 
            for(l = vl ; (l != NIL) && coeff_one_not_found; l = CDR(l))
            {
                entity crt_var = ENTITY(CAR(l));
                Value crt_val = vect_coeff((Variable) crt_var, init_vec);
 
                if(value_one_p(crt_val) || value_mone_p(crt_val))
                {
                    coeff_one_not_found = false;
                    var_found = true;
                    var = crt_var;
                    val = crt_val;
                }
                else if((value_notzero_p(crt_val)) && !var_found)
                {
                    var_found = true;
                    var = crt_var;
                    val = crt_val;
                }
            }
 
            if(var_found) /* If we get such a variable, we eliminate it. */
            {
                /* First, we remove it from "vl". */
                gen_remove(&vl, (void *) var);
 
                /* Then, we add it to "el". */
                el = CONS(ENTITY, var, el);
 
                /* We compute the expression (pv_elim) by which we are
                 * going to substitute our variable (var):
                 *
                 * We have: val*var = pv_elim
                 *
                 * The equality is: V = 0, with: V = val*var + Vaux
                 *
                 * So, we have: pv_elim = -Vaux, with: Vaux = V - val*var
                 *
                 * So: pv_elim = val*var - V
                 *
                 * ??? memory leak...
                 */
                pv_elim = vect_cl2_ofl_ctrl
                    (VALUE_MONE, vect_dup(init_vec),
                     VALUE_ONE,  vect_new((Variable) var, val),
                     NO_OFL_CTRL);
 
                /* substitute "val*var" by its value (pv_elim) in the system */
                substitute_var_with_vec(ps, var, val, vect_dup(pv_elim));
                /*ps = sc_normalize(ps);*/
                ps = sc_elim_db_constraints(ps);
 
                /* We substitute var by its value (pv_elim) in "sc_elim". */
                substitute_var_with_vec(sc_elim, var, val, vect_dup(pv_elim));
 
                /* The initial equality is added to "sc_elim". */
                sc_add_egalite(sc_elim, contrainte_make(vect_dup(init_vec)));
 
                /* We reinitialize the list of equalities. */
                eqs = ps->egalites;
            }
            /* Else, we try on the next equality. */
            else
                eqs = next;
 
            vect_rm(init_vec);
        }
    }
    *init_l = vl;
    *elim_l = el;
    sc_elim->base = NULL;
    sc_creer_base(sc_elim);
 
    return(sc_elim);
}
 
 
/*============================================================================*/
/* Psysteme better_elim_var_with_eg(Psysteme ps, list *init_l, list *elim_l):
 * Computes the elimination of variables in the system "ps" using its
 * equalities. All the used equalities are removed directly from "ps".
 *
 * However, we keep all these "used" equalities in "sc_elim". The return value
 * of this function is this system.
 *
 * Initially, "init_l" gives the list of variables that can be eliminated and
 * "elim_l" is empty. At the end, "init_l" contains the variables that are
 * not eliminated and "elim_l" contains the variables that are eliminated. We
 * keep the order of "init_l" in our process of elimination.
 *
 * At the end, to each equality of "sc_elim" will be associated a variable
 * of "elim_l". These lists are built so as to be able to match them directly.
 * Each variable of "elim_l" appears in one constraint of "sc_elim" and only
 * one. There will be as many equalities in "sc_elim" as variables in "elim_l"
 *
 * A variable can be eliminated using a given equality if it appears in this
 * equality, i.e. its associated coefficient is not equal to zero. Moreover,
 * for a given variable, we look for the equation in which it has the smallest
 * coefficient.
 *
 * Algo:
 * ----
 * BEGIN
 * vl = a copy of init_l;
 * el = NIL;
 * sc_elim = system with no constraints;
 * loop over the list of variables to eliminate vl
 *   v = current variable;
 *   eq = the equality of ps in which the coefficient of v is the smallest
 *   if eq is not NULL
 *     eq is taken off the list of equalities of ps
 *     loop over the list of equalities of ps
 *       eg = current equality
 *       substitute in eg the value of v given by eq
 *     end loop
 *     loop over the list of inequalities of ps
 *       eg = current inequality
 *       substitute in eg the value of v given by eq
 *     end loop
 *     loop over the list of equalities of sc_elim
 *       eg = current equality
 *       substitute in eg the value of v given by eq
 *     end loop
 *     loop over the list of inequalities of sc_elim
 *       eg = current inequality
 *       substitute in eg the value of v given by eq
 *     end loop
 *     add eq in the list of equalities of sc_elim
 *     remove v from init_l
 *     add v in el
 *   end if
 * end loop
 *
 * elim_l = el
 * END
 *
 * Note: Here is how we "substitute in eg the value of v given by eq":
 *      if eg and eq are as follows (Vaux and Vsub do not contained v):
 *              eg <=> c*v + Vaux = 0
 *              eq <=> val*v = Vsub
 *      let p = gcd(val,c)
 *      after the substitution, we have:
 *              eg <=> (c/p)*Vsub + (val/p)*Vaux = 0
 */
Psysteme better_elim_var_with_eg(ps, init_l, elim_l)
Psysteme ps;
list *init_l, *elim_l;
{
  Psysteme sc_elim = sc_new();
 
  /* During the computation, we modify *init_l, so we duplicate it.
   * We use "el" not *elim_l, which should be  empty at the beginning.
   */
  list vl = gen_append(*init_l, NIL),
       el = NIL,
       l;
  Pcontrainte eq, eg;
 
  for(l = vl; !ENDP(l); POP(l)) {
    Variable v = (Variable) ENTITY(CAR(l));
    Value coeff;
 
    if ((eq = contrainte_var_min_coeff(ps->egalites,v, &coeff, true))
        != NULL) {
 
 if(get_debug_level() > 7) {
fprintf(stderr, "System is :");
fprint_psysteme(stderr, ps);
fprintf(stderr, "\t\tElim var %s in equation:", entity_local_name((entity) v));
pu_vect_fprint(stderr, eq->vecteur);
fprintf(stderr, "\n");
 }
 
      if(!egalite_normalize(eq))
        pips_internal_error("Strange equality");
 
      sc_nbre_egalites(ps)--;
      if (eq == (ps->egalites)) ps->egalites = eq->succ;
      /* si eq etait en tete il faut l'enlever de la liste, sinon, eq a
         ete enleve par la fonction contrainte_var_min_coeff(). */
 
      for(eg = ps->egalites; eg != NULL; eg = eg->succ)
        (void) contrainte_subst_ofl_ctrl(v, eq, eg, true, NO_OFL_CTRL);
      for(eg = ps->inegalites; eg != NULL; eg = eg->succ)
        (void) contrainte_subst_ofl_ctrl(v, eq, eg, false, NO_OFL_CTRL);
 
      for(eg = sc_elim->egalites; eg != NULL; eg = eg->succ)
        (void) contrainte_subst_ofl_ctrl(v, eq, eg, true, NO_OFL_CTRL);
      for(eg = sc_elim->inegalites; eg != NULL; eg = eg->succ)
        (void) contrainte_subst_ofl_ctrl(v, eq, eg, false, NO_OFL_CTRL);
 
      sc_add_egalite(sc_elim, eq);
      gen_remove(init_l, (void *) v);
      el = CONS(ENTITY, (entity) v, el);
    }
  }
 
  *elim_l = el;
  sc_elim->base = NULL;
  sc_creer_base(sc_elim);
 
  ifdebug(7) {
fprintf(stderr, "[new_elim_var_with_eg] Results:\n");
fprintf(stderr, "Elim sys:\n");
fprint_entity_list(stderr, el);
fprint_psysteme(stderr, sc_elim);
fprintf(stderr, "Remnants sys:\n");
fprint_entity_list(stderr, *init_l);
fprint_psysteme(stderr, ps);
fprintf(stderr, "\n");
 }
 
  return(sc_elim);
}
 
 
/*============================================================================*/
/* bool single_var_vecteur_p(Pvecteur pv): returns true if the vector "pv"
 * contains only one element.
 *
 * Note: This element should not be a constant term (this is not tested).
 */
bool single_var_vecteur_p(Pvecteur pv)
{
 return(vect_size(pv) == 1);
}
 
 
/*============================================================================*/
/* list vecteur_to_list(Pvecteur v): translates a Pvecteur into a list of
 * entities, in the same order.
 */
/* FI: same comment as above: to be moved */
list vecteur_to_list(Pvecteur v)
{
 list l = NIL;
 
 for( ; v != NULL; v = v->succ)
   {
    entity var = (entity) v->var;
    if(var != (entity) TCST)
       l = gen_nconc(l, CONS(ENTITY, var, NIL));
   }
 
 return(l);
}
 
 
 
 
/*============================================================================*/
/* Ppolynome old_vecteur_to_polynome(Pvecteur vec): translates a Pvecteur into a
 * Ppolynome.
 */
/* FI: To be moved*/
Ppolynome old_vecteur_to_polynome(Pvecteur vec)
{
 Ppolynome pp_new = POLYNOME_NUL;
 
 for( ; vec != NULL; vec = vec->succ)
    polynome_add(&pp_new,
                 make_polynome(VALUE_TO_FLOAT(vec->val), vec->var, VALUE_ONE));
 
 return(pp_new);
}
 
 
 
 
/*============================================================================*/
/* list meld(list l1, list l2, bool (*compare_obj)()):
 */
list meld(l1, l2, compare_obj)
list l1, l2;
bool (*compare_obj)();
{
  if( ENDP(l1) ) {
    return(l2);
  }
  else if( ENDP(l2) ) {
    return(l1);
  }
  else if(compare_obj(CHUNK(CAR(l1)), CHUNK(CAR(l2)))) {
    return(gen_nconc(CONS(CHUNK, CHUNK(CAR(l1)), NIL),
                     meld(CDR(l1), l2, compare_obj)));
  }
  else {
    return(gen_nconc(CONS(CHUNK, CHUNK(CAR(l2)), NIL),
                     meld(l1, CDR(l2), compare_obj)));
  }
}
 
 
/*============================================================================*/
/* list general_merge_sort(list l, bool (*compare_obj)()): returns the
 * result of sorting the list "l" using the comparison function
 * "compare_obj". This bool function should retuns true if its first
 * argument has to be placed before its second argument in the sorted
 * list, else FALSE.
 *
 * This is a generic function that accepts any homogene list of newgen
 * objects. The comparison function must be coded by the user, its
 * prototype should be: bool my_compare_obj(chunk * obj1, chunk *
 * obj2);
 *
 * This function uses the merge sort algorithm which has a mean and worst
 * case complexity of n*log(n).  There are two steps.  First, we look for
 * sublists that are in the right order, each time we found one we put it
 * in a list of lists, a LIFO queue ("head" is the out point, "tail" is
 * the in point).  Second, we take the first two lists of our LIFO queue
 * (i.e. at the "head") and meld then into one list that we put again in
 * our LIFO (i.e.  at the "tail"). We continue until there remains only
 * one list in our LIFO queue, which in that case is the sorted list we
 * wanted.
 */
 
/*  hack to preserve the bool comparison while using qsort...
 */
static bool (*bool_compare_objects)();
static int compare_objects(p1, p2)
gen_chunk **p1, **p2;
{
    return(bool_compare_objects(*p2, *p1)-bool_compare_objects(*p1, *p2));
}
 
/* no way validate Prgm_mapping with this function...
 */
list new_general_merge_sort(l, compare_obj)
list l;
bool (*compare_obj)();
{
    bool (*current)();
    list lnew = gen_copy_seq(l);
 
    /* push
     */
    current = bool_compare_objects,
    bool_compare_objects = compare_obj;
 
    /* sort
     */
    gen_sort_list(lnew, compare_objects);
 
    /* pop
     */
    bool_compare_objects = current;
 
    return(lnew);
}
 
/*  I guess there is some kind of memory leaks here...
 *  I tried the one above, but I could not go thru the validation...
 *
 *  FC 02/01/94
 */
list general_merge_sort(l, compare_obj)
list l;
bool (*compare_obj)();
{
  list ch1, ch2, ch, ch_t, aux_l, head = NIL, tail = NIL;
  void * crt_obj, * prev_obj;
 
  pips_debug(9, "Debut\n");
 
  if( ENDP(l) || ENDP(CDR(l)) )
    return(l);
 
  /* First step */
  ch = l;       /* current sublist containing sorted objects */
  ch_t = ch;    /* tail of "ch" */
  prev_obj = CHUNK(CAR(l));
  for(aux_l = CDR(ch_t); !ENDP(aux_l); aux_l = CDR(ch_t), prev_obj = crt_obj) {
   crt_obj = CHUNK(CAR(aux_l));
    if(compare_obj(crt_obj, prev_obj)) {
      /* Current sublist stops here, we put it in our LIFO queue and ... */
      if(tail == NIL) {
        head = CONS(CONSP, ch, NIL);
        tail = head;
      }
      else {
        CDR(tail) = CONS(CONSP, ch, NIL);
        POP(tail);
      }
 
      /* ... we reinitialize our current sublist. */
      ch = CDR(ch_t);
      CDR(ch_t) = NIL;
      ch_t = ch;
    }
    else
      /* Else, current sublist increases. */
      POP(ch_t);
  }
  /* The last current sublist is put in our LIFO queue. */
  if(tail == NIL) {
    head = CONS(CONSP, ch, NIL);
    tail = head;
  }
  else {
    CDR(tail) = CONS(CONSP, ch, NIL);
    POP(tail);
  }
 
  /* Second step */
  for( ; ! ENDP(CDR(head)) ; ) {
    ch1 = CONSP(CAR(head));
    POP(head);
    ch2 = CONSP(CAR(head));
    POP(head);
    ch = meld(ch1, ch2, compare_obj);
 
    if(head == NIL) {
      head = CONS(CONSP, ch, NIL);
      tail = head;
    }
    else {
      CDR(tail) = CONS(CONSP, ch, NIL);
      POP(tail);
    }
  }
  pips_debug(9, "Fin\n");
 
  return(CONSP(CAR(head)));
}
 
 
/* ======================================================================== */
/* expression rational_op_exp(char *op_name, expression exp1 exp2):
 * Returns an expression containing the operation "op_name" between "exp1"
 * and "exp2".
 * "op_name" must be one of the four classic operations : +, -, * or /.
 *
 * If both expressions are integer constant values and the operation
 * result is an integer then the returned expression contained the
 * calculated result, but this calculus is a rational one, not an integer one
 * as in make_op_exp().
 *
 * Else, we treat five special cases :
 *       _ exp1 and exp2 are integer linear and op_name is + or -.
 *         This case is resolved by make_lin_op_exp().
 *       _ exp1 = 0
 *       _ exp1 = 1
 *       _ exp2 = 0
 *       _ exp2 = 1
 *
 * Else, we create a new expression with a binary call.
 *
 * Note: The function MakeBinaryCall() comes from Pips/.../syntax/expression.c
 *       The function int_to_expression() comes from ri-util.
 * Note: This function is almost equivalent to make_op_exp() but for the
 * rational calculus.
 */
/* FI: to be moved in ri-util/expression.c */
expression rational_op_exp(string op_name, expression exp1, expression exp2)
{
  expression result_exp = expression_undefined;
  entity op_ent, unary_minus_ent;
 
  pips_debug(7, "doing\n");
  op_ent = gen_find_tabulated(make_entity_fullname(TOP_LEVEL_MODULE_NAME,
                                                   op_name), entity_domain);
  unary_minus_ent =
    gen_find_tabulated(make_entity_fullname(TOP_LEVEL_MODULE_NAME,
                                            UNARY_MINUS_OPERATOR_NAME),
                       entity_domain);
 
  pips_debug(5, "begin OP EXP : %s  %s  %s\n",
             expression_to_string(exp1),
             op_name,
             expression_to_string(exp2));
 
  if( ! ENTITY_FOUR_OPERATION_P(op_ent) )
    user_error("rational_op_exp", "operation must be : +, -, * or /");
 
  if( expression_constant_p(exp1) && expression_constant_p(exp2) ) {
    int val1, val2;
 
    pips_debug(6, "Constant expressions\n");
    val1 = expression_to_int(exp1);
    val2 = expression_to_int(exp2);
 
    if (ENTITY_PLUS_P(op_ent))
      result_exp = int_to_expression(val1 + val2);
    else if(ENTITY_MINUS_P(op_ent))
      result_exp = int_to_expression(val1 - val2);
    else if(ENTITY_MULTIPLY_P(op_ent))
      result_exp = int_to_expression(val1 * val2);
    else { /* ENTITY_DIVIDE_P(op_ent) */
      /* rational calculus */
      if((val1 % val2) == 0)
        result_exp = int_to_expression((int) (val1 / val2));
    }
  }
  else {
    /* We need to know the integer linearity of both expressions. */
    normalized nor1 = NORMALIZE_EXPRESSION(exp1);
    normalized nor2 = NORMALIZE_EXPRESSION(exp2);
 
    if((normalized_tag(nor1) == is_normalized_linear) &&
       (normalized_tag(nor2) == is_normalized_linear) &&
       (ENTITY_PLUS_P(op_ent) || ENTITY_MINUS_P(op_ent)) ) {
      pips_debug(6, "Linear operation\n");
 
      result_exp = make_lin_op_exp(op_ent, exp1, exp2);
    }
    else if(expression_equal_integer_p(exp1, 0)) {
      if (ENTITY_PLUS_P(op_ent))
        result_exp = exp2;
      else if(ENTITY_MINUS_P(op_ent))
        result_exp = MakeUnaryCall(unary_minus_ent, exp2);
      else /* ENTITY_MULTIPLY_P(op_ent) || ENTITY_DIVIDE_P(op_ent) */
        result_exp = int_to_expression(0);
    }
    else if(expression_equal_integer_p(exp1, 1)) {
      if(ENTITY_MULTIPLY_P(op_ent))
        result_exp = exp2;
    }
    else if(expression_equal_integer_p(exp2, 0)) {
      if (ENTITY_PLUS_P(op_ent) || ENTITY_MINUS_P(op_ent))
        result_exp = exp1;
      else if (ENTITY_MULTIPLY_P(op_ent))
        result_exp = int_to_expression(0);
      else /* ENTITY_DIVIDE_P(op_ent) */
        user_error("rational_op_exp", "division by zero");
    }
    else if(expression_equal_integer_p(exp2, 1)) {
      if(ENTITY_MULTIPLY_P(op_ent) || ENTITY_DIVIDE_P(op_ent))
        result_exp = exp1;
    }
 
    /* Both expressions are unnormalized because they might be reused in
     * an unnormalized expression. */
    unnormalize_expression(exp1);
    unnormalize_expression(exp2);
  }
 
  if(result_exp == expression_undefined)
    result_exp = MakeBinaryCall(op_ent, exp1, exp2);
 
  pips_debug(5, "end   OP EXP : %s\n",
             expression_to_string(result_exp));
 
  return (result_exp);
}
 
 
/*==================================================================*/
/* Pvecteur vect_var_subst(vect,var,new_vect): substitute in the
 * vector "vect", the variable "var" by new_vect.
 *  (vect) = (val)x(var) + (vect_aux)
 *                     => (vect) = (val)x(new_vect) + (vect_aux)
 *
 * AC 93/12/06
 */
 
Pvecteur vect_var_subst(vect,var,new_vect)
 
 Pvecteur    vect,new_vect;
 Variable    var;
{
 Pvecteur    vect_aux;
 Value       val;
 
 if ((val = vect_coeff(var,vect)) != 0)
    {
     vect_erase_var(&vect,var);
     vect_aux = vect_multiply(new_vect,val);
     vect = vect_add(vect, vect_aux);
    }
 
 return(vect);
}
 
/*==================================================================*/
/*
 * Ppolynome prototype_var_subst(Ppolynome pp, Variable var,
 *                               Ppolynome ppsubst)
 *
 * Substitutes in polynome "pp" variable "var" by polynome "ppsubst".
 * "pp" is a prototype polynome, i.e. a linear fonction with symbolic
 * constants. Thus, there is no squared variables.
 *
 * This function takes advantage of that fact only when ppsubst in equal
 * to zero, else it uses polynome_var_subst().
 */
Ppolynome prototype_var_subst(pp, var, ppsubst)
Ppolynome pp;
Variable var;
Ppolynome ppsubst;
{
  Ppolynome newpp;
 
  if(POLYNOME_NUL_P(ppsubst)) {
    Ppolynome ppp, p = POLYNOME_UNDEFINED;
    Pvecteur pv;
 
    newpp = polynome_dup(pp);
    for(ppp = newpp; ppp != NULL; ppp = ppp->succ) {
      entity first = entity_undefined,
             second = entity_undefined;
      pv = (ppp->monome)->term;
      for(; (pv != NULL) && (second == entity_undefined); pv = pv->succ) {
        second = first;
        first = (entity) pv->var;
      }
      if(pv != NULL)
        pips_internal_error("Vecteur should contains 2 var");
      else if( same_entity_p(first,  (entity) var) ||
               same_entity_p(second, (entity) var)) {
        if(POLYNOME_UNDEFINED_P(p)) {
          newpp = ppp->succ;
        }
        else
          p->succ = ppp->succ;
      }
      else
        p = ppp;
    }
  }
  else
    newpp = polynome_var_subst(pp, var, ppsubst);
  return(newpp);
}
 
 
/* ======================================================================== */
/*
 * Ppolynome vecteur_mult(Pvecteur v1, v2)
 *
 * Does the multiplication of two vectors, the result is a polynome.
 */
Ppolynome vecteur_mult(Pvecteur v1, Pvecteur v2)
{
  Ppolynome pp = POLYNOME_NUL, new_pp;
  Pvecteur pv1, pv2, ppv;
 
  if(VECTEUR_NUL_P(v1) || VECTEUR_NUL_P(v2))
    return(POLYNOME_NUL);
 
  for(pv1 = v1; pv1 != NULL; pv1 = pv1->succ) {
    Variable var1 = pv1->var;
    Value val1 = pv1->val;
    for(pv2 = v2; pv2 != NULL; pv2 = pv2->succ) {
      Variable var2 = pv2->var;
      Value val2 = pv2->val;
      Value p = value_mult(val1,val2);
      float f = VALUE_TO_FLOAT(p);
 
      if(var1 == TCST)
        new_pp = make_polynome(f, var2, VALUE_ONE);
      else if(var2 == TCST)
        new_pp = make_polynome(f, var1, VALUE_ONE);
      else if(same_entity_p((entity) var1, (entity) var2))
        new_pp = make_polynome(f, var1, VALUE_CONST(2));
      else {
        new_pp = make_polynome(f, var1, VALUE_ONE);
        ppv = (new_pp->monome)->term;
        pips_assert("succ is NULL", ppv->succ == NULL);
        ppv->succ = vect_new(var2, VALUE_ONE);
      }
      polynome_add(&pp, new_pp);
    }
  }
  return(pp);
}
 
 
/* ======================================================================== */
/*
 * Pvecteur prototype_factorize(Ppolynome pp, Variable var)
 * returns the (linear) coefficient of var in polynomial pp.
 * "pp" is a prototype polynome, i.e. a linear fonction with symbolic
 * constants. Thus, there is no squared variables.
 *
 * This function takes plainly advantage of this property, and then is much
 * faster than polynome_factorize().
 */
Pvecteur prototype_factorize(Ppolynome pp, Variable var)
{
    Pvecteur pv = NULL;
 
    if(POLYNOME_NUL_P(pp))
        pv = VECTEUR_NUL;
    else if(var == TCST)
    {
        float f = polynome_TCST(pp);
        pv = vect_new(TCST, float_to_value(f));
    }
    else {
    Ppolynome ppp;
 
    for(ppp = pp; ppp != NULL; ppp = ppp->succ) {
      Variable newvar = VARIABLE_UNDEFINED;
      Value newval;
      Pvecteur vec, newpv;
      entity first = entity_undefined, second = entity_undefined;
      bool factor_found = true;
 
      vec = (ppp->monome)->term;
      for(; (vec != NULL) && (second == entity_undefined); vec = vec->succ) {
        second = first;
        first = (entity) vec->var;
      }
      if(vec != NULL)
        pips_internal_error("Vecteur should contains 2 var");
      else if(same_entity_p(first,  (entity) var))
        if(second == entity_undefined)
          newvar = TCST;
        else
          newvar = (Variable) second;
      else if(same_entity_p(second, (entity) var))
        newvar = (Variable) first;
      else
        factor_found = false;
 
      if(factor_found) {
        newval = float_to_value((ppp->monome)->coeff);
        newpv = vect_new(newvar, newval);
        newpv->succ = pv;
        pv = newpv;
      }
    }
  }
 
  return(pv);
}
 
 
#define MINMAX_REF_NAME "MMREF"
 
/*=================================================================== */
/*
 * Pcontrainte simplify_minmax_contrainte(Pcontrainte pc, Psysteme
 * ps_cont, int min_or_max) :
 *
 * Parameters :
 *   _ pc : a Pcontrainte, i.e. a list of vectors, noted (V1, ..., Vn)
 *   _ ps_cont : a system of equations, called the context.
 *   _ min_or_max : flag, says in which case we are (MIN or MAX)
 *
 * Result : list of vectors, a Pcontrainte
 *
 * Aims : simplify "pc", i.e. suppress one or more of its vectors. A
 * given vector can be suppressed if it surely smaller (case MAX) or
 * greater (case MIN) than one of the other. The case (MIN or MAX) is
 * given by "min_or_max". If two vectors can not be compared, both are
 * kept. The context allows the user to introduce relationship between
 * variables without which some vectors can not be eliminate.
 *
 * Algorithm : we use a function that eliminates redundances in a
 * system, sc_elim_redund(). This system corresponds to the context
 * augmented of following equations (i in {1, ...n}):
 *   _ Case MAX : Vi - X <= 0
 *   _ Case MIN : X - Vi <= 0
 * X is a special variable that represents the MAX or the MIN of our
 * vectors.  This elimination returns a new system in which we only
 * have to get the equations containing X and remove this variable to
 * obtain our simplified list of vectors.
 *
 * Note : "pc" is not changed, the returned list of vectors is a new one. */
 
Pcontrainte simplify_minmax_contrainte(pc, ps_cont, min_or_max)
Pcontrainte pc;
Psysteme ps_cont;
int min_or_max;
{
  Pcontrainte newnew_pc, new_pc, apc, pcc = CONTRAINTE_UNDEFINED,
  epc = CONTRAINTE_UNDEFINED;
  Psysteme psc, new_ps;
  entity ref_ent;
  int count;
  string exp_full_name;
 
  /* We get (or create) our special variable "X". */
  exp_full_name = strdup(concatenate(PAF_UTIL_MODULE_NAME,
                                     MODULE_SEP_STRING,
                                     MINMAX_REF_NAME, (char *) NULL));
  ref_ent = gen_find_tabulated(exp_full_name, entity_domain);
  if(ref_ent == entity_undefined)
    ref_ent = make_entity(exp_full_name,
                          make_type(is_type_variable,
                                    make_variable(make_basic_int(4/*UU*/),
                                                  NIL, NIL)),
                          make_storage(is_storage_ram, ram_undefined),
                          make_value_unknown());
 
 
  /* We put our special variable in our vectors. */
  for(apc = pc, count = 0; apc != NULL; apc = apc->succ, count++) {
    Pvecteur pv;
    Pcontrainte aapc;
 
    pv = vect_dup(apc->vecteur);
    if(min_or_max == IS_MIN) {
      vect_chg_sgn(pv);
      vect_add_elem(&pv, (Variable) ref_ent, (Value) 1);
    }
    else {/* min_or_max == IS_MAX */
      vect_add_elem(&pv, (Variable) ref_ent, (Value) -1);
    }
 
    aapc = contrainte_make(pv);
    if(CONTRAINTE_UNDEFINED_P(pcc)) {
      pcc = aapc;
      epc = aapc;
    }
    else {
      epc->succ = aapc;
      epc = epc->succ;
    }
  }
 
  /* We add the context. */
  psc = sc_dup(ps_cont);
  epc->succ = psc->inegalites;
  psc->inegalites = pcc;
  psc->nb_ineq += count;
  psc->base = NULL;
  sc_creer_base(psc);
 
  new_ps = sc_elim_redund(psc);
 
  new_pc = new_ps->inegalites;
 
  /* We remove our MINMAX variable. */
  newnew_pc = CONTRAINTE_UNDEFINED;
  for(apc = new_pc; apc != NULL; apc = apc->succ) {
    Pvecteur pv;
    Pcontrainte aapc;
    Value xc;
 
    pv = vect_dup(apc->vecteur);
    xc = vect_coeff((Variable) ref_ent, pv);
    if(value_one_p(xc) && (min_or_max == IS_MIN)) {
      vect_erase_var(&pv, (Variable) ref_ent);
      vect_chg_sgn(pv);
      aapc = contrainte_make(pv);
      aapc->succ = newnew_pc;
      newnew_pc = aapc;
    }
    else if(value_mone_p(xc) && (min_or_max == IS_MAX)) {
      vect_erase_var(&pv, (Variable) ref_ent);
      aapc = contrainte_make(pv);
      aapc->succ = newnew_pc;
      newnew_pc = aapc;
    }
  }
  return(newnew_pc);
}
 
 
/*================================================================== */
list vectors_to_expressions(pc)
Pcontrainte pc;
{
  list lexp = NIL;
  Pcontrainte apc;
 
  for(apc = pc; apc != NULL; apc = apc->succ) {
    expression new_exp = make_vecteur_expression(apc->vecteur);
    ADD_ELEMENT_TO_LIST(lexp, EXPRESSION, new_exp);
  }
  return(lexp);
}
 
 
/*================================================================== */
Pcontrainte expressions_to_vectors(lexp)
list lexp;
{
  list ll;
  Pcontrainte epc = CONTRAINTE_UNDEFINED, pc = CONTRAINTE_UNDEFINED;
 
  for(ll = lexp; !ENDP(ll); POP(ll)){
    Pvecteur pv;
    expression cexp = EXPRESSION(CAR(ll));
    normalized cnor;
 
    cnor = NORMALIZE_EXPRESSION(cexp);
    if(normalized_tag(cnor) == is_normalized_complex)
      pips_internal_error("Expressions MUST be linear");
 
    pv = (Pvecteur) normalized_linear(cnor);
 
    if(CONTRAINTE_UNDEFINED_P(pc)) {
      pc = contrainte_make(pv);
      epc = pc;
    }
    else {
      Pcontrainte apc = contrainte_make(pv);
      epc->succ = apc;
      epc = epc->succ;
    }
  }
  return(pc);
}
 
 
/*================================================================== */
/* list simplify_minmax(list lexp, Psysteme ps_cont, int min_or_max)
 *
 * Parameters :
 *   _ lexp : list of LINEAR expressions
 *   _ ps_cont : system of equations, called the context
 *   _ min_or_max : flag, says in which case we are (MIN or MAX)
 *
 * Result : list of LINEAR expressions
 *
 * Aims : simplify "lexp", i.e. suppress one or more of its
 * expressions. A given expression can be suppressed if it surely
 * smaller (case MAX) or greater (case MIN) than one of the other. The
 * case (MIN or MAX) is given by "min_or_max". If two expressions can
 * not be compared, both are kept.The context allows the user to
 * introduce relationship between variables without which some vectors
 * can not be eliminate.
 *
 * Algorithm : see simplify_minmax_contrainte().
 *
 * Note : "lexp" is not changed, the returned list of expressions is a
 * new one. */
list simplify_minmax(lexp, ps_cont, min_or_max)
list lexp;
Psysteme ps_cont;
int min_or_max;
{
  list new_lexp = NIL;
  Pcontrainte pc, new_pc;
 
  pc = expressions_to_vectors(lexp);
 
  new_pc = simplify_minmax_contrainte(pc, ps_cont, min_or_max);
 
  new_lexp = vectors_to_expressions(new_pc);
 
  return(new_lexp);
}
 
 
/* ======================================================================== */
/*
 * Psysteme find_implicit_equation(Psysteme ps)
 *
 * Returns a system containing the implicit equations of the system "ps".
 *
 * Each inequality may hides an implicit equation which means that all
 * solutions verify this equation.  In order to find these implicit
 * equations, we have to test all the inequalities.
 *
 * Let Expr <= 0 be the current inequality, we replace it with Expr + 1 <=
 * 0.  If the system is infeasible then we have found an implicit
 * equation.
 *
 * Explanation: Expr + 1 <= 0 means Expr <= -1. Then, if the new system is
 * infeasible though the original one is feasible, then Expr = 0 is
 * verified by all the solutions of the original system (it is an implicit
 * equation).
 * */
Psysteme find_implicit_equation(Psysteme ps)
{
  Pcontrainte ineg, eg;
  Psysteme impl_ps, aux_ps;
 
  if(ps == NULL)
    return(NULL);
 
  /* We put the equalities of the system in our implicit system. */
  impl_ps = sc_new();
  for(eg = ps->egalites; eg != NULL; eg = eg->succ)
    sc_add_egalite(impl_ps, contrainte_dup(eg));
 
  /* We duplicate "ps" in order to keep it unchanged. */
  aux_ps = sc_dup(ps);
 
  /* We make the test on each inequality. We count them. */
  for(ineg = aux_ps->inegalites; ineg != NULL; ineg = ineg->succ) {
    Pvecteur expr;
 
    /* We replace the original inequality (Expr <= 0) by the modified
     * one (Expr + 1 <= 0).
     */
    expr = ineg->vecteur;
    ineg->vecteur = vect_add(expr, vect_new(TCST, VALUE_ONE));
 
    /* We test the feasibility. If it is not feasible, we add one more
     * implicit equation in our implicit system : Expr == 0.
     */
    if(! sc_rational_feasibility_ofl_ctrl(aux_ps, NO_OFL_CTRL, true)) {
      Pcontrainte pc_expr = contrainte_make(expr);
 
      if(get_debug_level() > 7) {
        fprintf(stderr, "Equation implicit : ");
        pu_egalite_fprint(stderr, pc_expr, entity_local_name);
        fprintf(stderr, "\n");
      }
      sc_add_egalite(impl_ps, pc_expr);
    }
 
    /* We put the old value back */
    ineg->vecteur = expr;
  }
 
  sc_creer_base(impl_ps);
  impl_ps = sc_normalize(impl_ps);
 
  return(impl_ps);
}
 
 
 
/* These three functions respectively initialize, return and reset the
   static map of the static control on the statements. */
 
static statement_mapping current_stco_map = hash_table_undefined;
 
/* ======================================================================== */
void set_current_stco_map(statement_mapping scm)
{
  pips_assert("current_stco_map is defined", current_stco_map ==
              hash_table_undefined);
 
  current_stco_map = scm;
}
 
/* ======================================================================== */
statement_mapping get_current_stco_map(void)
{
  return current_stco_map;
}
 
/* ======================================================================== */
void reset_current_stco_map(void)
{
  current_stco_map = hash_table_undefined;
}
 
/* ======================================================================== */
static_control get_stco_from_current_map(statement s)
{
  statement_mapping STS = get_current_stco_map();
 
  return((static_control) GET_STATEMENT_MAPPING(STS,s));
}
 
/*======================================================================*/
/* expression make_rational_exp(v, d)
 *
 * From the vector v and the integer d creates the expression of the
 * following form: v/d .  AC 94/03/25
 *
 * Modification: this is an extension that verifies that v is not a
 * multiple of d, in which case it can be simplified, and no divide
 * operation is needed.  AP 94/08/19 */
 
expression make_rational_exp(v, d)
Pvecteur    v;
Value       d;
{
  expression e;
 
  if(VECTEUR_NUL_P(v))
    /* make a "zero" expression */
    e = int_to_expression(0);
  else if(value_zero_p(value_mod(vect_pgcd_all(v), value_abs(d))))
    /* divide "v" by "d", and make the expression with no denominator */
      e = make_vecteur_expression(vect_div(v, d));
  else {
      expression  e1, e2;
      entity      ent;
      list        le = NIL;
 
    /* build the denominator */
    e2 = Value_to_expression(d);
    le = CONS(EXPRESSION, e2, NIL);
 
    /* build the numerator */
    vect_normalize(v);
    e1 = make_vecteur_expression(v);
    le = CONS(EXPRESSION, e1, le);
 
    /* create the symbol of dividing */
    ent = gen_find_tabulated(make_entity_fullname(TOP_LEVEL_MODULE_NAME,
                                                  DIVIDE_OPERATOR_NAME),
                             entity_domain);
 
    /* make the expression */
    e = make_expression(make_syntax(is_syntax_call,
                                    make_call(ent, le)),
                        normalized_undefined);
  }
 
  return(e);
}
 
 
 
/* AP, sep 25th 1995 : I have added a function from
   static_controlise/utils.c */
 
/*=======================================================================*/
/* int stco_common_loops_of_statements(in_map, in_s, in_s2 )    AL 22/10/93
 * Input    : A statement mapping in_map wich associates a static_control
 *              to each statement, and two statements in_s and in_s2.
 * Output   : Number of same enclosing loops around ins_s and in_s2.
 */
int stco_common_loops_of_statements(in_map, in_s, in_s2 )
statement_mapping       in_map;
statement               in_s, in_s2;
{
        debug(9, "stco_common_loops_of_statements","doing\n");
        return( gen_length(stco_same_loops( in_map, in_s, in_s2 )) );
}