Diff for /rpl/src/instructions_v1.c between versions 1.5 and 1.39

version 1.5, 2010/03/09 10:18:49 version 1.39, 2012/04/13 14:13:01
Line 1 Line 1
 /*  /*
 ================================================================================  ================================================================================
   RPL/2 (R) version 4.0.13    RPL/2 (R) version 4.1.8
   Copyright (C) 1989-2010 Dr. BERTRAND Joël    Copyright (C) 1989-2012 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 38 Line 38
 void  void
 instruction_var(struct_processus *s_etat_processus)  instruction_var(struct_processus *s_etat_processus)
 {  {
     logical1                            presence_variable;  
   
     long                                i;  
   
     struct_objet                        *s_objet_statistique;      struct_objet                        *s_objet_statistique;
     struct_objet                        *s_objet_resultat;      struct_objet                        *s_objet_resultat;
     struct_objet                        *s_objet_temporaire;      struct_objet                        *s_objet_temporaire;
Line 85  instruction_var(struct_processus *s_etat Line 81  instruction_var(struct_processus *s_etat
      * Recherche d'une variable globale référencée par SIGMA       * Recherche d'une variable globale référencée par SIGMA
      */       */
   
     if (recherche_variable(s_etat_processus, ds_sdat) == d_faux)      if (recherche_variable_globale(s_etat_processus, ds_sdat) == d_faux)
     {      {
         /*          /*
          * Aucune variable SIGMA           * Aucune variable SIGMA
          */           */
   
         (*s_etat_processus).erreur_systeme = d_es;          (*s_etat_processus).erreur_systeme = d_es;
         (*s_etat_processus).erreur_execution = d_ex_absence_observations;  
         return;  
     }  
     else  
     {  
         /*  
          * Il existe une variable locale SIGMA. Reste à vérifier l'existence  
          * d'une variable SIGMA globale...  
          */  
   
         i = (*s_etat_processus).position_variable_courante;  
         presence_variable = d_faux;  
   
         while(i >= 0)          if ((*s_etat_processus).erreur_execution == d_ex)
         {          {
             if ((strcmp((*s_etat_processus).s_liste_variables[i].nom,              (*s_etat_processus).erreur_execution = d_ex_absence_observations;
                     ds_sdat) == 0) && ((*s_etat_processus)  
                     .s_liste_variables[i].niveau == 1))  
             {  
                 presence_variable = d_vrai;  
                 break;  
             }  
   
             i--;  
         }          }
   
         if (presence_variable == d_faux)          return;
       }
       else
       {
           if (((*(*(*s_etat_processus).pointeur_variable_courante).objet)
                   .type != MIN) && ((*(*(*s_etat_processus)
                   .pointeur_variable_courante).objet).type != MRL))
         {          {
             (*s_etat_processus).erreur_execution = d_ex_absence_observations;              (*s_etat_processus).erreur_execution =
                       d_ex_matrice_statistique_invalide;
             return;              return;
         }          }
         else  
         {  
             (*s_etat_processus).position_variable_courante = i;  
   
             if ((*s_etat_processus).s_liste_variables[i].objet == NULL)  
             {  
                 (*s_etat_processus).erreur_execution = d_ex_variable_partagee;  
                 return;  
             }  
   
             if (((*((*s_etat_processus).s_liste_variables          nombre_colonnes = (*((struct_matrice *) (*(*(*s_etat_processus)
                     [(*s_etat_processus).position_variable_courante].objet))                  .pointeur_variable_courante).objet).objet))
                     .type != MIN) && ((*((*s_etat_processus)                  .nombre_colonnes;
                     .s_liste_variables[(*s_etat_processus)  
                     .position_variable_courante].objet)).type != MRL))  
             {  
                 (*s_etat_processus).erreur_execution =  
                         d_ex_matrice_statistique_invalide;  
                 return;  
             }  
   
             nombre_colonnes = (*((struct_matrice *) (*((*s_etat_processus)  
                     .s_liste_variables[(*s_etat_processus)  
                     .position_variable_courante].objet)).objet))  
                     .nombre_colonnes;  
         }  
     }      }
   
     s_objet_statistique = ((*s_etat_processus).s_liste_variables      s_objet_statistique = (*(*s_etat_processus).pointeur_variable_courante)
             [(*s_etat_processus).position_variable_courante]).objet;              .objet;
   
     if (((*s_objet_statistique).type == MIN) ||      if (((*s_objet_statistique).type == MIN) ||
             ((*s_objet_statistique).type == MRL))              ((*s_objet_statistique).type == MRL))
