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

version 1.24, 2011/06/22 13:27:02 version 1.74, 2020/01/10 11:15:47
Line 1 Line 1
 /*  /*
 ================================================================================  ================================================================================
   RPL/2 (R) version 4.1.0.prerelease.3    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 421  instruction_prvar(struct_processus *s_et Line 425  instruction_prvar(struct_processus *s_et
     }      }
     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).pointeur_variable_courante).nom,                  (*(*s_etat_processus).pointeur_variable_courante).nom,
                 (*(*s_etat_processus).pointeur_variable_courante)                  (*(*s_etat_processus).pointeur_variable_courante)
                 .variable_partagee, (*(*s_etat_processus)                  .variable_partagee, (*(*s_etat_processus)
                 .pointeur_variable_courante).origine) == d_faux)                  .pointeur_variable_courante).origine) == NULL)
         {          {
             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 449  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 482  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)
 {  {
     int                         i;      integer8                    i;
     int                         nb_variables;      integer8                    j;
       integer8                    nb_variables;
   
     struct_objet                s_objet;      struct_objet                s_objet;
   
Line 522  instruction_prusr(struct_processus *s_et Line 511  instruction_prusr(struct_processus *s_et
         }          }
     }      }
   
     nb_variables = nombre_variables(s_etat_processus,      nb_variables = nombre_variables(s_etat_processus);
             (*s_etat_processus).s_arbre_variables);  
   
     if ((tableau = malloc(nb_variables * sizeof(struct_tableau_variables)))      if ((tableau = malloc(((size_t) nb_variables) *
             == NULL)              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;          (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
         return;          return;
     }      }
   
     liste_variables(s_etat_processus, tableau, 0,      nb_variables = liste_variables(s_etat_processus, tableau);
             (*s_etat_processus).s_arbre_variables);  
   
     s_objet.type = CHN;      s_objet.type = CHN;
   
     for(i = 0; i < nb_variables; i++)      for(i = 0; i < nb_variables; i++)
Line 542  instruction_prusr(struct_processus *s_et Line 530  instruction_prusr(struct_processus *s_et
         if ((s_objet.objet = malloc((strlen(tableau[i].nom) + 64)          if ((s_objet.objet = malloc((strlen(tableau[i].nom) + 64)
                 * sizeof(unsigned char))) == NULL)                  * sizeof(unsigned char))) == NULL)
         {          {
               for(j = i; j < nb_variables; j++)
               {
                   if (tableau[j].mutex != NULL)
                   {
                       pthread_mutex_unlock(tableau[i].mutex);
                   }
               }
   
             free(tableau);              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",
                 tableau[i].nom, tableau[i].niveau);                  tableau[i].nom, tableau[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);
     }      }
Line 575  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 1301  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 1354  instruction_psdev(struct_processus *s_et Line 1354  instruction_psdev(struct_processus *s_et
     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 1436  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 1531  instruction_pvar(struct_processus *s_eta Line 1532  instruction_pvar(struct_processus *s_eta
     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 1613  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.24  
changed lines
  Added in v.1.74


CVSweb interface <joel.bertrand@systella.fr>