Diff for /rpl/src/instructions_c4.c between versions 1.2 and 1.80

version 1.2, 2010/01/27 22:22:12 version 1.80, 2022/09/07 13:40:33
Line 1 Line 1
 /*  /*
 ================================================================================  ================================================================================
   RPL/2 (R) version 4.0.10    RPL/2 (R) version 4.1.34
   Copyright (C) 1989-2010 Dr. BERTRAND Joël    Copyright (C) 1989-2021 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"
 #include "convert.conv.h"  #include "convert-conv.h"
   
   
 /*  /*
Line 39 Line 39
 void  void
 instruction_cov(struct_processus *s_etat_processus)  instruction_cov(struct_processus *s_etat_processus)
 {  {
     integer8                            nombre_colonnes;  
   
     logical1                            erreur;      logical1                            erreur;
     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;
   
       integer8                            nombre_colonnes;
   
     (*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 86  instruction_cov(struct_processus *s_etat Line 83  instruction_cov(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
Line 98  instruction_cov(struct_processus *s_etat Line 95  instruction_cov(struct_processus *s_etat
     }      }
     else      else
     {      {
         /*          if (((*(*(*s_etat_processus).pointeur_variable_courante).objet)
          * Il existe une variable locale SIGMA. Reste à vérifier l'existence                  .type != MIN) && ((*(*(*s_etat_processus)
          * d'une variable SIGMA globale...                  .pointeur_variable_courante).objet).type != MRL))
          */  
   
         i = (*s_etat_processus).position_variable_courante;  
         presence_variable = d_faux;  
   
         while(i >= 0)  
         {          {
             if ((strcmp((*s_etat_processus).s_liste_variables[i].nom,              (*s_etat_processus).erreur_execution =
                     ds_sdat) == 0) && ((*s_etat_processus)                      d_ex_matrice_statistique_invalide;
                     .s_liste_variables[i].niveau == 1))  
             {  
                 presence_variable = d_vrai;  
                 break;  
             }  
   
             i--;  
         }  
   
         if (presence_variable == d_faux)  
         {  
             (*s_etat_processus).erreur_execution = d_ex_absence_observations;  
             return;              return;
         }          }
         else  
         {  
             (*s_etat_processus).position_variable_courante = i;  
   
             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)).nombre_colonnes;
                     == 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)  
                     .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 221  void Line 175  void
 instruction_corr(struct_processus *s_etat_processus)  instruction_corr(struct_processus *s_etat_processus)
 {  {
     logical1                            erreur;      logical1                            erreur;
     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;
   
     unsigned long                       nombre_colonnes;      integer8                            nombre_colonnes;
   
     (*s_etat_processus).erreur_execution = d_ex;      (*s_etat_processus).erreur_execution = d_ex;
   
Line 267  instruction_corr(struct_processus *s_eta Line 218  instruction_corr(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
Line 279  instruction_corr(struct_processus *s_eta Line 230  instruction_corr(struct_processus *s_eta
     }      }
     else      else
     {      {
         /*          if (((*(*(*s_etat_processus).pointeur_variable_courante).objet)
          * Il existe une variable locale SIGMA. Reste à vérifier l'existence                  .type != MIN) && ((*(*(*s_etat_processus)
          * d'une variable SIGMA globale...                  .pointeur_variable_courante).objet).type != MRL))
          */  
   
         i = (*s_etat_processus).position_variable_courante;  
         presence_variable = d_faux;  
   
         while(i >= 0)  
         {          {
             if ((strcmp((*s_etat_processus).s_liste_variables[i].nom,              (*s_etat_processus).erreur_execution =
                     ds_sdat) == 0) && ((*s_etat_processus)                      d_ex_matrice_statistique_invalide;
                     .s_liste_variables[i].niveau == 1))  
             {  
                 presence_variable = d_vrai;  
                 break;  
             }  
   
             i--;  
         }  
   
         if (presence_variable == d_faux)  
         {  
             (*s_etat_processus).erreur_execution = d_ex_absence_observations;  
             return;              return;
         }          }
         else  
         {  
             (*s_etat_processus).position_variable_courante = i;  
   
             if ((*s_etat_processus).s_liste_variables  
                     [(*s_etat_processus).position_variable_courante].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))
                     .position_variable_courante].objet)).objet))                  .nombre_colonnes;
                     .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 402  instruction_corr(struct_processus *s_eta Line 311  instruction_corr(struct_processus *s_eta
 void  void
 instruction_copyright(struct_processus *s_etat_processus)  instruction_copyright(struct_processus *s_etat_processus)
 {  {
 #   include                     "copyright.conv.h"  #   include                     "copyright-conv.h"
   
     (*s_etat_processus).erreur_execution = d_ex;      (*s_etat_processus).erreur_execution = d_ex;
   
Line 463  instruction_convert(struct_processus *s_ Line 372  instruction_convert(struct_processus *s_
   
     logical1                    last_valide;      logical1                    last_valide;
   
     long                        longueur_chaine;      size_t                      longueur_chaine;
   
     logical1                    presence_resultat;      logical1                    presence_resultat;
   
Line 472  instruction_convert(struct_processus *s_ Line 381  instruction_convert(struct_processus *s_
     struct_objet                *s_objet_argument_3;      struct_objet                *s_objet_argument_3;
   
     unsigned char               *commande;      unsigned char               *commande;
       unsigned char               *executable_candidat;
     unsigned char               ligne[1024 + 1];      unsigned char               ligne[1024 + 1];
     unsigned char               *tampon_instruction;      unsigned char               *tampon_instruction;
   
Line 543  instruction_convert(struct_processus *s_ Line 453  instruction_convert(struct_processus *s_
             (((*s_objet_argument_3).type == INT) ||              (((*s_objet_argument_3).type == INT) ||
             ((*s_objet_argument_3).type == REL)))              ((*s_objet_argument_3).type == REL)))
     {      {
         longueur_chaine = strlen(ds_rplconvert_commande) - 9          if ((*s_etat_processus).rpl_home == NULL)
                 + strlen((unsigned char *) (*s_objet_argument_1).objet)  
                 + strlen((unsigned char *) (*s_objet_argument_2).objet)  
                 + (2 * strlen(d_exec_path));  
   
         if ((commande = malloc((longueur_chaine + 1) * sizeof(unsigned char)))  
                 == NULL)  
         {          {
             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;              longueur_chaine = strlen(ds_rplconvert_commande) - 9
             return;                      + strlen((unsigned char *) (*s_objet_argument_1).objet)
                       + strlen((unsigned char *) (*s_objet_argument_2).objet)
                       + (2 * strlen(d_exec_path));
   
               if ((commande = malloc((longueur_chaine + 1) *
                       sizeof(unsigned char))) == NULL)
               {
                   (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   return;
               }
   
               sprintf(commande, ds_rplconvert_commande, d_exec_path, d_exec_path,
                       (unsigned char *) (*s_objet_argument_2).objet,
                       (unsigned char *) (*s_objet_argument_1).objet);
   
               if (alsprintf(s_etat_processus, &executable_candidat,
                       "%s/bin/rplconvert", d_exec_path) < 0)
               {
                   (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   return;
               }
   
               if (controle_integrite(s_etat_processus, executable_candidat,
                       "rplconvert") != d_vrai)
               {
                   (*s_etat_processus).erreur_systeme = d_es_somme_controle;
                   return;
               }
   
               free(executable_candidat);
         }          }
           else
           {
               longueur_chaine = strlen(ds_rplconvert_commande) - 9
                       + strlen((unsigned char *) (*s_objet_argument_1).objet)
                       + strlen((unsigned char *) (*s_objet_argument_2).objet)
                       + (2 * strlen((*s_etat_processus).rpl_home));
   
               if ((commande = malloc((longueur_chaine + 1) *
                       sizeof(unsigned char))) == NULL)
               {
                   (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   return;
               }
   
               sprintf(commande, ds_rplconvert_commande,
                       (*s_etat_processus).rpl_home, (*s_etat_processus).rpl_home,
                       (unsigned char *) (*s_objet_argument_2).objet,
                       (unsigned char *) (*s_objet_argument_1).objet);
   
               if (alsprintf(s_etat_processus, &executable_candidat,
                       "%s/bin/rplconvert", (*s_etat_processus).rpl_home) < 0)
               {
                   (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   return;
               }
   
         sprintf(commande, ds_rplconvert_commande, d_exec_path, d_exec_path,              if (controle_integrite(s_etat_processus, executable_candidat,
                 (unsigned char *) (*s_objet_argument_2).objet,                      "rplconvert") != d_vrai)
                 (unsigned char *) (*s_objet_argument_1).objet);              {
                   (*s_etat_processus).erreur_systeme = d_es_somme_controle;
                   return;
               }
   
               free(executable_candidat);
           }
   
         if ((pipe = popen(commande, "r")) == NULL)          if ((pipe = popen(commande, "r")) == NULL)
         {          {
Line 585  instruction_convert(struct_processus *s_ Line 549  instruction_convert(struct_processus *s_
                             (*s_etat_processus).instruction_courante;                              (*s_etat_processus).instruction_courante;
                     (*s_etat_processus).instruction_courante = ligne;                      (*s_etat_processus).instruction_courante = ligne;
   
                       (*s_etat_processus).type_en_cours = NON;
                     recherche_type(s_etat_processus);                      recherche_type(s_etat_processus);
                                           
                     (*s_etat_processus).instruction_courante =                      (*s_etat_processus).instruction_courante =
Line 684  instruction_convert(struct_processus *s_ Line 649  instruction_convert(struct_processus *s_
 void  void
 instruction_close(struct_processus *s_etat_processus)  instruction_close(struct_processus *s_etat_processus)
 {  {
     file                        *descripteur;      const char                  *queue;
   
     int                         socket;      int                         socket;
   
     logical1                    socket_connectee;      logical1                    socket_connectee;
   
       sqlite3_stmt                *ppStmt;
   
       struct_descripteur_fichier  *descripteur;
   
     struct_liste_chainee        *l_element_courant;      struct_liste_chainee        *l_element_courant;
     struct_liste_chainee        *l_element_precedent;      struct_liste_chainee        *l_element_precedent;
   
Line 767  instruction_close(struct_processus *s_et Line 736  instruction_close(struct_processus *s_et
                         (*((struct_descripteur_fichier *) (*l_element_courant)                          (*((struct_descripteur_fichier *) (*l_element_courant)
                         .donnee)).tid) != 0))                          .donnee)).tid) != 0))
                 {                  {
                     descripteur = (*((struct_descripteur_fichier *)                      descripteur = (struct_descripteur_fichier *)
                             (*l_element_courant).donnee)).descripteur;                              (*l_element_courant).donnee;
   
                     if (l_element_precedent == NULL)                      if (l_element_precedent == NULL)
                     {                      {
Line 787  instruction_close(struct_processus *s_et Line 756  instruction_close(struct_processus *s_et
   
                     free((*((struct_descripteur_fichier *)                      free((*((struct_descripteur_fichier *)
                             (*l_element_courant).donnee)).nom);                              (*l_element_courant).donnee)).nom);
                     free((*l_element_courant).donnee);  
                     free(l_element_courant);                      free(l_element_courant);
   
                     break;                      break;
Line 810  instruction_close(struct_processus *s_et Line 778  instruction_close(struct_processus *s_et
          * Fermeture du fichier           * Fermeture du fichier
          */           */
   
         if (fclose(descripteur) != 0)          if (fclose((*descripteur).descripteur_c) != 0)
         {          {
               free(descripteur);
             liberation(s_etat_processus, s_objet_argument);              liberation(s_etat_processus, s_objet_argument);
   
             (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;              (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
             return;              return;
         }          }
   
           if ((*descripteur).type != 'C')
           {
               if (sqlite3_prepare_v2((*descripteur).descripteur_sqlite,
                       "vacuum", 7, &ppStmt, &queue) != SQLITE_OK)
               {
                   free(descripteur);
                   liberation(s_etat_processus, s_objet_argument);
   
                   (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
                   return;
               }
   
               if (sqlite3_step(ppStmt) != SQLITE_DONE)
               {
                   free(descripteur);
                   liberation(s_etat_processus, s_objet_argument);
   
                   (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
                   return;
               }
   
               if (sqlite3_finalize(ppStmt) != SQLITE_OK)
               {
                   free(descripteur);
                   liberation(s_etat_processus, s_objet_argument);
   
                   (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
                   return;
               }
   
               if (sqlite3_close((*descripteur).descripteur_sqlite) != SQLITE_OK)
               {
                   free(descripteur);
                   liberation(s_etat_processus, s_objet_argument);
   
                   (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
                   return;
               }
   
               free(descripteur);
           }
   
         if ((*((struct_fichier *) (*s_objet_argument).objet)).ouverture == 'S')          if ((*((struct_fichier *) (*s_objet_argument).objet)).ouverture == 'S')
         {          {
             if (destruction_fichier((*((struct_fichier *)              if (destruction_fichier((*((struct_fichier *)
Line 954  instruction_create(struct_processus *s_e Line 965  instruction_create(struct_processus *s_e
   
     struct_objet                *s_objet_argument;      struct_objet                *s_objet_argument;
   
       unsigned char               *nom;
   
     unsigned long               unite;      unsigned long               unite;
   
     (*s_etat_processus).erreur_execution = d_ex;      (*s_etat_processus).erreur_execution = d_ex;
Line 998  instruction_create(struct_processus *s_e Line 1011  instruction_create(struct_processus *s_e
   
     if ((*s_objet_argument).type == CHN)      if ((*s_objet_argument).type == CHN)
     {      {
         erreur = caracteristiques_fichier(s_etat_processus, (unsigned char *)          if ((nom = transliteration(s_etat_processus, (unsigned char *)
                 (*s_objet_argument).objet, &existence, &ouverture, &unite);                  (*s_objet_argument).objet, d_locale, "UTF-8")) == NULL)
           {
               liberation(s_etat_processus, s_objet_argument);
               return;
           }
   
           erreur = caracteristiques_fichier(s_etat_processus, nom,
                   &existence, &ouverture, &unite);
   
         if ((erreur != d_absence_erreur) || (existence == d_vrai))          if ((erreur != d_absence_erreur) || (existence == d_vrai))
         {          {
             liberation(s_etat_processus, s_objet_argument);              liberation(s_etat_processus, s_objet_argument);
               free(nom);
   
             (*s_etat_processus).erreur_execution =              (*s_etat_processus).erreur_execution =
                     d_ex_erreur_acces_fichier;                      d_ex_erreur_acces_fichier;
             return;              return;
         }          }
   
         if ((fichier = fopen((unsigned char *) (*s_objet_argument).objet, "w"))          if ((fichier = fopen(nom, "w")) == NULL)
                 == NULL)  
         {          {
             liberation(s_etat_processus, s_objet_argument);              liberation(s_etat_processus, s_objet_argument);
               free(nom);
   
             (*s_etat_processus).erreur_execution =              (*s_etat_processus).erreur_execution =
                     d_ex_erreur_acces_fichier;                      d_ex_erreur_acces_fichier;
             return;              return;
         }          }
   
           free(nom);
   
         if (fclose(fichier) != 0)          if (fclose(fichier) != 0)
         {          {
             liberation(s_etat_processus, s_objet_argument);              liberation(s_etat_processus, s_objet_argument);
Line 1063  instruction_cswp(struct_processus *s_eta Line 1086  instruction_cswp(struct_processus *s_eta
     struct_objet                *s_objet_argument_2;      struct_objet                *s_objet_argument_2;
     struct_objet                *s_objet_argument_3;      struct_objet                *s_objet_argument_3;
   
     signed long                 colonne_1;      integer8                    colonne_1;
     signed long                 colonne_2;      integer8                    colonne_2;
       integer8                    i;
     unsigned long               i;  
   
     (*s_etat_processus).erreur_execution = d_ex;      (*s_etat_processus).erreur_execution = d_ex;
   
Line 1138  instruction_cswp(struct_processus *s_eta Line 1160  instruction_cswp(struct_processus *s_eta
   
         if ((*s_objet_argument_3).type == MIN)          if ((*s_objet_argument_3).type == MIN)
         {          {
             if ((colonne_1 < 0) || (colonne_1 > ((signed long)              if ((colonne_1 < 0) || (colonne_1 >
                     (*((struct_matrice *) (*s_objet_argument_3).objet))                      (*((struct_matrice *) (*s_objet_argument_3).objet))
                     .nombre_colonnes) - 1) || (colonne_2 < 0) || (colonne_2 >                      .nombre_colonnes - 1) || (colonne_2 < 0) || (colonne_2 >
                     ((signed long) (*((struct_matrice *)                      (*((struct_matrice *)
                     (*s_objet_argument_3).objet)).nombre_colonnes) - 1))                      (*s_objet_argument_3).objet)).nombre_colonnes - 1))
             {              {
                 liberation(s_etat_processus, s_objet_argument_1);                  liberation(s_etat_processus, s_objet_argument_1);
                 liberation(s_etat_processus, s_objet_argument_2);                  liberation(s_etat_processus, s_objet_argument_2);
Line 1175  instruction_cswp(struct_processus *s_eta Line 1197  instruction_cswp(struct_processus *s_eta
         }          }
         else if ((*s_objet_argument_3).type == MRL)          else if ((*s_objet_argument_3).type == MRL)
         {          {
             if ((colonne_1 < 0) || (colonne_1 > ((signed long)              if ((colonne_1 < 0) || (colonne_1 >
                     (*((struct_matrice *) (*s_objet_argument_3).objet))                      (*((struct_matrice *) (*s_objet_argument_3).objet))
                     .nombre_colonnes) - 1) || (colonne_2 < 0) || (colonne_2 >                      .nombre_colonnes - 1) || (colonne_2 < 0) || (colonne_2 >
                     ((signed long) (*((struct_matrice *)                      (*((struct_matrice *)
                     (*s_objet_argument_3).objet)).nombre_colonnes) - 1))                      (*s_objet_argument_3).objet)).nombre_colonnes - 1))
             {              {
                 liberation(s_etat_processus, s_objet_argument_1);                  liberation(s_etat_processus, s_objet_argument_1);
                 liberation(s_etat_processus, s_objet_argument_2);                  liberation(s_etat_processus, s_objet_argument_2);
Line 1212  instruction_cswp(struct_processus *s_eta Line 1234  instruction_cswp(struct_processus *s_eta
         }          }
         else if ((*s_objet_argument_3).type == MCX)          else if ((*s_objet_argument_3).type == MCX)
         {          {
             if ((colonne_1 < 0) || (colonne_1 > ((signed long)              if ((colonne_1 < 0) || (colonne_1 >
                     (*((struct_matrice *) (*s_objet_argument_3).objet))                      (*((struct_matrice *) (*s_objet_argument_3).objet))
                     .nombre_colonnes) - 1) || (colonne_2 < 0) || (colonne_2 >                      .nombre_colonnes - 1) || (colonne_2 < 0) || (colonne_2 >
                     ((signed long) (*((struct_matrice *)                      (*((struct_matrice *)
                     (*s_objet_argument_3).objet)).nombre_colonnes) - 1))                      (*s_objet_argument_3).objet)).nombre_colonnes - 1))
             {              {
                 liberation(s_etat_processus, s_objet_argument_1);                  liberation(s_etat_processus, s_objet_argument_1);
                 liberation(s_etat_processus, s_objet_argument_2);                  liberation(s_etat_processus, s_objet_argument_2);

Removed from v.1.2  
changed lines
  Added in v.1.80


CVSweb interface <joel.bertrand@systella.fr>