Diff for /rpl/src/instructions_e1.c between versions 1.7 and 1.74

version 1.7, 2010/04/21 13:45:47 version 1.74, 2023/08/07 17:42:54
Line 1 Line 1
 /*  /*
 ================================================================================  ================================================================================
   RPL/2 (R) version 4.0.15    RPL/2 (R) version 4.1.35
   Copyright (C) 1989-2010 Dr. BERTRAND Joël    Copyright (C) 1989-2023 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 114  instruction_eval(struct_processus *s_eta Line 114  instruction_eval(struct_processus *s_eta
         return;          return;
     }      }
   
     if ((s_objet_simplifie = simplification(s_etat_processus, s_objet)) == NULL)      if ((*s_etat_processus).l_base_pile_systeme == NULL)
     {      {
         if (last_valide == d_vrai)          (*s_etat_processus).erreur_systeme = d_es_pile_vide;
           return;
       }
   
       if (test_cfsf(s_etat_processus, 46) == d_vrai)
       {
           (*(*s_etat_processus).l_base_pile_systeme).evaluation_expression =
                   d_vrai;
   
           if (evaluation(s_etat_processus, s_objet, 'E') == d_erreur)
         {          {
             sf(s_etat_processus, 31);              (*(*s_etat_processus).l_base_pile_systeme)
                       .evaluation_expression = d_faux;
   
               if (last_valide == d_vrai)
               {
                   sf(s_etat_processus, 31);
               }
   
               liberation(s_etat_processus, s_objet);
               return;
         }          }
   
         return;          (*(*s_etat_processus).l_base_pile_systeme).evaluation_expression =
     }                  d_faux;
           liberation(s_etat_processus, s_objet);
   
     liberation(s_etat_processus, s_objet);          if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
     s_objet = s_objet_simplifie;                  &s_objet) == d_erreur)
           {
               if (last_valide == d_vrai)
               {
                   sf(s_etat_processus, 31);
               }
   
     if ((*s_etat_processus).l_base_pile_systeme == NULL)              (*s_etat_processus).erreur_execution = d_ex_manque_argument;
     {              return;
         (*s_etat_processus).erreur_systeme = d_es_pile_vide;          }
         return;  
           if ((s_objet_simplifie = simplification(s_etat_processus, s_objet))
                   == NULL)
           {
               if (last_valide == d_vrai)
               {
                   sf(s_etat_processus, 31);
               }
   
               liberation(s_etat_processus, s_objet);
               return;
           }
   
           liberation(s_etat_processus, s_objet);
           s_objet = s_objet_simplifie;
     }      }
   
     (*(*s_etat_processus).l_base_pile_systeme).evaluation_expression = d_vrai;      (*(*s_etat_processus).l_base_pile_systeme).evaluation_expression = d_vrai;
Line 185  instruction_eval(struct_processus *s_eta Line 223  instruction_eval(struct_processus *s_eta
 void  void
 instruction_end(struct_processus *s_etat_processus)  instruction_end(struct_processus *s_etat_processus)
 {  {
     struct_objet                    *s_objet;  
   
     logical1                        condition;      logical1                        condition;
   
       struct_liste_pile_systeme       *l_element_courant;
   
       struct_objet                    *s_objet;
   
     (*s_etat_processus).erreur_execution = d_ex;      (*s_etat_processus).erreur_execution = d_ex;
           
     if ((*s_etat_processus).affichage_arguments == 'Y')      if ((*s_etat_processus).affichage_arguments == 'Y')
Line 227  instruction_end(struct_processus *s_etat Line 267  instruction_end(struct_processus *s_etat
         printf("        (expression 2)]\n");          printf("        (expression 2)]\n");
         printf("    END\n\n");          printf("    END\n\n");
   
           printf("    CRITICAL\n");
           printf("        (expression)\n");
           printf("    END\n\n");
   
         printf("    DO\n");          printf("    DO\n");
         printf("        (expression)\n");          printf("        (expression)\n");
         printf("    UNTIL\n");          printf("    UNTIL\n");
Line 262  instruction_end(struct_processus *s_etat Line 306  instruction_end(struct_processus *s_etat
         return;          return;
     }      }
   
       if ((*s_etat_processus).l_base_pile_systeme == NULL)
       {
           (*s_etat_processus).erreur_systeme = d_es_processus;
           return;
       }
   
     if (((*(*s_etat_processus).l_base_pile_systeme).type_cloture == 'I')      if (((*(*s_etat_processus).l_base_pile_systeme).type_cloture == 'I')
             || ((*(*s_etat_processus).l_base_pile_systeme).type_cloture == 'J'))              || ((*(*s_etat_processus).l_base_pile_systeme).type_cloture == 'J'))
     {      {
Line 366  instruction_end(struct_processus *s_etat Line 416  instruction_end(struct_processus *s_etat
     }      }
     else if ((*(*s_etat_processus).l_base_pile_systeme).type_cloture == 'C')      else if ((*(*s_etat_processus).l_base_pile_systeme).type_cloture == 'C')
     {      {
         if ((*(*s_etat_processus).l_base_pile_systeme).clause != 'Q')          depilement_pile_systeme(s_etat_processus);
   
           if ((*s_etat_processus).erreur_systeme != d_es)
         {          {
             depilement_pile_systeme(s_etat_processus);              return;
           }
       }
       else if ((*(*s_etat_processus).l_base_pile_systeme).type_cloture == 'K')
       {
           l_element_courant = (*(*s_etat_processus).l_base_pile_systeme).suivant;
   
             if ((*s_etat_processus).erreur_systeme != d_es)          while(l_element_courant != NULL)
           {
               switch((*l_element_courant).clause)
             {              {
                 return;                  case 'K' :
                   case 'Q' :
                   case 'C' :
                   {
                       if ((*l_element_courant).clause == 'Q')
                       {
                           (*l_element_courant).clause = 'C';
                       }
                       else
                       {
                           (*l_element_courant).clause = (*(*s_etat_processus)
                                   .l_base_pile_systeme).clause;
                       }
   
                       l_element_courant = NULL;
                       break;
                   }
   
                   default :
                   {
                       l_element_courant = (*l_element_courant).suivant;
                       break;
                   }
             }              }
         }          }
         else  
           depilement_pile_systeme(s_etat_processus);
   
           if ((*s_etat_processus).erreur_systeme != d_es)
           {
               return;
           }
       }
       else if ((*(*s_etat_processus).l_base_pile_systeme).type_cloture == 'Q')
       {
           depilement_pile_systeme(s_etat_processus);
   
           if ((*s_etat_processus).erreur_systeme != d_es)
           {
               return;
           }
   
           if (pthread_mutex_unlock(&mutex_sections_critiques) != 0)
         {          {
             (*(*s_etat_processus).l_base_pile_systeme).clause = 'C';              (*s_etat_processus).erreur_systeme = d_es_processus;
               return;
         }          }
   
           (*s_etat_processus).sections_critiques--;
     }      }
     else       else
     {      {
         (*s_etat_processus).erreur_systeme = d_es_end_incoherent;          (*s_etat_processus).erreur_systeme = d_es_end_incoherent;
     }      }
Line 412  instruction_else(struct_processus *s_eta Line 513  instruction_else(struct_processus *s_eta
     unsigned char               *instruction_majuscule;      unsigned char               *instruction_majuscule;
     unsigned char               *tampon;      unsigned char               *tampon;
   
     unsigned long               niveau;      integer8                    niveau;
   
     void                        (*fonction)();      void                        (*fonction)();
   
Line 480  instruction_else(struct_processus *s_eta Line 581  instruction_else(struct_processus *s_eta
                 }                  }
   
                 if ((instruction_majuscule = conversion_majuscule(                  if ((instruction_majuscule = conversion_majuscule(
                           s_etat_processus,
                         (*s_etat_processus).instruction_courante)) == NULL)                          (*s_etat_processus).instruction_courante)) == NULL)
                 {                  {
                     free((*s_etat_processus).instruction_courante);                      free((*s_etat_processus).instruction_courante);
Line 493  instruction_else(struct_processus *s_eta Line 595  instruction_else(struct_processus *s_eta
                 {                  {
                     if (strcmp(instruction_majuscule, "END") == 0)                      if (strcmp(instruction_majuscule, "END") == 0)
                     {                      {
                         (*s_etat_processus).position_courante -= (strlen(                          (*s_etat_processus).position_courante -=
                                 instruction_majuscule) + 1);                                  (((integer8) strlen(
                                   instruction_majuscule)) + 1);
                         drapeau_fin = d_vrai;                          drapeau_fin = d_vrai;
                     }                      }
                     else                      else
Line 691  instruction_elseif(struct_processus *s_e Line 794  instruction_elseif(struct_processus *s_e
     unsigned char               *instruction_majuscule;      unsigned char               *instruction_majuscule;
     unsigned char               *tampon;      unsigned char               *tampon;
   
     unsigned long               niveau;      integer8                    niveau;
   
     void                        (*fonction)();      void                        (*fonction)();
   
Line 770  instruction_elseif(struct_processus *s_e Line 873  instruction_elseif(struct_processus *s_e
                 }                  }
   
                 if ((instruction_majuscule = conversion_majuscule(                  if ((instruction_majuscule = conversion_majuscule(
                           s_etat_processus,
                         (*s_etat_processus).instruction_courante)) == NULL)                          (*s_etat_processus).instruction_courante)) == NULL)
                 {                  {
                     free((*s_etat_processus).instruction_courante);                      free((*s_etat_processus).instruction_courante);
Line 783  instruction_elseif(struct_processus *s_e Line 887  instruction_elseif(struct_processus *s_e
                 {                  {
                     if (strcmp(instruction_majuscule, "END") == 0)                      if (strcmp(instruction_majuscule, "END") == 0)
                     {                      {
                         (*s_etat_processus).position_courante -= (strlen(                          (*s_etat_processus).position_courante -=
                                 instruction_majuscule) + 1);                                  (((integer8) strlen(
                                   instruction_majuscule)) + 1);
                         drapeau_fin = d_vrai;                          drapeau_fin = d_vrai;
                     }                      }
                     else                      else
Line 972  instruction_elseif(struct_processus *s_e Line 1077  instruction_elseif(struct_processus *s_e
 void  void
 instruction_sensible_e(struct_processus *s_etat_processus)  instruction_sensible_e(struct_processus *s_etat_processus)
 {  {
       (*s_etat_processus).instruction_sensible = 'Y';
   
     if (strcmp((*s_etat_processus).instruction_courante, "e") == 0)      if (strcmp((*s_etat_processus).instruction_courante, "e") == 0)
     {      {
         instruction_e(s_etat_processus);          instruction_e(s_etat_processus);
Line 1132  instruction_eng(struct_processus *s_etat Line 1239  instruction_eng(struct_processus *s_etat
                 return;                  return;
             }              }
   
             (*((logical8 *) (*s_objet).objet)) =              (*((logical8 *) (*s_objet).objet)) = (logical8)
                     (*((integer8 *) (*s_objet_argument).objet));                      (*((integer8 *) (*s_objet_argument).objet));
   
             i43 = test_cfsf(s_etat_processus, 43);              i43 = test_cfsf(s_etat_processus, 43);
Line 1170  instruction_eng(struct_processus *s_etat Line 1277  instruction_eng(struct_processus *s_etat
             {              {
                 if (valeur_binaire[i] == '0')                  if (valeur_binaire[i] == '0')
                 {                  {
                     cf(s_etat_processus, j++);                      cf(s_etat_processus, (unsigned char) j++);
                 }                  }
                 else                  else
                 {                  {
                     sf(s_etat_processus, j++);                      sf(s_etat_processus, (unsigned char) j++);
                 }                  }
             }              }
   
             for(; j <= 56; cf(s_etat_processus, j++));              for(; j <= 56; cf(s_etat_processus, (unsigned char) j++));
   
             sf(s_etat_processus, 49);              sf(s_etat_processus, 49);
             sf(s_etat_processus, 50);              sf(s_etat_processus, 50);

Removed from v.1.7  
changed lines
  Added in v.1.74


CVSweb interface <joel.bertrand@systella.fr>