[BACK]Return to instructions_b1.c CVS log [TXT] [DIR] Up to [local] / rpl / src

Diff for /rpl/src/instructions_b1.c between versions 1.19 and 1.73

version 1.19, 2011/04/11 12:10:06 version 1.73, 2023/08/07 17:42:52
Line 1 Line 1
 /*  /*
 ================================================================================  ================================================================================
   RPL/2 (R) version 4.1.0.prerelease.0    RPL/2 (R) version 4.1.35
   Copyright (C) 1989-2011 Dr. BERTRAND Joël    Copyright (C) 1989-2023 Dr. BERTRAND Joël
   
   This file is part of RPL/2.    This file is part of RPL/2.
   
Line 203  instruction_b_vers_r(struct_processus *s Line 203  instruction_b_vers_r(struct_processus *s
             return;              return;
         }          }
   
         (*((integer8 *) (*s_objet_resultat).objet)) = (*((logical8 *)          (*((integer8 *) (*s_objet_resultat).objet)) = (integer8) (*((logical8 *)
                 (*s_objet_argument).objet));                  (*s_objet_argument).objet));
     }      }
     else      else
Line 243  instruction_backspace(struct_processus * Line 243  instruction_backspace(struct_processus *
 {  {
     struct_descripteur_fichier  *descripteur;      struct_descripteur_fichier  *descripteur;
   
       integer8                    i;
       integer8                    nombre_octets;
     integer8                    position_finale;      integer8                    position_finale;
     integer8                    position_initiale;      integer8                    position_initiale;
       integer8                    saut;
       integer8                    pointeur;
       integer8                    niveau;
       integer8                    longueur_effective;
       integer8                    longueur_questure;
   
   
       logical1                    guillemets_a_cheval;
     logical1                    presence_chaine;      logical1                    presence_chaine;
     logical1                    presence_indicateur;      logical1                    presence_indicateur;
   
     long                        pointeur;  
     long                        niveau;  
   
     size_t                      longueur_effective;  
     size_t                      longueur_questure;  
   
     struct flock                lock;      struct flock                lock;
   
     struct_objet                *s_objet_argument;      struct_objet                *s_objet_argument;
   
     unsigned char               *tampon_lecture;      unsigned char               *tampon_lecture;
       unsigned char               tampon[9];
   
     (*s_etat_processus).erreur_execution = d_ex;      (*s_etat_processus).erreur_execution = d_ex;
   
Line 362  instruction_backspace(struct_processus * Line 366  instruction_backspace(struct_processus *
   
                 longueur_questure = 256;                  longueur_questure = 256;
   
                 if ((tampon_lecture = malloc(longueur_questure *                  if ((tampon_lecture = malloc(((size_t) longueur_questure) *
                         sizeof(unsigned char))) == NULL)                          sizeof(unsigned char))) == NULL)
                 {                  {
                     (*s_etat_processus).erreur_systeme =                      (*s_etat_processus).erreur_systeme =
Line 383  instruction_backspace(struct_processus * Line 387  instruction_backspace(struct_processus *
                         longueur_effective = longueur_questure;                          longueur_effective = longueur_questure;
                     }                      }
   
                     if (fseek((*descripteur).descripteur_c, position_initiale,                      if (fseek((*descripteur).descripteur_c,
                             SEEK_SET) != 0)                              (long) position_initiale, SEEK_SET) != 0)
                     {                      {
                         (*s_etat_processus).erreur_systeme =                          (*s_etat_processus).erreur_systeme =
                                 d_es_erreur_fichier;                                  d_es_erreur_fichier;
                         return;                          return;
                     }                      }
   
                     longueur_effective = fread(tampon_lecture,                      longueur_effective = (integer8) fread(tampon_lecture,
                             (size_t) sizeof(unsigned char), longueur_effective,                              sizeof(unsigned char), (size_t) longueur_effective,
                             (*descripteur).descripteur_c);                              (*descripteur).descripteur_c);
   
                     pointeur = longueur_effective - 1;                      pointeur = longueur_effective - 1;
Line 466  instruction_backspace(struct_processus * Line 470  instruction_backspace(struct_processus *
                         position_finale--;                          position_finale--;
                     }                      }
   
                     if (fseek((*descripteur).descripteur_c, position_initiale,                      if (fseek((*descripteur).descripteur_c,
                             SEEK_SET) != 0)                              (long) position_initiale, SEEK_SET) != 0)
                     {                      {
                         (*s_etat_processus).erreur_systeme =                          (*s_etat_processus).erreur_systeme =
                                 d_es_erreur_fichier;                                  d_es_erreur_fichier;
                         return;                          return;
                     }                      }
   
                     longueur_effective = fread(tampon_lecture,                      longueur_effective = (integer8) fread(tampon_lecture,
                             (size_t) sizeof(unsigned char), longueur_effective,                              sizeof(unsigned char), (size_t) longueur_effective,
                             (*descripteur).descripteur_c);                              (*descripteur).descripteur_c);
   
                     pointeur = longueur_effective - 1;                      pointeur = longueur_effective - 1;
                     presence_indicateur = d_faux;                      presence_indicateur = d_faux;
                       guillemets_a_cheval = d_faux;
   
                     while((pointeur >= 0) && (presence_indicateur == d_faux))                      while((pointeur >= 0) && (presence_indicateur == d_faux)
                               && (guillemets_a_cheval == d_faux))
                     {                      {
                         if (tampon_lecture[pointeur] == '"')                          if (tampon_lecture[pointeur] == '"')
                         {                          {
                             presence_chaine = (presence_chaine == d_vrai)                              if (pointeur > 0)
                                     ? d_faux : d_vrai;                              {
                                   // On n'est pas au début du buffer, on regarde
                                   // si les guillemets sont échappés.
   
                                   if (tampon_lecture[pointeur - 1] != '\\')
                                   {
                                           presence_chaine = (presence_chaine
                                                   == d_vrai) ? d_faux : d_vrai;
                                   }
                               }
                               else
                               {
                                   // On est au début du buffer. Un guillemet
                                   // peut-être échappé par le dernier caractère
                                   // du buffer précédent.
   
                                   guillemets_a_cheval = d_vrai;
                               }
                         }                          }
                         else                          else
                         {                          {
Line 500  instruction_backspace(struct_processus * Line 523  instruction_backspace(struct_processus *
                             }                              }
                         }                          }
   
                         if (niveau == 0)                          if (guillemets_a_cheval == d_faux)
                         {  
                             presence_indicateur = d_vrai;  
                         }  
                         else  
                         {                          {
                             position_finale--;                              if (niveau == 0)
                             pointeur--;                              {
                                   presence_indicateur = d_vrai;
                               }
                               else
                               {
                                   position_finale--;
                                   pointeur--;
                               }
                         }                          }
                     }                      }
                 } while((longueur_effective == longueur_questure) &&                  } while((longueur_effective == longueur_questure) &&
Line 523  instruction_backspace(struct_processus * Line 549  instruction_backspace(struct_processus *
                     return;                      return;
                 }                  }
   
                 if (fseek((*descripteur).descripteur_c, position_finale,                  if (fseek((*descripteur).descripteur_c, (long) position_finale,
                         SEEK_SET) != 0)                          SEEK_SET) != 0)
                 {                  {
                     liberation(s_etat_processus, s_objet_argument);                      liberation(s_etat_processus, s_objet_argument);
Line 540  instruction_backspace(struct_processus * Line 566  instruction_backspace(struct_processus *
                 /*                  /*
                  * Fichiers non formatés                   * Fichiers non formatés
                  */                   */
   
                   /*
                    Chaque enregistrement est terminé par un champ
                    * indiquant la longueur totale de cet enregistrement.
                    *
                    * XXXXXXX0                             longueur sur 7 bits
                    * XXXX0011 XXXXXXXX XXXX0011           longueur sur 16 bits
                    * LSB(1/2) MSB      LSB(2/2)
                    * XXXX0101 XXXXXXXX XXXXXXXX XXXX0101  longueur sur 24 bits
                    * XXXX0111 XXXXXXXX XXXXXXXX XXXXXXXX
                    *          XXXX0111                    longueur sur 32 bits
                    * XXXX1001 XXXXXXXX XXXXXXXX XXXXXXXX
                    *          XXXXXXXX XXXX1001           longueur sur 40 bits
                    * XXXX1011 XXXXXXXX XXXXXXXX XXXXXXXX
                    *          XXXXXXXX XXXXXXXX XXXX1011  longueur sur 48 bits
                    * XXXX1101 XXXXXXXX XXXXXXXX XXXXXXXX
                    *          XXXXXXXX XXXXXXXX XXXXXXXX
                    *          XXXX1101                    longueur sur 56 bits
                    * XXXX1111 XXXXXXXX XXXXXXXX XXXXXXXX
                    *          XXXXXXXX XXXXXXXX XXXXXXXX
                    *          XXXXXXXX XXXX1111           longueur sur 64 bits
                    */
   
                   if ((position_finale = ftell((*descripteur).descripteur_c))
                           == -1)
                   {
                       liberation(s_etat_processus, s_objet_argument);
   
                       (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
                       return;
                   }
   
                   // Lecture du premier octet. Le pointeur de lecture se
                   // trouve après l'opération à sa position initiale.
   
                   if (position_finale == 0)
                   {
                       liberation(s_etat_processus, s_objet_argument);
   
                       (*s_etat_processus).erreur_execution =
                               d_ex_debut_de_fichier_atteint;
                       return;
                   }
   
                   if (fseek((*descripteur).descripteur_c,
                           ((long) position_finale) - 1, SEEK_SET) != 0)
                   {
                       liberation(s_etat_processus, s_objet_argument);
   
                       (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
                       return;
                   }
   
                   if (fread(tampon, (size_t) sizeof(unsigned char), 1,
                           (*descripteur).descripteur_c) != 1)
                   {
                       liberation(s_etat_processus, s_objet_argument);
   
                       (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
                       return;
                   }
   
                   if ((tampon[0] & 0x01) == 0)
                   {
                       // Longueur sur sept bits
                       saut = tampon[0] >> 1;
                   }
                   else
                   {
                       // Longueurs supérieures
                       nombre_octets = 2 + ((tampon[0] >> 1) & 0x07);
   
                       if ((position_finale - nombre_octets) < 0)
                       {
                           liberation(s_etat_processus, s_objet_argument);
   
                           (*s_etat_processus).erreur_systeme = d_ex_syntaxe;
                           return;
                       }
   
                       if (fseek((*descripteur).descripteur_c,
                               ((long) (position_finale - nombre_octets)),
                               SEEK_SET) != 0)
                       {
                           liberation(s_etat_processus, s_objet_argument);
   
                           (*s_etat_processus).erreur_systeme =
                                   d_es_erreur_fichier;
                           return;
                       }
   
                       if (fread(tampon, (size_t) sizeof(unsigned char),
                               (size_t) nombre_octets,
                               (*descripteur).descripteur_c)
                               != (size_t) nombre_octets)
                       {
                           liberation(s_etat_processus, s_objet_argument);
   
                           (*s_etat_processus).erreur_systeme =
                                   d_es_erreur_fichier;
                           return;
                       }
   
                       // Récupération du LSB
   
                       saut = (tampon[0] & 0xF0)
                               | ((tampon[nombre_octets - 1] & 0x0F) >> 4);
   
                       // Autres octets
   
                       for(i = 1; i < (nombre_octets - 1); i++)
                       {
                           saut |= ((integer8) tampon[i]) <<
                                   (((nombre_octets - 1) - i) * 8);
                       }
                   }
   
                   if (position_finale - saut >= 0)
                   {
                       if (fseek((*descripteur).descripteur_c,
                               (long) (position_finale - saut), SEEK_SET) != 0)
                       {
                           liberation(s_etat_processus, s_objet_argument);
   
                           (*s_etat_processus).erreur_systeme =
                                   d_es_erreur_fichier;
                           return;
                       }
                   }
                   else
                   {
                       liberation(s_etat_processus, s_objet_argument);
   
                       (*s_etat_processus).erreur_execution =
                               d_ex_debut_de_fichier_atteint;
                       return;
                   }
             }              }
         }          }
         else          else
