[BACK]Return to instructions_n1.c CVS log [TXT] [DIR] Up to [local] / rpl / src

Diff for /rpl/src/instructions_n1.c between versions 1.9 and 1.45

version 1.9, 2010/05/24 10:58:33 version 1.45, 2013/03/20 22:24:36
Line 1 Line 1
 /*  /*
 ================================================================================  ================================================================================
   RPL/2 (R) version 4.0.16    RPL/2 (R) version 4.1.13
   Copyright (C) 1989-2010 Dr. BERTRAND Joël    Copyright (C) 1989-2013 Dr. BERTRAND Joël
   
   This file is part of RPL/2.    This file is part of RPL/2.
   
Line 20 Line 20
 */  */
   
   
 #include "rpl.conv.h"  #include "rpl-conv.h"
   
   
 /*  /*
Line 48  instruction_neg(struct_processus *s_etat Line 48  instruction_neg(struct_processus *s_etat
     struct_objet                *s_objet_argument;      struct_objet                *s_objet_argument;
     struct_objet                *s_objet_resultat;      struct_objet                *s_objet_resultat;
   
     unsigned long               i;      integer8                    i;
     unsigned long               j;      integer8                    j;
   
     (*s_etat_processus).erreur_execution = d_ex;      (*s_etat_processus).erreur_execution = d_ex;
   
Line 120  instruction_neg(struct_processus *s_etat Line 120  instruction_neg(struct_processus *s_etat
         }          }
   
         /*          /*
          * Permet d'éviter les résultats du type -0. Valable pour tous           * Permet d'éviter les résultats du type -0. Valable pour tous
          * les types...           * les types...
          */           */
   
