[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.44 and 1.72

version 1.44, 2013/02/27 17:11:43 version 1.72, 2020/01/10 11:15:46
Line 1 Line 1
 /*  /*
 ================================================================================  ================================================================================
   RPL/2 (R) version 4.1.13    RPL/2 (R) version 4.1.32
   Copyright (C) 1989-2013 Dr. BERTRAND Joël    Copyright (C) 1989-2020 Dr. BERTRAND Joël
   
   This file is part of RPL/2.    This file is part of RPL/2.
   
Line 27 Line 27
 ================================================================================  ================================================================================
   Fonction 'neg'    Fonction 'neg'
 ================================================================================  ================================================================================
   Entrées :    Entrées :
 --------------------------------------------------------------------------------  --------------------------------------------------------------------------------
   Sorties :    Sorties :
 --------------------------------------------------------------------------------  --------------------------------------------------------------------------------
   Effets de bord : néant    Effets de bord : néant
 ================================================================================  ================================================================================
 */  */
   
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 112  instruction_neg(struct_processus *s_etat Line 112  instruction_neg(struct_processus *s_etat
   
     if ((*s_objet_argument).type == INT)      if ((*s_objet_argument).type == INT)
     {      {
         if ((s_objet_resultat = copie_objet(s_etat_processus,          if ((*((integer8 *) (*s_objet_argument).objet)) != INT64_MIN)
                 s_objet_argument, 'Q')) == NULL)  
         {          {
             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;              if ((s_objet_resultat = copie_objet(s_etat_processus,
             return;                      s_objet_argument, 'Q')) == NULL)
         }              {
                   (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   return;
               }
   
         /*              /*
          * 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...
          */               */
   
         if ((*((integer8 *) (*s_objet_argument).objet)) != 0)              if ((*((integer8 *) (*s_objet_argument).objet)) != 0)
               {
                   (*((integer8 *) (*s_objet_resultat).objet)) =
                           -(*((integer8 *) (*s_objet_argument).objet));
               }
           }
           else
         {          {
             (*((integer8 *) (*s_objet_resultat).objet)) =              if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
                     -(*((integer8 *) (*s_objet_argument).objet));              {
                   (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   return;
               }
   
               (*((real8 *) (*s_objet_resultat).objet)) =
                       -((real8) (*((integer8 *) (*s_objet_argument).objet)));
   
         }          }
     }      }
   
 /*  /*
 --------------------------------------------------------------------------------  --------------------------------------------------------------------------------
   Opposition d'un réel    Opposition d'un réel
 --------------------------------------------------------------------------------  --------------------------------------------------------------------------------
 */  */
   
Line 194  instruction_neg(struct_processus *s_etat Line 209  instruction_neg(struct_processus *s_etat
   
     else if ((*s_objet_argument).type == VIN)      else if ((*s_objet_argument).type == VIN)
     {      {
         if ((s_objet_resultat = copie_objet(s_etat_processus,          drapeau = d_faux;
                 s_objet_argument, 'Q')) == NULL)  
           for(i = 0; i < (*((struct_vecteur *) (*s_objet_argument).objet))
                   .taille; i++)
         {          {
             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;              if (((integer8 *) (*((struct_vecteur *)
             return;                      (*s_objet_argument).objet)).tableau)[i] == INT64_MIN)
               {
                   drapeau = d_vrai;
                   break;
               }
         }          }
   
         for(i = 0; i < (*(((struct_vecteur *) (*s_objet_argument).objet)))          if (drapeau == d_vrai)
                 .taille; i++)  
         {          {
             if (((integer8 *) (*(((struct_vecteur *)              if ((s_objet_resultat = allocation(s_etat_processus, VRL)) == NULL)
                     (*s_objet_argument).objet))).tableau)[i] != 0)  
             {              {
                 ((integer8 *) (*(((struct_vecteur *) (*s_objet_resultat)                  (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                         .objet))).tableau)[i] = -((integer8 *)                  return;
                         (*(((struct_vecteur *)              }
                         (*s_objet_argument).objet))).tableau)[i];  
               if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
                       malloc(((size_t) (*((struct_vecteur *) (*s_objet_argument)
                       .objet)).taille) * sizeof(real8))) == NULL)
               {
                   (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   return;
               }
   
               for(i = 0; i < (*((struct_vecteur *) (*s_objet_argument).objet))
                       .taille; i++)
               {
                   if (((real8 *) (*(((struct_vecteur *)
                           (*s_objet_argument).objet))).tableau)[i] != 0)
                   {
                       ((real8 *) (*((struct_vecteur *) (*s_objet_resultat)
                               .objet)).tableau)[i] = -((real8) ((integer8 *)
                               (*((struct_vecteur *)
                               (*s_objet_argument).objet)).tableau)[i]);
                   }
                   else
                   {
                       ((real8 *) (*((struct_vecteur *) (*s_objet_resultat)
                               .objet)).tableau)[i] = 0;
                   }
               }
           }
           else
           {
               if ((s_objet_resultat = copie_objet(s_etat_processus,
                       s_objet_argument, 'Q')) == NULL)
               {
                   (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   return;
               }
   
               for(i = 0; i < (*(((struct_vecteur *) (*s_objet_argument).objet)))
                       .taille; i++)
               {
                   if (((integer8 *) (*(((struct_vecteur *)
                           (*s_objet_argument).objet))).tableau)[i] != 0)
                   {
                       ((integer8 *) (*(((struct_vecteur *) (*s_objet_resultat)
                               .objet))).tableau)[i] = -((integer8 *)
                               (*(((struct_vecteur *)
                               (*s_objet_argument).objet))).tableau)[i];
                   }
             }              }
         }          }
     }      }
   
 /*  /*
 --------------------------------------------------------------------------------  --------------------------------------------------------------------------------
   Opposition d'un vecteur de réels    Opposition d'un vecteur de réels
 --------------------------------------------------------------------------------  --------------------------------------------------------------------------------
 */  */
   
Line 293  instruction_neg(struct_processus *s_etat Line 358  instruction_neg(struct_processus *s_etat
   
     else if ((*s_objet_argument).type == MIN)      else if ((*s_objet_argument).type == MIN)
     {      {
         if ((s_objet_resultat = copie_objet(s_etat_processus,          drapeau = d_faux;
                 s_objet_argument, 'Q')) == NULL)  
         {  
             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;  
             return;  
         }  
   
         for(i = 0; i < (*(((struct_matrice *) (*s_objet_argument).objet)))          for(i = 0; i < (*((struct_matrice *) (*s_objet_argument).objet))
                 .nombre_lignes; i++)                  .nombre_lignes; i++)
         {          {
             for(j = 0; j < (*(((struct_matrice *) (*s_objet_argument).objet)))              for(j = 0; j < (*((struct_matrice *) (*s_objet_argument).objet))
                     .nombre_colonnes; j++)                      .nombre_colonnes; j++)
             {              {
                 if (((integer8 **) (*(((struct_matrice *) (*s_objet_argument)                  if (((integer8 **) (*((struct_matrice *)
                         .objet))).tableau)[i][j] != 0)                          (*s_objet_argument).objet)).tableau)[i][j] == INT64_MIN)
                 {                  {
                     ((integer8 **) (*(((struct_matrice *) (*s_objet_resultat)                      drapeau = d_vrai;
                             .objet))).tableau)[i][j] = -((integer8 **)                      break;
                             (*(((struct_matrice *)                  }
                             (*s_objet_argument).objet))).tableau)[i][j];              }
   
               if (drapeau == d_vrai)
               {
                   break;
               }
           }
   
           if (drapeau == d_vrai)
           {
               if ((s_objet_resultat = allocation(s_etat_processus, MRL)) == NULL)
               {
                   (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   return;
               }
   
               if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
                       malloc(((size_t) (*((struct_matrice *) (*s_objet_argument)
                       .objet)).nombre_lignes) * sizeof(real8 *))) == NULL)
               {
                   (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   return;
               }
   
               for(i = 0; i < (*((struct_matrice *) (*s_objet_argument).objet))
                       .nombre_lignes; i++)
               {
                   if ((((real8 **) (*((struct_matrice *) (*s_objet_resultat)
                           .objet)).tableau)[i] = malloc(((size_t)
                           ((*((struct_matrice *) (*s_objet_argument).objet))
                           .nombre_colonnes)) * sizeof(real8))) == NULL)
                   {
                       (*s_etat_processus).erreur_systeme =
                               d_es_allocation_memoire;
                       return;
                   }
   
                   for(j = 0; j < (*((struct_matrice *) (*s_objet_argument)
                           .objet)).nombre_colonnes; j++)
                   {
                       if (((integer8 **) (*((struct_matrice *)
                               (*s_objet_argument).objet)).tableau)[i][j] != 0)
                       {
                           ((real8 **) (*((struct_matrice *) (*s_objet_resultat)
                                   .objet)).tableau)[i][j] = -((real8)
                                   ((integer8 **) (*(((struct_matrice *)
                                   (*s_objet_argument).objet))).tableau)[i][j]);
                       }
                       else
                       {
                           ((real8 **) (*((struct_matrice *) (*s_objet_resultat)
                                   .objet)).tableau)[i][j] = 0;
                       }
                   }
               }
           }
           else
           {
               if ((s_objet_resultat = copie_objet(s_etat_processus,
                       s_objet_argument, 'Q')) == NULL)
               {
                   (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   return;
               }
   
               for(i = 0; i < (*((struct_matrice *) (*s_objet_argument).objet))
                       .nombre_lignes; i++)
               {
                   for(j = 0; j < (*((struct_matrice *) (*s_objet_argument)
                           .objet)).nombre_colonnes; j++)
                   {
                       if (((integer8 **) (*((struct_matrice *)
                               (*s_objet_argument).objet)).tableau)[i][j] != 0)
                       {
                           ((integer8 **) (*((struct_matrice *)
                                   (*s_objet_resultat).objet)).tableau)[i][j] =
                                   -((integer8 **) (*((struct_matrice *)
                                   (*s_objet_argument).objet)).tableau)[i][j];
                       }
                 }                  }
             }              }
         }          }
Line 320  instruction_neg(struct_processus *s_etat Line 458  instruction_neg(struct_processus *s_etat
   
 /*  /*
 --------------------------------------------------------------------------------  --------------------------------------------------------------------------------
   Opposition d'une matrice de réels    Opposition d'une matrice de réels
 --------------------------------------------------------------------------------  --------------------------------------------------------------------------------
 */  */
   
Line 641  instruction_neg(struct_processus *s_etat Line 779  instruction_neg(struct_processus *s_etat
 ================================================================================  ================================================================================
   Fonction 'not'    Fonction 'not'
 ================================================================================  ================================================================================
   Entrées : pointeur sur une struct_processus    Entrées : pointeur sur une struct_processus
 --------------------------------------------------------------------------------  --------------------------------------------------------------------------------
   Sorties :    Sorties :
 --------------------------------------------------------------------------------  --------------------------------------------------------------------------------
   Effets de bord : néant    Effets de bord : néant
 ================================================================================  ================================================================================
 */  */
   
Line 978  instruction_not(struct_processus *s_etat Line 1116  instruction_not(struct_processus *s_etat
 ================================================================================  ================================================================================
   Fonction '<>'    Fonction '<>'
 ================================================================================  ================================================================================
   Entrées :    Entrées :
 --------------------------------------------------------------------------------  --------------------------------------------------------------------------------
   Sorties :    Sorties :
 --------------------------------------------------------------------------------  --------------------------------------------------------------------------------
   Effets de bord : néant    Effets de bord : néant
 ================================================================================  ================================================================================
 */  */
   
Line 1003  instruction_ne(struct_processus *s_etat_ Line 1141  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 1084  instruction_ne(struct_processus *s_etat_ Line 1222  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 1320  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 1344  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 1472  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 1600  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 1702  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 1839  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 1931  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 2044  instruction_ne(struct_processus *s_etat_ Line 2182  instruction_ne(struct_processus *s_etat_
 ================================================================================  ================================================================================
   Fonction 'next'    Fonction 'next'
 ================================================================================  ================================================================================
   Entrées :    Entrées :
 --------------------------------------------------------------------------------  --------------------------------------------------------------------------------
   Sorties :    Sorties :
 --------------------------------------------------------------------------------  --------------------------------------------------------------------------------
   Effets de bord : néant    Effets de bord : néant
 ================================================================================  ================================================================================
 */  */
   
Line 2124  instruction_next(struct_processus *s_eta Line 2262  instruction_next(struct_processus *s_eta
          * 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)
Line 2158  instruction_next(struct_processus *s_eta Line 2296  instruction_next(struct_processus *s_eta
         /*          /*
          * Empilement pour calculer le nouvel indice. Au passage, la           * Empilement pour calculer le nouvel indice. Au passage, la
          * variable (*(*s_etat_processus).l_base_pile_systeme).indice_boucle           * variable (*(*s_etat_processus).l_base_pile_systeme).indice_boucle
          * est libérée.           * est libérée.
          */           */
   
         if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),          if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
Line 2205  instruction_next(struct_processus *s_eta Line 2343  instruction_next(struct_processus *s_eta
         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;
Line 2301  instruction_next(struct_processus *s_eta Line 2439  instruction_next(struct_processus *s_eta
     { // FORALL      { // FORALL
         if ((*(*(*s_etat_processus).l_base_pile_systeme).limite_indice_boucle)          if ((*(*(*s_etat_processus).l_base_pile_systeme).limite_indice_boucle)
                 .type == NON)                  .type == NON)
         { // L'objet initial était vide.          { // L'objet initial était vide.
             (*s_etat_processus).niveau_courant--;              (*s_etat_processus).niveau_courant--;
             depilement_pile_systeme(s_etat_processus);              depilement_pile_systeme(s_etat_processus);
   
Line 2462  instruction_next(struct_processus *s_eta Line 2600  instruction_next(struct_processus *s_eta
 ================================================================================  ================================================================================
   Fonction 'nrand'    Fonction 'nrand'
 ================================================================================  ================================================================================
   Entrées : structure processus    Entrées : structure processus
 -------------------------------------------------------------------------------  -------------------------------------------------------------------------------
   Sorties :    Sorties :
 --------------------------------------------------------------------------------  --------------------------------------------------------------------------------
   Effets de bord : néant    Effets de bord : néant
 ================================================================================  ================================================================================
 */  */
   
Removed from v.1.44  
changed lines
  Added in v.1.72

CVSweb interface <joel.bertrand@systella.fr>