Line 1346  instruction_bessel(struct_processus *s_e Line 1509  instruction_bessel(struct_processus *s_e
                             }                              }
   
                             (*((real8 *) (*s_objet_resultat).objet)) =                              (*((real8 *) (*s_objet_resultat).objet)) =
                                     gsl_sf_bessel_Yn((double) ((*((real8 *)                                      gsl_sf_bessel_Yn((int) ((*((real8 *)
                                     (*s_objet_argument_2).objet))),                                      (*s_objet_argument_2).objet))),
                                     (double) ((*((real8 *)                                      (double) ((*((real8 *)
                                     (*s_objet_argument_1).objet))));                                      (*s_objet_argument_1).objet))));
Line 1375  instruction_bessel(struct_processus *s_e Line 1538  instruction_bessel(struct_processus *s_e
                             }                              }
   
                             (*((real8 *) (*s_objet_resultat).objet)) =                              (*((real8 *) (*s_objet_resultat).objet)) =
                                     gsl_sf_bessel_In((double) ((*((real8 *)                                      gsl_sf_bessel_In((int) ((*((real8 *)
                                     (*s_objet_argument_2).objet))),                                      (*s_objet_argument_2).objet))),
                                     (double) ((*((real8 *)                                      (double) ((*((real8 *)
                                     (*s_objet_argument_1).objet))));                                      (*s_objet_argument_1).objet))));
Line 1404  instruction_bessel(struct_processus *s_e Line 1567  instruction_bessel(struct_processus *s_e
                             }                              }
   
                             (*((real8 *) (*s_objet_resultat).objet)) =                              (*((real8 *) (*s_objet_resultat).objet)) =
                                     gsl_sf_bessel_Kn((double) ((*((real8 *)                                      gsl_sf_bessel_Kn((int) ((*((real8 *)
                                     (*s_objet_argument_2).objet))),                                      (*s_objet_argument_2).objet))),
                                     (double) ((*((real8 *)                                      (double) ((*((real8 *)
                                     (*s_objet_argument_1).objet))));                                      (*s_objet_argument_1).objet))));
Removed from v.1.19  
changed lines
  Added in v.1.73

CVSweb interface <joel.bertrand@systella.fr>