Diff for /rpl/src/instructions_i3.c between versions 1.4 and 1.70

version 1.4, 2010/03/04 10:17:51 version 1.70, 2020/01/10 11:15:46
Line 1 Line 1
 /*  /*
 ================================================================================  ================================================================================
   RPL/2 (R) version 4.0.12    RPL/2 (R) version 4.1.32
   Copyright (C) 1989-2010 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 20 Line 20
 */  */
   
   
 #include "rpl.conv.h"  #include "rpl-conv.h"
   
   
 /*  /*
Line 48  instruction_inquire(struct_processus *s_ Line 48  instruction_inquire(struct_processus *s_
   
     long                        position_courante;      long                        position_courante;
   
       struct_descripteur_fichier  *dfichier;
   
     struct flock                lock;      struct flock                lock;
   
     struct_objet                *s_objet_argument_1;      struct_objet                *s_objet_argument_1;
Line 55  instruction_inquire(struct_processus *s_ Line 57  instruction_inquire(struct_processus *s_
     struct_objet                *s_objet_resultat;      struct_objet                *s_objet_resultat;
   
     unsigned char               caractere;      unsigned char               caractere;
       unsigned char               *nom;
     unsigned char               *requete;      unsigned char               *requete;
     unsigned char               verrou;      unsigned char               verrou;
   
Line 93  instruction_inquire(struct_processus *s_ Line 96  instruction_inquire(struct_processus *s_
         printf("    NAME           : %s\n", d_CHN);          printf("    NAME           : %s\n", d_CHN);
         printf("    FORMATTED      : %s (true/false)\n", d_INT);          printf("    FORMATTED      : %s (true/false)\n", d_INT);
         printf("    KEY FIELD      : %s\n", d_INT);          printf("    KEY FIELD      : %s\n", d_INT);
           printf("    FORMAT         : %s\n", d_LST);
         printf("    PROTECTION     : %s (WRITEONLY/READONLY/READWRITE)\n\n",          printf("    PROTECTION     : %s (WRITEONLY/READONLY/READWRITE)\n\n",
                 d_CHN);                  d_CHN);
   
Line 105  instruction_inquire(struct_processus *s_ Line 109  instruction_inquire(struct_processus *s_
             printf("  Queries by name:\n\n");              printf("  Queries by name:\n\n");
         }          }
   
         printf("    FORMAT         : %s\n", d_LST);  
         printf("    EXISTENCE      : %s (true/false)\n", d_INT);          printf("    EXISTENCE      : %s (true/false)\n", d_INT);
         printf("    LOCK           : %s (NONE/READ/WRITE)\n", d_CHN);          printf("    LOCK           : %s (NONE/READ/WRITE)\n", d_CHN);
   
Line 150  instruction_inquire(struct_processus *s_ Line 153  instruction_inquire(struct_processus *s_
         return;          return;
     }      }
   
     if ((requete = conversion_majuscule((unsigned char *)      if ((requete = conversion_majuscule(s_etat_processus, (unsigned char *)
             (*s_objet_argument_1).objet)) == NULL)              (*s_objet_argument_1).objet)) == NULL)
     {      {
         (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;          (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
Line 185  instruction_inquire(struct_processus *s_ Line 188  instruction_inquire(struct_processus *s_
                 return;                  return;
             }              }
   
             /*              if ((dfichier = descripteur_fichier(s_etat_processus,
              * La fin du fichier renvoyée ne correspond pas à la fin physique                      (struct_fichier *) (*s_objet_argument_2).objet)) ==
              * du fichier mais à un défaut d'enregistrement.                      NULL)
              */  
   
             if ((fichier = descripteur_fichier(s_etat_processus,  
                     (struct_fichier *) (*s_objet_argument_2).objet)) == NULL)  
             {              {
                 return;                  return;
             }              }
   
             if ((position_courante = ftell(fichier)) == -1)              if ((*dfichier).type != 'C')
             {              {
                 (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;                  liberation(s_etat_processus, s_objet_argument_1);
                   liberation(s_etat_processus, s_objet_argument_2);
   
                   free(requete);
   
                   (*s_etat_processus).erreur_execution =
                           d_ex_erreur_type_fichier;
                 return;                  return;
             }              }
   
             fin_fichier = d_vrai;              if ((*((struct_fichier *) (*s_objet_argument_2).objet)).binaire
                       != 'F')
             while(feof(fichier) == 0)  
             {              {
                 if (fread(&caractere, sizeof(unsigned char), (size_t) 1,                  /*
                         fichier) > 0)                   * La fin du fichier renvoyée ne correspond pas à la fin
                    * physique du fichier mais à un défaut d'enregistrement.
                    */
   
                   if ((position_courante = ftell((*dfichier).descripteur_c))
                           == -1)
                 {                  {
                     if (caractere == '{')                      (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
                       return;
                   }
   
                   fin_fichier = d_vrai;
   
                   while(feof((*dfichier).descripteur_c) == 0)
                   {
                       if (fread(&caractere, sizeof(unsigned char), (size_t) 1,
                               (*dfichier).descripteur_c) > 0)
                     {                      {
                         fin_fichier = d_faux;                          if (caractere == '{')
                         break;                          {
                               fin_fichier = d_faux;
                               break;
                           }
                     }                      }
                 }                  }
             }  
   
             if (fseek(fichier, position_courante, SEEK_SET) != 0)                  if (fseek((*dfichier).descripteur_c, position_courante,
                           SEEK_SET) != 0)
                   {
                       (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
                       return;
                   }
               }
               else
             {              {
                 (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;                  // Fichier de type FLOW
                 return;                  if (feof((*dfichier).descripteur_c) == 0)
                   {
                       fin_fichier = d_faux;
                   }
                   else
                   {
                       fin_fichier = d_vrai;
                   }
             }              }
   
             if (fin_fichier == d_faux)              if (fin_fichier == d_faux)
Line 430  instruction_inquire(struct_processus *s_ Line 464  instruction_inquire(struct_processus *s_
          * La question porte sur un fichier fermé.           * La question porte sur un fichier fermé.
          */           */
   
           if ((nom = transliteration(s_etat_processus,
                   (unsigned char *) (*s_objet_argument_2).objet,
                   d_locale, "UTF-8")) == NULL)
           {
               liberation(s_etat_processus, s_objet_argument_1);
               liberation(s_etat_processus, s_objet_argument_2);
               return;
           }
   
         if (strcmp(requete, "EXISTENCE") == 0)          if (strcmp(requete, "EXISTENCE") == 0)
         {          {
             erreur = caracteristiques_fichier(s_etat_processus,              erreur = caracteristiques_fichier(s_etat_processus, nom,
                     (unsigned char *) (*s_objet_argument_2).objet,  
                     &existence, &ouverture, &unite);                      &existence, &ouverture, &unite);
   
             if (erreur != d_absence_erreur)              if (erreur != d_absence_erreur)
             {              {
                   free(nom);
                 free(requete);                  free(requete);
   
                 liberation(s_etat_processus, s_objet_argument_1);                  liberation(s_etat_processus, s_objet_argument_1);
Line 474  instruction_inquire(struct_processus *s_ Line 517  instruction_inquire(struct_processus *s_
         }          }
         else if (strcmp(requete, "LOCK") == 0)          else if (strcmp(requete, "LOCK") == 0)
         {          {
             erreur = caracteristiques_fichier(s_etat_processus,              erreur = caracteristiques_fichier(s_etat_processus, nom,
                     (unsigned char *) (*s_objet_argument_2).objet,  
                     &existence, &ouverture, &unite);                      &existence, &ouverture, &unite);
   
             if (erreur != d_absence_erreur)              if (erreur != d_absence_erreur)
             {              {
                 free(requete);                  free(requete);
                   free(nom);
   
                 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 504  instruction_inquire(struct_processus *s_ Line 547  instruction_inquire(struct_processus *s_
                  */                   */
   
                 free(requete);                  free(requete);
                   free(nom);
   
                 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 519  instruction_inquire(struct_processus *s_ Line 563  instruction_inquire(struct_processus *s_
                  * Fichier existant                   * Fichier existant
                  */                   */
   
                 if ((fichier = fopen((unsigned char *)                  if ((fichier = fopen(nom, "r+")) == NULL)
                         (*s_objet_argument_2).objet, "r+")) == NULL)  
                 {                  {
                     free(requete);                      free(requete);
                       free(nom);
   
                     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 541  instruction_inquire(struct_processus *s_ Line 585  instruction_inquire(struct_processus *s_
   
                 if (fcntl(fileno(fichier), F_GETLK, &lock) == -1)                  if (fcntl(fileno(fichier), F_GETLK, &lock) == -1)
                 {                  {
                       free(nom);
   
                     if (fclose(fichier) != 0)                      if (fclose(fichier) != 0)
                     {                      {
                         free(requete);                          free(requete);
Line 580  instruction_inquire(struct_processus *s_ Line 626  instruction_inquire(struct_processus *s_
   
                     if (fcntl(fileno(fichier), F_GETLK, &lock) == -1)                      if (fcntl(fileno(fichier), F_GETLK, &lock) == -1)
                     {                      {
                           free(nom);
   
                         if (fclose(fichier) != 0)                          if (fclose(fichier) != 0)
                         {                          {
                             free(requete);                              free(requete);
Line 668  instruction_inquire(struct_processus *s_ Line 716  instruction_inquire(struct_processus *s_
                 if (fclose(fichier) != 0)                  if (fclose(fichier) != 0)
                 {                  {
                     free(requete);                      free(requete);
                       free(nom);
   
                     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 680  instruction_inquire(struct_processus *s_ Line 729  instruction_inquire(struct_processus *s_
         }          }
         else          else
         {          {
               free(nom);
             free(requete);              free(requete);
   
             liberation(s_etat_processus, s_objet_argument_1);              liberation(s_etat_processus, s_objet_argument_1);
Line 688  instruction_inquire(struct_processus *s_ Line 738  instruction_inquire(struct_processus *s_
             (*s_etat_processus).erreur_execution = d_ex_erreur_requete_fichier;              (*s_etat_processus).erreur_execution = d_ex_erreur_requete_fichier;
             return;              return;
         }          }
   
           free(nom);
     }      }
     else      else
     {      {
Line 737  instruction_idft(struct_processus *s_eta Line 789  instruction_idft(struct_processus *s_eta
   
     logical1                    presence_longueur_dft;      logical1                    presence_longueur_dft;
   
     long                        longueur_dft_signee;      integer8                    longueur_dft_signee;
   
     struct_complexe16           *matrice_f77;      struct_complexe16           *matrice_f77;
   
Line 745  instruction_idft(struct_processus *s_eta Line 797  instruction_idft(struct_processus *s_eta
     struct_objet                *s_objet_longueur_dft;      struct_objet                *s_objet_longueur_dft;
     struct_objet                *s_objet_resultat;      struct_objet                *s_objet_resultat;
   
     unsigned long               i;      integer8                    i;
     unsigned long               j;      integer8                    j;
     unsigned long               k;      integer8                    k;
     unsigned long               longueur_dft;      integer8                    longueur_dft;
   
     (*s_etat_processus).erreur_execution = d_ex;      (*s_etat_processus).erreur_execution = d_ex;
   
Line 866  instruction_idft(struct_processus *s_eta Line 918  instruction_idft(struct_processus *s_eta
                     (*s_objet_argument).objet)).taille;                      (*s_objet_argument).objet)).taille;
         }          }
   
         if ((matrice_f77 = malloc(longueur_dft *          if ((matrice_f77 = malloc(((size_t) longueur_dft) *
                 sizeof(struct_complexe16))) == NULL)                  sizeof(struct_complexe16))) == NULL)
         {          {
             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;              (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
Line 916  instruction_idft(struct_processus *s_eta Line 968  instruction_idft(struct_processus *s_eta
         }          }
   
         nombre_lignes = 1;          nombre_lignes = 1;
         nombre_colonnes = longueur_dft;          nombre_colonnes = (integer4) longueur_dft;
         inverse = -1;          inverse = -1;
   
         dft(matrice_f77, &nombre_lignes, &nombre_colonnes, &inverse, &erreur);          dft(matrice_f77, &nombre_lignes, &nombre_colonnes, &inverse, &erreur);
Line 956  instruction_idft(struct_processus *s_eta Line 1008  instruction_idft(struct_processus *s_eta
                     (*s_objet_argument).objet)).nombre_colonnes;                      (*s_objet_argument).objet)).nombre_colonnes;
         }          }
   
         if ((matrice_f77 = malloc(longueur_dft *          if ((matrice_f77 = malloc(((size_t) longueur_dft) * ((size_t)
                 (*((struct_matrice *) (*s_objet_argument).objet))                  (*((struct_matrice *) (*s_objet_argument).objet))
                 .nombre_lignes * sizeof(struct_complexe16))) == NULL)                  .nombre_lignes) * sizeof(struct_complexe16))) == NULL)
         {          {
             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;              (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
             return;              return;
Line 1034  instruction_idft(struct_processus *s_eta Line 1086  instruction_idft(struct_processus *s_eta
             }              }
         }          }
   
         nombre_lignes = (*((struct_matrice *) (*s_objet_argument).objet))          nombre_lignes = (integer4) (*((struct_matrice *) (*s_objet_argument)
                 .nombre_lignes;                  .objet)).nombre_lignes;
         nombre_colonnes = longueur_dft;          nombre_colonnes = (integer4) longueur_dft;
         inverse = -1;          inverse = -1;
   
         dft(matrice_f77, &nombre_lignes, &nombre_colonnes, &inverse, &erreur);          dft(matrice_f77, &nombre_lignes, &nombre_colonnes, &inverse, &erreur);
Line 1063  instruction_idft(struct_processus *s_eta Line 1115  instruction_idft(struct_processus *s_eta
                 longueur_dft;                  longueur_dft;
   
         if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =          if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
                 malloc((*((struct_matrice *) (*s_objet_resultat).objet))                  malloc(((size_t) (*((struct_matrice *) (*s_objet_resultat)
                 .nombre_lignes * sizeof(struct_complexe16 *))) == NULL)                  .objet)).nombre_lignes) * sizeof(struct_complexe16 *))) == NULL)
         {          {
             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;              (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
             return;              return;
Line 1075  instruction_idft(struct_processus *s_eta Line 1127  instruction_idft(struct_processus *s_eta
         {          {
             if ((((struct_complexe16 **) (*((struct_matrice *)              if ((((struct_complexe16 **) (*((struct_matrice *)
                     (*s_objet_resultat).objet)).tableau)[i] =                      (*s_objet_resultat).objet)).tableau)[i] =
                     malloc((*((struct_matrice *)                      malloc(((size_t) (*((struct_matrice *)
                     (*s_objet_resultat).objet)).nombre_colonnes *                      (*s_objet_resultat).objet)).nombre_colonnes) *
                     sizeof(struct_complexe16))) == NULL)                      sizeof(struct_complexe16))) == NULL)
             {              {
                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;                  (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;

Removed from v.1.4  
changed lines
  Added in v.1.70


CVSweb interface <joel.bertrand@systella.fr>