Line 133  instruction_neg(struct_processus *s_etat Line 133  instruction_neg(struct_processus *s_etat
   
 /*  /*
 --------------------------------------------------------------------------------  --------------------------------------------------------------------------------
   Opposition d'un réel    Opposition d'un réel
 --------------------------------------------------------------------------------  --------------------------------------------------------------------------------
 */  */
   
Line 217  instruction_neg(struct_processus *s_etat Line 217  instruction_neg(struct_processus *s_etat
   
 /*  /*
 --------------------------------------------------------------------------------  --------------------------------------------------------------------------------
   Opposition d'un vecteur de réels    Opposition d'un vecteur de réels
 --------------------------------------------------------------------------------  --------------------------------------------------------------------------------
 */  */
   
Line 320  instruction_neg(struct_processus *s_etat Line 320  instruction_neg(struct_processus *s_etat
   
 /*  /*
 --------------------------------------------------------------------------------  --------------------------------------------------------------------------------
   Opposition d'une matrice de réels    Opposition d'une matrice de réels
 --------------------------------------------------------------------------------  --------------------------------------------------------------------------------
 */  */
   
Line 667  instruction_not(struct_processus *s_etat Line 667  instruction_not(struct_processus *s_etat
   
         if ((*s_etat_processus).langue == 'F')          if ((*s_etat_processus).langue == 'F')
         {          {
             printf("(complément)\n\n");              printf("(complément)\n\n");
         }          }
         else          else
         {          {
Line 1003  instruction_ne(struct_processus *s_etat_ Line 1003  instruction_ne(struct_processus *s_etat_
   
     logical1                    difference;      logical1                    difference;
   
     unsigned long               i;      integer8                    i;
     unsigned long               j;      integer8                    j;
     unsigned long               nombre_elements;      integer8                    nombre_elements;
   
     (*s_etat_processus).erreur_execution = d_ex;      (*s_etat_processus).erreur_execution = d_ex;
   
Line 1015  instruction_ne(struct_processus *s_etat_ Line 1015  instruction_ne(struct_processus *s_etat_
   
         if ((*s_etat_processus).langue == 'F')          if ((*s_etat_processus).langue == 'F')
         {          {
             printf("(opérateur différence)\n\n");              printf("(opérateur différence)\n\n");
         }          }
         else          else
         {          {
Line 1084  instruction_ne(struct_processus *s_etat_ Line 1084  instruction_ne(struct_processus *s_etat_
   
 /*  /*
 --------------------------------------------------------------------------------  --------------------------------------------------------------------------------
   SAME NOT sur des valeurs numériques    SAME NOT sur des valeurs numériques
 --------------------------------------------------------------------------------  --------------------------------------------------------------------------------
 */  */
   
Line 1182  instruction_ne(struct_processus *s_etat_ Line 1182  instruction_ne(struct_processus *s_etat_
   
 /*  /*
 --------------------------------------------------------------------------------  --------------------------------------------------------------------------------
   SAME NOT portant sur des chaînes de caractères    SAME NOT portant sur des chaînes de caractères
 --------------------------------------------------------------------------------  --------------------------------------------------------------------------------
 */  */
   
Line 1206  instruction_ne(struct_processus *s_etat_ Line 1206  instruction_ne(struct_processus *s_etat_
 --------------------------------------------------------------------------------  --------------------------------------------------------------------------------
 */  */
     /*      /*
      * Il y a de la récursivité dans l'air...       * Il y a de la récursivité dans l'air...
      */       */
   
     else if ((((*s_objet_argument_1).type == LST) &&      else if ((((*s_objet_argument_1).type == LST) &&
Line 1334  instruction_ne(struct_processus *s_etat_ Line 1334  instruction_ne(struct_processus *s_etat_
     }      }
   
     /*      /*
      * Vecteurs de réels       * Vecteurs de réels
      */       */
   
     else if (((*s_objet_argument_1).type == VRL) &&      else if (((*s_objet_argument_1).type == VRL) &&
Line 1462  instruction_ne(struct_processus *s_etat_ Line 1462  instruction_ne(struct_processus *s_etat_
     }      }
   
     /*      /*
      * Matrice de réels       * Matrice de réels
      */       */
   
     else if (((*s_objet_argument_1).type == MRL) &&      else if (((*s_objet_argument_1).type == MRL) &&
Line 1564  instruction_ne(struct_processus *s_etat_ Line 1564  instruction_ne(struct_processus *s_etat_
 */  */
   
     /*      /*
      * Nom ou valeur numérique / Nom ou valeur numérique       * Nom ou valeur numérique / Nom ou valeur numérique
      */       */
   
     else if ((((*s_objet_argument_1).type == NOM) &&      else if ((((*s_objet_argument_1).type == NOM) &&
Line 1701  instruction_ne(struct_processus *s_etat_ Line 1701  instruction_ne(struct_processus *s_etat_
     }      }
   
     /*      /*
      * Nom ou valeur numérique / Expression       * Nom ou valeur numérique / Expression
      */       */
   
     else if (((((*s_objet_argument_1).type == ALG) ||      else if (((((*s_objet_argument_1).type == ALG) ||
Line 1793  instruction_ne(struct_processus *s_etat_ Line 1793  instruction_ne(struct_processus *s_etat_
     }      }
   
     /*      /*
      * Expression / Nom ou valeur numérique       * Expression / Nom ou valeur numérique
      */       */
   
     else if ((((*s_objet_argument_1).type == NOM) ||      else if ((((*s_objet_argument_1).type == NOM) ||
Line 2058  instruction_next(struct_processus *s_eta Line 2058  instruction_next(struct_processus *s_eta
     struct_objet                *s_objet;      struct_objet                *s_objet;
     struct_objet                *s_copie_objet;      struct_objet                *s_copie_objet;
   
       logical1                    fin_boucle;
     logical1                    presence_compteur;      logical1                    presence_compteur;
   
     (*s_etat_processus).erreur_execution = d_ex;      (*s_etat_processus).erreur_execution = d_ex;
Line 2068  instruction_next(struct_processus *s_eta Line 2069  instruction_next(struct_processus *s_eta
   
         if ((*s_etat_processus).langue == 'F')          if ((*s_etat_processus).langue == 'F')
         {          {
             printf("(fin d'une boucle définie)\n\n");              printf("(fin d'une boucle définie)\n\n");
         }          }
         else          else
         {          {
Line 2106  instruction_next(struct_processus *s_eta Line 2107  instruction_next(struct_processus *s_eta
         return;          return;
     }      }
   
     presence_compteur = ((*(*s_etat_processus).l_base_pile_systeme)      if ((*(*s_etat_processus).l_base_pile_systeme).type_cloture != 'A')
             .type_cloture == 'F') ? d_vrai : d_faux;      { // FOR ou START
           presence_compteur = ((*(*s_etat_processus).l_base_pile_systeme)
                   .type_cloture == 'F') ? d_vrai : d_faux;
   
     if (((*(*s_etat_processus).l_base_pile_systeme).type_cloture != 'S')          if (((*(*s_etat_processus).l_base_pile_systeme).type_cloture != 'S')
             && (presence_compteur == d_faux))                  && (presence_compteur == d_faux))
     {          {
         (*s_etat_processus).erreur_execution = d_ex_erreur_traitement_boucle;              (*s_etat_processus).erreur_execution =
         return;                      d_ex_erreur_traitement_boucle;
     }              return;
           }
   
     /*          /*
      * Pour une boucle avec indice, on fait pointer            * Pour une boucle avec indice, on fait pointer 
      * (*(*s_etat_processus).l_base_pile_systeme).indice_boucle sur           * (*(*s_etat_processus).l_base_pile_systeme).indice_boucle sur
      * la variable correspondante. Remarque, le contenu de la variable           * la variable correspondante. Remarque, le contenu de la variable
      * est détruit au courant de l'opération.           * est détruit au courant de l'opération.
      */           */
   
     if (presence_compteur == d_vrai)          if (presence_compteur == d_vrai)
     {  
         if (recherche_variable(s_etat_processus, (*(*s_etat_processus)  
                 .l_base_pile_systeme).nom_variable) == d_faux)  
         {          {
             (*s_etat_processus).erreur_execution = d_ex_variable_non_definie;              if (recherche_variable(s_etat_processus, (*(*s_etat_processus)
             return;                      .l_base_pile_systeme).nom_variable) == d_faux)
               {
                   (*s_etat_processus).erreur_execution =
                           d_ex_variable_non_definie;
                   return;
               }
   
               if ((*(*s_etat_processus).pointeur_variable_courante)
                       .variable_verrouillee == d_vrai)
               {
                   (*s_etat_processus).erreur_execution =
                           d_ex_variable_verrouillee;
                   return;
               }
   
               if ((*(*s_etat_processus).pointeur_variable_courante).objet == NULL)
               {
                   (*s_etat_processus).erreur_execution = d_ex_variable_partagee;
                   return;
               }
   
               (*(*s_etat_processus).l_base_pile_systeme).indice_boucle =
                       (*(*s_etat_processus).pointeur_variable_courante).objet;
         }          }
   
         if (((*s_etat_processus).s_liste_variables[(*s_etat_processus)          /*
                 .position_variable_courante]).variable_verrouillee == d_vrai)           * Empilement pour calculer le nouvel indice. Au passage, la
            * variable (*(*s_etat_processus).l_base_pile_systeme).indice_boucle
            * est libérée.
            */
   
           if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                   (*(*s_etat_processus).l_base_pile_systeme).indice_boucle)
                   == d_erreur)
         {          {
             (*s_etat_processus).erreur_execution = d_ex_variable_verrouillee;  
             return;              return;
         }          }
   
         if (((*s_etat_processus).s_liste_variables[(*s_etat_processus)          if ((s_objet = allocation(s_etat_processus, INT)) == NULL)
                 .position_variable_courante]).objet == NULL)  
         {          {
             (*s_etat_processus).erreur_execution = d_ex_variable_partagee;              (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
             return;              return;
         }          }
   
         (*(*s_etat_processus).l_base_pile_systeme).indice_boucle =          (*((integer8 *) (*s_objet).objet)) = 1;
                 ((*s_etat_processus).s_liste_variables[(*s_etat_processus)  
                 .position_variable_courante]).objet;  
     }  
   
     /*  
      * Empilement pour calculer le nouvel indice. Au passage, la  
      * variable (*(*s_etat_processus).l_base_pile_systeme).indice_boucle  
      * est libérée.  
      */  
   
     if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),  
             (*(*s_etat_processus).l_base_pile_systeme).indice_boucle)  
             == d_erreur)  
     {  
         return;  
     }  
   
     if ((s_objet = allocation(s_etat_processus, INT)) == NULL)          if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
     {                  s_objet) == d_erreur)
         (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;          {
         return;              return;
     }          }
   
     (*((integer8 *) (*s_objet).objet)) = 1;  
   
     if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),  
             s_objet) == d_erreur)  
     {  
         return;  
     }  
   
     instruction_plus(s_etat_processus);          instruction_plus(s_etat_processus);
   
     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),          if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
             &s_objet) == d_erreur)                  &s_objet) == d_erreur)
     {          {
         liberation(s_etat_processus, s_objet);              liberation(s_etat_processus, s_objet);
   
         (*s_etat_processus).erreur_execution = d_ex_manque_argument;              (*s_etat_processus).erreur_execution = d_ex_manque_argument;
         return;              return;
     }          }
   
     if (((*s_objet).type != INT) &&          if (((*s_objet).type != INT) && ((*s_objet).type != REL))
             ((*s_objet).type != REL))          {
     {              liberation(s_etat_processus, s_objet);
         liberation(s_etat_processus, s_objet);  
   
         (*s_etat_processus).erreur_execution = d_ex_erreur_traitement_boucle;              (*s_etat_processus).erreur_execution =
         return;                      d_ex_erreur_traitement_boucle;
     }              return;
           }
   
     if (presence_compteur == d_vrai)          if (presence_compteur == d_vrai)
     {          {
         /*              /*
          * L'addition crée si besoin une copie de l'objet               * L'addition crée si besoin une copie de l'objet
          */               */
   
         (*(*s_etat_processus).l_base_pile_systeme).indice_boucle = NULL;              (*(*s_etat_processus).l_base_pile_systeme).indice_boucle = NULL;
         ((*s_etat_processus).s_liste_variables[(*s_etat_processus)              (*(*s_etat_processus).pointeur_variable_courante).objet = s_objet;
                 .position_variable_courante]).objet = s_objet;          }
     }          else
     else          {
     {              (*(*s_etat_processus).l_base_pile_systeme).indice_boucle = s_objet;
         (*(*s_etat_processus).l_base_pile_systeme).indice_boucle = s_objet;          }
     }  
   
     if ((s_copie_objet = copie_objet(s_etat_processus, s_objet, 'P')) == NULL)          if ((s_copie_objet = copie_objet(s_etat_processus, s_objet, 'P'))
     {                  == NULL)
         (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;          {
         return;              (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
     }              return;
           }
   
     if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),          if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
             s_copie_objet) == d_erreur)                  s_copie_objet) == d_erreur)
     {          {
         return;              return;
     }          }
   
     if ((s_copie_objet = copie_objet(s_etat_processus,          if ((s_copie_objet = copie_objet(s_etat_processus,
             (*(*s_etat_processus).l_base_pile_systeme)                  (*(*s_etat_processus).l_base_pile_systeme)
             .limite_indice_boucle, 'P')) == NULL)                  .limite_indice_boucle, 'P')) == NULL)
     {          {
         (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;              (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
         return;              return;
     }          }
   
     if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),          if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
             s_copie_objet) == d_erreur)                  s_copie_objet) == d_erreur)
     {          {
         return;              return;
     }          }
   
     instruction_le(s_etat_processus);          instruction_le(s_etat_processus);
   
     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),          if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
             &s_objet) == d_erreur)                  &s_objet) == d_erreur)
     {          {
         (*s_etat_processus).erreur_execution = d_ex_manque_argument;              (*s_etat_processus).erreur_execution = d_ex_manque_argument;
         return;              return;
     }          }
   
     if ((*s_objet).type != INT)          if ((*s_objet).type != INT)
     {          {
         liberation(s_etat_processus, s_objet);              liberation(s_etat_processus, s_objet);
   
         (*s_etat_processus).erreur_execution = d_ex_erreur_traitement_boucle;              (*s_etat_processus).erreur_execution =
         return;                      d_ex_erreur_traitement_boucle;
     }              return;
           }
   
     if ((*((integer8 *) (*s_objet).objet)) != 0)          if ((*((integer8 *) (*s_objet).objet)) != 0)
     {  
         if ((*(*s_etat_processus).l_base_pile_systeme)  
                 .origine_routine_evaluation == 'N')  
         {          {
             (*s_etat_processus).position_courante = (*(*s_etat_processus)              if ((*(*s_etat_processus).l_base_pile_systeme)
                     .l_base_pile_systeme).adresse_retour;                      .origine_routine_evaluation == 'N')
               {
                   (*s_etat_processus).position_courante = (*(*s_etat_processus)
                           .l_base_pile_systeme).adresse_retour;
               }
               else
               {
                   (*s_etat_processus).expression_courante = (*(*s_etat_processus)
                           .l_base_pile_systeme).pointeur_objet_retour;
               }
         }          }
         else          else
         {          {
             (*s_etat_processus).expression_courante = (*(*s_etat_processus)              depilement_pile_systeme(s_etat_processus);
                     .l_base_pile_systeme).pointeur_objet_retour;  
               if ((*s_etat_processus).erreur_systeme != d_es)
               {
                   return;
               }
   
               if (presence_compteur == d_vrai)
               {
                   (*s_etat_processus).niveau_courant--;
   
                   if (retrait_variables_par_niveau(s_etat_processus) == d_erreur)
                   {
                       return;
                   }
               }
         }          }
   
           liberation(s_etat_processus, s_objet);
     }      }
     else      else
     {      { // FORALL
         depilement_pile_systeme(s_etat_processus);          if ((*(*(*s_etat_processus).l_base_pile_systeme).limite_indice_boucle)
                   .type == NON)
           { // L'objet initial était vide.
               (*s_etat_processus).niveau_courant--;
               depilement_pile_systeme(s_etat_processus);
   
         if ((*s_etat_processus).erreur_systeme != d_es)              liberation(s_etat_processus, (*(*s_etat_processus)
         {                      .l_base_pile_systeme).limite_indice_boucle);
             return;              return;
         }          }
           else if ((*(*(*s_etat_processus).l_base_pile_systeme)
                   .limite_indice_boucle).type == LST)
           { // FORALL sur une liste
               if ((*((struct_liste_chainee *) (*(*(*s_etat_processus)
                       .l_base_pile_systeme).indice_boucle).objet)).suivant
                       != NULL)
               {
                   if (recherche_variable(s_etat_processus, (*(*s_etat_processus)
                           .l_base_pile_systeme).nom_variable) == d_faux)
                   {
                       (*s_etat_processus).erreur_execution =
                               d_ex_variable_non_definie;
                       return;
                   }
   
         if (presence_compteur == d_vrai)                  if ((*(*s_etat_processus).pointeur_variable_courante)
                           .variable_verrouillee == d_vrai)
                   {
                       (*s_etat_processus).erreur_execution =
                               d_ex_variable_verrouillee;
                       return;
                   }
   
                   if ((*(*s_etat_processus).pointeur_variable_courante).objet
                           == NULL)
                   {
                       (*s_etat_processus).erreur_execution
                               = d_ex_variable_partagee;
                       return;
                   }
   
                   (*(*(*s_etat_processus).l_base_pile_systeme).indice_boucle)
                           .objet = (*((struct_liste_chainee *)
                           (*(*(*s_etat_processus).l_base_pile_systeme)
                           .indice_boucle).objet)).suivant;
                   liberation(s_etat_processus, (*(*s_etat_processus)
                           .pointeur_variable_courante).objet);
   
                   if (((*(*s_etat_processus).pointeur_variable_courante).objet
                           = copie_objet(s_etat_processus,
                           (*((struct_liste_chainee *) (*(*(*s_etat_processus)
                           .l_base_pile_systeme).indice_boucle).objet)).donnee,
                           'P')) == NULL)
                   {
                       (*s_etat_processus).erreur_systeme
                               = d_es_allocation_memoire;
                       return;
                   }
   
                   fin_boucle = d_faux;
               }
               else
               {
                   fin_boucle = d_vrai;
               }
           }
           else
           { // FORALL sur une table
               (*((integer8 *) (*(*(*s_etat_processus).l_base_pile_systeme)
                       .indice_boucle).objet))++;
   
               if ((*((integer8 *) (*(*(*s_etat_processus).l_base_pile_systeme)
                       .indice_boucle).objet)) < (integer8) (*((struct_tableau *)
                       (*(*(*s_etat_processus).l_base_pile_systeme)
                       .limite_indice_boucle).objet)).nombre_elements)
               {
                   if (recherche_variable(s_etat_processus, (*(*s_etat_processus)
                           .l_base_pile_systeme).nom_variable) == d_faux)
                   {
                       (*s_etat_processus).erreur_execution =
                               d_ex_variable_non_definie;
                       return;
                   }
   
                   if ((*(*s_etat_processus).pointeur_variable_courante)
                           .variable_verrouillee == d_vrai)
                   {
                       (*s_etat_processus).erreur_execution =
                               d_ex_variable_verrouillee;
                       return;
                   }
   
                   if ((*(*s_etat_processus).pointeur_variable_courante).objet
                           == NULL)
                   {
                       (*s_etat_processus).erreur_execution
                               = d_ex_variable_partagee;
                       return;
                   }
   
                   liberation(s_etat_processus, (*(*s_etat_processus)
                           .pointeur_variable_courante).objet);
   
                   if (((*(*s_etat_processus).pointeur_variable_courante).objet
                           = copie_objet(s_etat_processus, (*((struct_tableau *)
                           (*(*(*s_etat_processus).l_base_pile_systeme)
                           .limite_indice_boucle).objet)).elements[(*((integer8 *)
                           (*(*(*s_etat_processus).l_base_pile_systeme)
                           .indice_boucle).objet))], 'P')) == NULL)
                   {
                       (*s_etat_processus).erreur_systeme
                               = d_es_allocation_memoire;
                       return;
                   }
   
                   fin_boucle = d_faux;
               }
               else
               {
                   fin_boucle = d_vrai;
               }
           }
   
           if (fin_boucle == d_vrai)
         {          {
               depilement_pile_systeme(s_etat_processus);
   
               if ((*s_etat_processus).erreur_systeme != d_es)
               {
                   return;
               }
   
             (*s_etat_processus).niveau_courant--;              (*s_etat_processus).niveau_courant--;
   
             if (retrait_variable_par_niveau(s_etat_processus) == d_erreur)              if (retrait_variables_par_niveau(s_etat_processus) == d_erreur)
             {              {
                 return;                  return;
             }              }
         }          }
           else
           {
               if ((*(*s_etat_processus).l_base_pile_systeme)
                       .origine_routine_evaluation == 'N')
               {
                   (*s_etat_processus).position_courante = (*(*s_etat_processus)
                           .l_base_pile_systeme).adresse_retour;
               }
               else
               {
                   (*s_etat_processus).expression_courante = (*(*s_etat_processus)
                           .l_base_pile_systeme).pointeur_objet_retour;
               }
           }
     }      }
   
     liberation(s_etat_processus, s_objet);  
   
     return;      return;
 }  }
   
Line 2321  instruction_nrand(struct_processus *s_et Line 2483  instruction_nrand(struct_processus *s_et
   
         if ((*s_etat_processus).langue == 'F')          if ((*s_etat_processus).langue == 'F')
         {          {
             printf("(valeur aléatoire gaussienne)\n\n");              printf("(valeur aléatoire gaussienne)\n\n");
         }          }
         else          else
         {          {
Removed from v.1.9  
changed lines
  Added in v.1.45

CVSweb interface <joel.bertrand@systella.fr>