Line 276  instruction_version(struct_processus *s_ Line 237  instruction_version(struct_processus *s_
     struct_objet                        *s_objet_resultat;      struct_objet                        *s_objet_resultat;
   
     unsigned char                       texte[] = "RPL/2 version ";      unsigned char                       texte[] = "RPL/2 version ";
       unsigned char                       tampon[256 + 1];
   
     (*s_etat_processus).erreur_execution = d_ex;      (*s_etat_processus).erreur_execution = d_ex;
   
Line 538  instruction_version(struct_processus *s_ Line 500  instruction_version(struct_processus *s_
         return;          return;
     }      }
   
     if (((*(*l_element_courant).donnee).objet = malloc((strlen(d_date_en_rpl)      if (((*(*l_element_courant).donnee).objet = date_compilation()) == NULL)
             + 1) * sizeof(unsigned char))) == NULL)  
     {      {
         (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;          (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
         return;          return;
     }      }
   
     strcpy((unsigned char *) (*(*l_element_courant).donnee).objet,  
             d_date_en_rpl);  
   
     /*      /*
      * Ajout des options de compilation       * Ajout des options de compilation
      */       */
Line 869  instruction_version(struct_processus *s_ Line 827  instruction_version(struct_processus *s_
         return;          return;
     }      }
   
 #ifdef DEBUG  #ifdef RPLCAS
     if (((*(*l_element_courant).donnee).objet = malloc(6 *      if (((*(*l_element_courant).donnee).objet = malloc(8 *
             sizeof(unsigned char))) == NULL)              sizeof(unsigned char))) == NULL)
     {      {
         (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;          (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
Line 878  instruction_version(struct_processus *s_ Line 836  instruction_version(struct_processus *s_
     }      }
   
     strcpy((unsigned char *) (*(*l_element_courant).donnee).objet,      strcpy((unsigned char *) (*(*l_element_courant).donnee).objet,
             "DEBUG");              "RPL/CAS");
 #else  #else
     if (((*(*l_element_courant).donnee).objet = malloc(15 *      if (((*(*l_element_courant).donnee).objet = malloc(17 *
             sizeof(unsigned char))) == NULL)              sizeof(unsigned char))) == NULL)
     {      {
         (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;          (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
Line 888  instruction_version(struct_processus *s_ Line 846  instruction_version(struct_processus *s_
     }      }
   
     strcpy((unsigned char *) (*(*l_element_courant).donnee).objet,      strcpy((unsigned char *) (*(*l_element_courant).donnee).objet,
             "DEBUG DISABLED");              "RPL/CAS DISABLED");
 #endif  #endif
   
     if (((*l_element_courant).suivant =      if (((*l_element_courant).suivant =
Line 930  instruction_version(struct_processus *s_ Line 888  instruction_version(struct_processus *s_
             "EXPERIMENTAL CODE DISABLED");              "EXPERIMENTAL CODE DISABLED");
 #endif  #endif
   
       if (((*l_element_courant).suivant =
               allocation_maillon(s_etat_processus)) == NULL)
       {
           (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
           return;
       }
   
       l_element_courant = (*l_element_courant).suivant;
       (*l_element_courant).suivant = NULL;
   
       if (((*l_element_courant).donnee = allocation(s_etat_processus, CHN))
               == NULL)
       {
           (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
           return;
       }
   
       sprintf(tampon, "%zu BITS ABI", sizeof(void *) * 8);
   
       if (((*(*l_element_courant).donnee).objet = malloc((strlen(tampon) + 1 )
               * sizeof(unsigned char))) == NULL)
       {
           (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
           return;
       }
   
       strcpy((unsigned char *) (*(*l_element_courant).donnee).objet, tampon);
   
       if (((*l_element_courant).suivant =
               allocation_maillon(s_etat_processus)) == NULL)
       {
           (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
           return;
       }
   
       l_element_courant = (*l_element_courant).suivant;
       (*l_element_courant).suivant = NULL;
   
       if (((*l_element_courant).donnee = allocation(s_etat_processus, CHN))
               == NULL)
       {
           (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
           return;
       }
   
       if (((*(*l_element_courant).donnee).objet = conversion_majuscule(HOST))
               == NULL)
       {
           (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
           return;
       }
   
     /*      /*
      * Empilement du résultat       * Empilement du résultat
      */       */
Line 959  instruction_version(struct_processus *s_ Line 969  instruction_version(struct_processus *s_
 void  void
 instruction_vars(struct_processus *s_etat_processus)  instruction_vars(struct_processus *s_etat_processus)
 {  {
       int                                 i;
       int                                 nb_variables;
   
     logical1                            variable_partagee;      logical1                            variable_partagee;
   
     struct_liste_chainee                *l_element_courant;      struct_liste_chainee                *l_element_courant;
Line 966  instruction_vars(struct_processus *s_eta Line 979  instruction_vars(struct_processus *s_eta
   
     struct_objet                        *s_objet_resultat;      struct_objet                        *s_objet_resultat;
   
     unsigned long                       i;      struct_tableau_variables            *tableau;
   
     (*s_etat_processus).erreur_execution = d_ex;      (*s_etat_processus).erreur_execution = d_ex;
   
Line 1010  instruction_vars(struct_processus *s_eta Line 1023  instruction_vars(struct_processus *s_eta
     (*s_objet_resultat).objet = NULL;      (*s_objet_resultat).objet = NULL;
     l_element_precedent = NULL;      l_element_precedent = NULL;
   
     for(i = 0; i < (*s_etat_processus).nombre_variables; i++)      nb_variables = nombre_variables(s_etat_processus,
               (*s_etat_processus).s_arbre_variables);
   
       if ((tableau = malloc(nb_variables * sizeof(struct_tableau_variables)))
               == NULL)
       {
           (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
           return;
       }
   
       liste_variables(s_etat_processus, tableau, 0,
               (*s_etat_processus).s_arbre_variables);
   
       for(i = 0; i < nb_variables; i++)
     {      {
         if (l_element_precedent == NULL)          if (l_element_precedent == NULL)
         {          {
Line 1060  instruction_vars(struct_processus *s_eta Line 1086  instruction_vars(struct_processus *s_eta
          * Mise en place d'un verrou si la variable est partagée.           * Mise en place d'un verrou si la variable est partagée.
          */           */
   
         if ((*s_etat_processus).s_liste_variables[i].objet == NULL)          if (tableau[i].objet == NULL)
         {          {
             if (pthread_mutex_lock(&((*(*s_etat_processus)              if (pthread_mutex_lock(&((*(*s_etat_processus)
                     .s_liste_variables_partagees).mutex)) != 0)                      .s_liste_variables_partagees).mutex)) != 0)
Line 1070  instruction_vars(struct_processus *s_eta Line 1096  instruction_vars(struct_processus *s_eta
             }              }
   
             if (recherche_variable_partagee(s_etat_processus,              if (recherche_variable_partagee(s_etat_processus,
                     ((*s_etat_processus).s_liste_variables[i]).nom,                      tableau[i].nom, tableau[i].variable_partagee,
                     ((*s_etat_processus).s_liste_variables[i])                      tableau[i].origine) == d_faux)
                     .variable_partagee, ((*s_etat_processus)  
                     .s_liste_variables[i]).origine) == d_faux)  
             {              {
                 // La variable partagée n'existe plus.                  // La variable partagée n'existe plus.
   
Line 1122  instruction_vars(struct_processus *s_eta Line 1146  instruction_vars(struct_processus *s_eta
   
         if (((*((struct_nom *) (*(*((struct_liste_chainee *) (*((struct_objet *)          if (((*((struct_nom *) (*(*((struct_liste_chainee *) (*((struct_objet *)
                 (*l_element_courant).donnee)).objet)).donnee).objet)).nom =                  (*l_element_courant).donnee)).objet)).donnee).objet)).nom =
                 malloc((strlen((*s_etat_processus).s_liste_variables[i].nom)                  malloc((strlen(tableau[i].nom)
                 + 1) * sizeof(unsigned char))) == NULL)                  + 1) * sizeof(unsigned char))) == NULL)
         {          {
             if (variable_partagee == d_vrai)              if (variable_partagee == d_vrai)
Line 1141  instruction_vars(struct_processus *s_eta Line 1165  instruction_vars(struct_processus *s_eta
   
         strcpy((*((struct_nom *) (*(*((struct_liste_chainee *)          strcpy((*((struct_nom *) (*(*((struct_liste_chainee *)
                 (*((struct_objet *) (*l_element_courant).donnee)).objet))                  (*((struct_objet *) (*l_element_courant).donnee)).objet))
                 .donnee).objet)).nom, (*s_etat_processus)                  .donnee).objet)).nom, tableau[i].nom);
                 .s_liste_variables[i].nom);  
   
         /*          /*
          * Préparation du niveau           * Préparation du niveau
Line 1186  instruction_vars(struct_processus *s_eta Line 1209  instruction_vars(struct_processus *s_eta
   
         (*((integer8 *) (*(*(*((struct_liste_chainee *) (*((struct_objet *)          (*((integer8 *) (*(*(*((struct_liste_chainee *) (*((struct_objet *)
                 (*l_element_courant).donnee)).objet)).suivant).donnee).objet)) =                  (*l_element_courant).donnee)).objet)).suivant).donnee).objet)) =
                 (integer8) (*s_etat_processus).s_liste_variables[i].niveau;                  (integer8) tableau[i].niveau;
   
         /*          /*
          * Préparation du contenu de la variable           * Préparation du contenu de la variable
Line 1210  instruction_vars(struct_processus *s_eta Line 1233  instruction_vars(struct_processus *s_eta
             return;              return;
         }          }
   
         if ((*s_etat_processus).s_liste_variables[i].objet == NULL)          if (tableau[i].objet == NULL)
         {          {
             // Variable partagée              // Variable partagée
   
Line 1246  instruction_vars(struct_processus *s_eta Line 1269  instruction_vars(struct_processus *s_eta
   
             if (((*(*(*((struct_liste_chainee *) (*((struct_objet *)              if (((*(*(*((struct_liste_chainee *) (*((struct_objet *)
                     (*l_element_courant).donnee)).objet)).suivant).suivant)                      (*l_element_courant).donnee)).objet)).suivant).suivant)
                     .donnee = copie_objet(s_etat_processus, (*s_etat_processus)                      .donnee = copie_objet(s_etat_processus, tableau[i].objet,
                     .s_liste_variables[i].objet, 'P')) == NULL)                      'P')) == NULL)
             {              {
                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;                  (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                 return;                  return;
Line 1274  instruction_vars(struct_processus *s_eta Line 1297  instruction_vars(struct_processus *s_eta
             return;              return;
         }          }
   
         if (((*s_etat_processus).s_liste_variables[i].origine == 'P')          if ((tableau[i].origine == 'P')
                 ? ((*s_etat_processus).s_liste_variables[i]                  ? (tableau[i].variable_statique.adresse != 0)
                 .variable_statique.adresse != 0)                  : (tableau[i].variable_statique.pointeur != NULL))
                 : ((*s_etat_processus).s_liste_variables[i]  
                 .variable_statique.pointeur != NULL))  
         {          {
             if (((*(*(*(*(*((struct_liste_chainee *) (*((struct_objet *)              if (((*(*(*(*(*((struct_liste_chainee *) (*((struct_objet *)
                     (*l_element_courant).donnee)).objet)).suivant).suivant)                      (*l_element_courant).donnee)).objet)).suivant).suivant)
Line 1331  instruction_vars(struct_processus *s_eta Line 1352  instruction_vars(struct_processus *s_eta
             return;              return;
         }          }
   
         if ((*s_etat_processus).s_liste_variables[i].variable_verrouillee          if (tableau[i].variable_verrouillee == d_vrai)
                 == d_vrai)  
         {          {
             if (((*(*(*(*(*(*((struct_liste_chainee *) (*((struct_objet *)              if (((*(*(*(*(*(*((struct_liste_chainee *) (*((struct_objet *)
                     (*l_element_courant).donnee)).objet)).suivant).suivant)                      (*l_element_courant).donnee)).objet)).suivant).suivant)
Line 1431  instruction_vars(struct_processus *s_eta Line 1451  instruction_vars(struct_processus *s_eta
         l_element_precedent = l_element_courant;          l_element_precedent = l_element_courant;
     }      }
   
       free(tableau);
   
     if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),      if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
             s_objet_resultat) == d_erreur)              s_objet_resultat) == d_erreur)
     {      {
Line 1641  instruction_visit(struct_processus *s_et Line 1663  instruction_visit(struct_processus *s_et
 void  void
 instruction_variable(struct_processus *s_etat_processus)  instruction_variable(struct_processus *s_etat_processus)
 {  {
     logical1                            presence_variable;  
   
     long                                i;  
   
     struct_liste_chainee                *l_element_courant;      struct_liste_chainee                *l_element_courant;
   
     struct_objet                        *s_objet;      struct_objet                        *s_objet;
Line 1691  instruction_variable(struct_processus *s Line 1709  instruction_variable(struct_processus *s
   
     if ((*s_objet).type == NOM)      if ((*s_objet).type == NOM)
     {      {
         if (recherche_variable(s_etat_processus, ((*((struct_nom *)          if (recherche_variable_globale(s_etat_processus, ((*((struct_nom *)
                 (*s_objet).objet)).nom)) == d_faux)                  (*s_objet).objet)).nom)) == d_faux)
         {          {
             liberation(s_etat_processus, s_objet);              liberation(s_etat_processus, s_objet);
Line 1701  instruction_variable(struct_processus *s Line 1719  instruction_variable(struct_processus *s
             return;              return;
         }          }
   
         i = (*s_etat_processus).position_variable_courante;          (*(*s_etat_processus).pointeur_variable_courante)
         presence_variable = d_faux;                  .variable_verrouillee = d_faux;
   
         while(i >= 0)  
         {  
             if ((strcmp((*s_etat_processus).s_liste_variables[i].nom,  
                     (*((struct_nom *) (*s_objet).objet)).nom) == 0)  
                     && ((*s_etat_processus).s_liste_variables[i].niveau == 1))  
             {  
                 presence_variable = d_vrai;  
                 break;  
             }  
   
             i--;  
         }  
   
         (*s_etat_processus).position_variable_courante = i;  
   
         if (presence_variable == d_faux)  
         {  
             liberation(s_etat_processus, s_objet);  
   
             (*s_etat_processus).erreur_execution = d_ex_variable_non_definie;  
             return;  
         }  
   
         ((*s_etat_processus).s_liste_variables[(*s_etat_processus)  
                 .position_variable_courante]).variable_verrouillee = d_faux;  
     }      }
     else if ((*s_objet).type == LST)      else if ((*s_objet).type == LST)
     {      {
Line 1744  instruction_variable(struct_processus *s Line 1736  instruction_variable(struct_processus *s
                 return;                  return;
             }              }
   
             if (recherche_variable(s_etat_processus, (*((struct_nom *)              if (recherche_variable_globale(s_etat_processus, (*((struct_nom *)
                     (*(*l_element_courant).donnee).objet)).nom) == d_faux)                      (*(*l_element_courant).donnee).objet)).nom) == d_faux)
             {              {
                 liberation(s_etat_processus, s_objet);                  liberation(s_etat_processus, s_objet);
Line 1755  instruction_variable(struct_processus *s Line 1747  instruction_variable(struct_processus *s
                 return;                  return;
             }              }
   
             i = (*s_etat_processus).position_variable_courante;              (*(*s_etat_processus).pointeur_variable_courante)
             presence_variable = d_faux;                      .variable_verrouillee = d_faux;
   
             while(i >= 0)  
             {  
                 if ((strcmp((*s_etat_processus).s_liste_variables[i].nom,  
                         (*((struct_nom *) (*(*l_element_courant).donnee)  
                         .objet)).nom) == 0) && ((*s_etat_processus)  
                         .s_liste_variables[i].niveau == 1))  
                 {  
                     presence_variable = d_vrai;  
                     break;  
                 }  
   
                 i--;  
             }  
   
             (*s_etat_processus).position_variable_courante = i;  
   
             if (presence_variable == d_faux)  
             {  
                 liberation(s_etat_processus, s_objet);  
   
                 (*s_etat_processus).erreur_execution =  
                         d_ex_variable_non_definie;  
                 return;  
             }  
   
             ((*s_etat_processus).s_liste_variables[(*s_etat_processus)  
                     .position_variable_courante]).variable_verrouillee = d_faux;  
   
             l_element_courant = (*l_element_courant).suivant;              l_element_courant = (*l_element_courant).suivant;
         }          }

Removed from v.1.5  
changed lines
  Added in v.1.39


CVSweb interface <joel.bertrand@systella.fr>