Diff for /rpl/src/instructions_p4.c between versions 1.18 and 1.74

version 1.18, 2011/04/21 16:00:58 version 1.74, 2020/01/10 11:15:47
Line 1 Line 1
 /*  /*
 ================================================================================  ================================================================================
   RPL/2 (R) version 4.1.0.prerelease.0    RPL/2 (R) version 4.1.32
   Copyright (C) 1989-2011 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 254  instruction_prst(struct_processus *s_eta Line 254  instruction_prst(struct_processus *s_eta
         }          }
     }      }
   
       routine_recursive = 2;
     impression_pile(s_etat_processus, (*s_etat_processus).l_base_pile,      impression_pile(s_etat_processus, (*s_etat_processus).l_base_pile,
             'E', 1);              'E', 1);
       routine_recursive = 0;
     return;      return;
 }  }
   
Line 333  instruction_prstc(struct_processus *s_et Line 335  instruction_prstc(struct_processus *s_et
         }          }
     }      }
   
       routine_recursive = 2;
     impression_pile(s_etat_processus, (*s_etat_processus).l_base_pile,      impression_pile(s_etat_processus, (*s_etat_processus).l_base_pile,
             'C', 1);              'C', 1);
       routine_recursive = 0;
     return;      return;
 }  }
   
Line 414  instruction_prvar(struct_processus *s_et Line 418  instruction_prvar(struct_processus *s_et
         return;          return;
     }      }
   
     if ((*s_etat_processus).s_liste_variables[(*s_etat_processus)      if ((*(*s_etat_processus).pointeur_variable_courante).objet != NULL)
             .position_variable_courante].objet != NULL)  
     {      {
         formateur_tex(s_etat_processus, (*s_etat_processus).s_liste_variables          formateur_tex(s_etat_processus, (*(*s_etat_processus)
                 [(*s_etat_processus).position_variable_courante].objet, 'N');                  .pointeur_variable_courante).objet, 'N');
     }      }
     else      else
     {      {
         if (pthread_mutex_lock(&((*(*s_etat_processus)  
                 .s_liste_variables_partagees).mutex)) != 0)  
         {  
             (*s_etat_processus).erreur_systeme = d_es_processus;  
             return;  
         }  
   
         if (recherche_variable_partagee(s_etat_processus,          if (recherche_variable_partagee(s_etat_processus,
                 (*s_etat_processus).s_liste_variables                  (*(*s_etat_processus).pointeur_variable_courante).nom,
                 [(*s_etat_processus).position_variable_courante].nom,                  (*(*s_etat_processus).pointeur_variable_courante)
                 (*s_etat_processus).s_liste_variables                  .variable_partagee, (*(*s_etat_processus)
                 [(*s_etat_processus).position_variable_courante]                  .pointeur_variable_courante).origine) == NULL)
                 .variable_partagee, (*s_etat_processus).s_liste_variables  
                 [(*s_etat_processus).position_variable_courante].origine)  
                 == d_faux)  
         {          {
             if (pthread_mutex_unlock(&((*(*s_etat_processus)  
                     .s_liste_variables_partagees).mutex)) != 0)  
             {  
                 (*s_etat_processus).erreur_systeme = d_es_processus;  
                 return;  
             }  
   
             (*s_etat_processus).erreur_systeme = d_es;              (*s_etat_processus).erreur_systeme = d_es;
             (*s_etat_processus).erreur_execution = d_ex_variable_non_definie;              (*s_etat_processus).erreur_execution = d_ex_variable_non_definie;
   
Line 453  instruction_prvar(struct_processus *s_et Line 439  instruction_prvar(struct_processus *s_et
         }          }
   
         formateur_tex(s_etat_processus, (*(*s_etat_processus)          formateur_tex(s_etat_processus, (*(*s_etat_processus)
                 .s_liste_variables_partagees).table                  .pointeur_variable_partagee_courante).objet, 'N');
                 [(*(*s_etat_processus).s_liste_variables_partagees)  
                 .position_variable].objet, 'N');  
   
         if (pthread_mutex_unlock(&((*(*s_etat_processus)          if (pthread_mutex_unlock(&((*(*s_etat_processus)
                 .s_liste_variables_partagees).mutex)) != 0)                  .pointeur_variable_partagee_courante).mutex)) != 0)
         {          {
             (*s_etat_processus).erreur_systeme = d_es_processus;              (*s_etat_processus).erreur_systeme = d_es_processus;
             return;              return;
Line 486  instruction_prvar(struct_processus *s_et Line 470  instruction_prvar(struct_processus *s_et
 void  void
 instruction_prusr(struct_processus *s_etat_processus)  instruction_prusr(struct_processus *s_etat_processus)
 {  {
       integer8                    i;
       integer8                    j;
       integer8                    nb_variables;
   
     struct_objet                s_objet;      struct_objet                s_objet;
   
     unsigned long               i;      struct_tableau_variables    *tableau;
   
     (*s_etat_processus).erreur_execution = d_ex;      (*s_etat_processus).erreur_execution = d_ex;
   
Line 523  instruction_prusr(struct_processus *s_et Line 511  instruction_prusr(struct_processus *s_et
         }          }
     }      }
   
       nb_variables = nombre_variables(s_etat_processus);
   
       if ((tableau = malloc(((size_t) nb_variables) *
               sizeof(struct_tableau_variables))) == NULL)
       {
           liberation_mutexes_arbre_variables_partagees(s_etat_processus,
                   (*(*s_etat_processus).s_arbre_variables_partagees));
           (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
           return;
       }
   
       nb_variables = liste_variables(s_etat_processus, tableau);
     s_objet.type = CHN;      s_objet.type = CHN;
   
     for(i = 0; i < (*s_etat_processus).nombre_variables; i++)      for(i = 0; i < nb_variables; i++)
     {      {
         if ((s_objet.objet = malloc((strlen((*s_etat_processus)          if ((s_objet.objet = malloc((strlen(tableau[i].nom) + 64)
                 .s_liste_variables[i].nom) + 64) * sizeof(unsigned char)))                  * sizeof(unsigned char))) == NULL)
                 == NULL)  
         {          {
               for(j = i; j < nb_variables; j++)
               {
                   if (tableau[j].mutex != NULL)
                   {
                       pthread_mutex_unlock(tableau[i].mutex);
                   }
               }
   
               free(tableau);
   
             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;              (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
             return;              return;
         }          }
   
         sprintf((unsigned char *) s_objet.objet, "\\noindent %s [%lu]\n",          sprintf((unsigned char *) s_objet.objet, "\\\\noindent %s [%lld]\n",
                 (*s_etat_processus).s_liste_variables[i].nom,                  tableau[i].nom, tableau[i].niveau);
                 (*s_etat_processus).s_liste_variables[i].niveau);  
           if (tableau[i].mutex != NULL)
           {
               pthread_mutex_unlock(tableau[i].mutex);
           }
   
         formateur_tex(s_etat_processus, &s_objet, 'N');          formateur_tex(s_etat_processus, &s_objet, 'N');
         free(s_objet.objet);          free(s_objet.objet);
     }      }
   
       free(tableau);
     return;      return;
 }  }
   
Line 562  instruction_prusr(struct_processus *s_et Line 576  instruction_prusr(struct_processus *s_et
 void  void
 instruction_prmd(struct_processus *s_etat_processus)  instruction_prmd(struct_processus *s_etat_processus)
 {  {
       long                        i;
       long                        j;
     long                        longueur_utile;      long                        longueur_utile;
     long                        longueur_utile_limite;      long                        longueur_utile_limite;
   
     struct_objet                s_objet;      struct_objet                s_objet;
   
     unsigned long               i;  
     unsigned long               j;  
   
     (*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 1288  instruction_perm(struct_processus *s_eta Line 1301  instruction_perm(struct_processus *s_eta
                 return;                  return;
             }              }
   
             if (fabs(c - floor(c)) < fabs(ceil(c) - c))              if (abs(c - floor(c)) < fabs(ceil(c) - c))
             {              {
                 (*((integer8 *) (*s_objet_resultat).objet)) =                  (*((integer8 *) (*s_objet_resultat).objet)) =
                         (integer8) floor(c);                          (integer8) floor(c);
Line 1337  instruction_perm(struct_processus *s_eta Line 1350  instruction_perm(struct_processus *s_eta
 void  void
 instruction_psdev(struct_processus *s_etat_processus)  instruction_psdev(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;
   
     unsigned long                       nombre_colonnes;      integer8                            nombre_colonnes;
   
     (*s_etat_processus).erreur_execution = d_ex;      (*s_etat_processus).erreur_execution = d_ex;
   
Line 1384  instruction_psdev(struct_processus *s_et Line 1393  instruction_psdev(struct_processus *s_et
      * 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;          if ((*s_etat_processus).erreur_execution == d_ex)
         presence_variable = d_faux;  
   
         while(i >= 0)  
         {          {
             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  
                     [(*s_etat_processus).position_variable_courante].objet))  
                     .type != MIN) && ((*((*s_etat_processus)  
                     .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)          nombre_colonnes = (*((struct_matrice *) (*(*(*s_etat_processus)
                     .s_liste_variables[(*s_etat_processus)                  .pointeur_variable_courante).objet).objet)).nombre_colonnes;
                     .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 1464  instruction_psdev(struct_processus *s_et Line 1436  instruction_psdev(struct_processus *s_et
         }          }
   
         if (((*s_objet_resultat).objet = ecart_type_statistique(          if (((*s_objet_resultat).objet = ecart_type_statistique(
                   s_etat_processus,
                 (struct_matrice *) (*s_objet_statistique).objet, 'P')) == NULL)                  (struct_matrice *) (*s_objet_statistique).objet, 'P')) == NULL)
         {          {
             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;              (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
Line 1555  instruction_psdev(struct_processus *s_et Line 1528  instruction_psdev(struct_processus *s_et
 void  void
 instruction_pvar(struct_processus *s_etat_processus)  instruction_pvar(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;
   
     unsigned long                       nombre_colonnes;      integer8                            nombre_colonnes;
   
     (*s_etat_processus).erreur_execution = d_ex;      (*s_etat_processus).erreur_execution = d_ex;
   
Line 1602  instruction_pvar(struct_processus *s_eta Line 1571  instruction_pvar(struct_processus *s_eta
      * 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)          nombre_colonnes = (*((struct_matrice *) (*(*(*s_etat_processus)
             {                  .pointeur_variable_courante).objet).objet)).nombre_colonnes;
                 (*s_etat_processus).erreur_execution =  
                         d_ex_variable_partagee;  
                 return;  
             }  
   
             if (((*((*s_etat_processus).s_liste_variables  
                     [(*s_etat_processus).position_variable_courante].objet))  
                     .type != MIN) && ((*((*s_etat_processus)  
                     .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 1682  instruction_pvar(struct_processus *s_eta Line 1614  instruction_pvar(struct_processus *s_eta
             return;              return;
         }          }
   
         if (((*s_objet_resultat).objet = variance_statistique((struct_matrice *)          if (((*s_objet_resultat).objet = variance_statistique(s_etat_processus,
                 (*s_objet_statistique).objet, 'P')) == NULL)                  (struct_matrice *) (*s_objet_statistique).objet, 'P')) == NULL)
         {          {
             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;              (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
             return;              return;

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


CVSweb interface <joel.bertrand@systella.fr>