[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.2 and 1.74

version 1.2, 2010/01/27 22:22:12 version 1.74, 2024/01/09 07:33:49
Line 1 Line 1
 /*  /*
 ================================================================================  ================================================================================
   RPL/2 (R) version 4.0.10    RPL/2 (R) version 4.1.35
   Copyright (C) 1989-2010 Dr. BERTRAND Joël    Copyright (C) 1989-2024 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 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 241  instruction_b_vers_r(struct_processus *s Line 241  instruction_b_vers_r(struct_processus *s
 void  void
 instruction_backspace(struct_processus *s_etat_processus)  instruction_backspace(struct_processus *s_etat_processus)
 {  {
     file                        *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 304  instruction_backspace(struct_processus * Line 308  instruction_backspace(struct_processus *
     if ((*s_objet_argument).type == FCH)      if ((*s_objet_argument).type == FCH)
     {      {
         /*          /*
          * Vérification des verrous           * Fichiers à accès séquentiel
          */           */
   
         lock.l_type = F_RDLCK;          if ((*((struct_fichier *) (*s_objet_argument).objet)).acces == 'S')
         lock.l_whence = SEEK_SET;  
         lock.l_start = 0;  
         lock.l_len = 0;  
         lock.l_pid = getpid();  
   
         if ((descripteur = descripteur_fichier(s_etat_processus,  
                 (struct_fichier *) (*s_objet_argument).objet)) == NULL)  
         {          {
             liberation(s_etat_processus, s_objet_argument);              /*
             return;               * Vérification des verrous
         }               */
   
         if (fcntl(fileno(descripteur), F_GETLK, &lock) == -1)              lock.l_type = F_RDLCK;
         {              lock.l_whence = SEEK_SET;
             liberation(s_etat_processus, s_objet_argument);              lock.l_start = 0;
               lock.l_len = 0;
               lock.l_pid = getpid();
   
             (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;              if ((descripteur = descripteur_fichier(s_etat_processus,
             return;                      (struct_fichier *) (*s_objet_argument).objet)) == NULL)
         }              {
                   liberation(s_etat_processus, s_objet_argument);
                   return;
               }
   
         if (lock.l_type != F_UNLCK)              if (fcntl(fileno((*descripteur).descripteur_c), F_GETLK, &lock)
         {                      == -1)
             liberation(s_etat_processus, s_objet_argument);              {
                   liberation(s_etat_processus, s_objet_argument);
   
             (*s_etat_processus).erreur_execution =                  (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
                     d_ex_fichier_verrouille;                  return;
             return;              }
         }  
   
         if ((*((struct_fichier *) (*s_objet_argument).objet)).acces == 'S')              if (lock.l_type != F_UNLCK)
         {              {
             /*                  liberation(s_etat_processus, s_objet_argument);
              * Fichiers à accès séquentiel  
              */                  (*s_etat_processus).erreur_execution =
                           d_ex_fichier_verrouille;
                   return;
               }
   
             if ((*((struct_fichier *) (*s_objet_argument).objet)).binaire              if ((*((struct_fichier *) (*s_objet_argument).objet)).binaire
                     == 'N')                      == 'N')
Line 350  instruction_backspace(struct_processus * Line 355  instruction_backspace(struct_processus *
                  * Fichiers formatés                   * Fichiers formatés
                  */                   */
   
                 if ((position_finale = ftell(descripteur)) == -1)                  if ((position_finale = ftell((*descripteur).descripteur_c))
                           == -1)
                 {                  {
                     liberation(s_etat_processus, s_objet_argument);                      liberation(s_etat_processus, s_objet_argument);
   
Line 360  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 381  instruction_backspace(struct_processus * Line 387  instruction_backspace(struct_processus *
                         longueur_effective = longueur_questure;                          longueur_effective = longueur_questure;
                     }                      }
   
                     if (fseek(descripteur, position_initiale, SEEK_SET) != 0)                      if (fseek((*descripteur).descripteur_c,
                               (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).descripteur_c);
   
                     pointeur = longueur_effective - 1;                      pointeur = longueur_effective - 1;
                     presence_indicateur = d_faux;                      presence_indicateur = d_faux;
Line 416  instruction_backspace(struct_processus * Line 423  instruction_backspace(struct_processus *
                      * Le début du fichier est atteint.                       * Le début du fichier est atteint.
                      */                       */
   
                     if (fseek(descripteur, 0, SEEK_SET) != 0)                      if (fseek((*descripteur).descripteur_c, 0, SEEK_SET) != 0)
                     {                      {
                         liberation(s_etat_processus, s_objet_argument);                          liberation(s_etat_processus, s_objet_argument);
                         free(tampon_lecture);                          free(tampon_lecture);
Line 463  instruction_backspace(struct_processus * Line 470  instruction_backspace(struct_processus *
                         position_finale--;                          position_finale--;
                     }                      }
   
                     if (fseek(descripteur, position_initiale, SEEK_SET) != 0)                      if (fseek((*descripteur).descripteur_c,
                               (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).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 496  instruction_backspace(struct_processus * Line 523  instruction_backspace(struct_processus *
                             }                              }
                         }                          }
   
                         if (niveau == 0)                          if (guillemets_a_cheval == d_faux)
                         {                          {
                             presence_indicateur = d_vrai;                              if (niveau == 0)
                         }                              {
                         else                                  presence_indicateur = d_vrai;
                         {                              }
                             position_finale--;                              else
                             pointeur--;                              {
                                   position_finale--;
                                   pointeur--;
                               }
                         }                          }
                     }                      }
                 } while((longueur_effective == longueur_questure) &&                  } while((longueur_effective == longueur_questure) &&
Line 519  instruction_backspace(struct_processus * Line 549  instruction_backspace(struct_processus *
                     return;                      return;
                 }                  }
   
                 if (fseek(descripteur, position_finale, SEEK_SET) != 0)                  if (fseek((*descripteur).descripteur_c, (long) position_finale,
                           SEEK_SET) != 0)
                 {                  {
                     liberation(s_etat_processus, s_objet_argument);                      liberation(s_etat_processus, s_objet_argument);
                     free(tampon_lecture);                      free(tampon_lecture);
Line 535  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 1341  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 1370  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 1399  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))));
Line 1826  instruction_bessel(struct_processus *s_e Line 1994  instruction_bessel(struct_processus *s_e
   
     return;      return;
 }  }
   
   
   /*
   ================================================================================
     Fonction 'backtrace'
   ================================================================================
     Entrées :
   --------------------------------------------------------------------------------
     Sorties :
   --------------------------------------------------------------------------------
     Effets de bord : néant
   ================================================================================
   */
   
   void
   instruction_backtrace(struct_processus *s_etat_processus)
   {
       (*s_etat_processus).erreur_execution = d_ex;
   
       if ((*s_etat_processus).affichage_arguments == 'Y')
       {
           printf("\n  BACKTRACE ");
   
           if ((*s_etat_processus).langue == 'F')
           {
               printf("(affichage de la pile système)\n\n");
               printf("  Aucun argument\n");
           }
           else
           {
               printf("(print system stack)\n\n");
               printf("  No argument\n");
           }
   
           return;
       }
       else if ((*s_etat_processus).test_instruction == 'Y')
       {
           (*s_etat_processus).nombre_arguments = -1;
           return;
       }
   
       if (test_cfsf(s_etat_processus, 31) == d_vrai)
       {
           if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
           {
               return;
           }
       }
   
       trace(s_etat_processus, stdout);
   
       return;
   }
   
 // vim: ts=4  // vim: ts=4
Removed from v.1.2  
changed lines
  Added in v.1.74

CVSweb interface <joel.bertrand@systella.fr>