--- rpl/src/instructions_b1.c 2010/08/06 15:26:46 1.13 +++ rpl/src/instructions_b1.c 2018/12/24 15:55:25 1.66 @@ -1,7 +1,7 @@ /* ================================================================================ - RPL/2 (R) version 4.0.18 - Copyright (C) 1989-2010 Dr. BERTRAND Joël + RPL/2 (R) version 4.1.30 + Copyright (C) 1989-2018 Dr. BERTRAND Joël This file is part of RPL/2. @@ -203,7 +203,7 @@ instruction_b_vers_r(struct_processus *s return; } - (*((integer8 *) (*s_objet_resultat).objet)) = (*((logical8 *) + (*((integer8 *) (*s_objet_resultat).objet)) = (integer8) (*((logical8 *) (*s_objet_argument).objet)); } else @@ -243,23 +243,27 @@ instruction_backspace(struct_processus * { struct_descripteur_fichier *descripteur; + integer8 i; + integer8 nombre_octets; integer8 position_finale; integer8 position_initiale; + integer8 saut; + integer8 pointeur; + integer8 niveau; + integer8 longueur_effective; + integer8 longueur_questure; + + logical1 guillemets_a_cheval; logical1 presence_chaine; logical1 presence_indicateur; - long pointeur; - long niveau; - - size_t longueur_effective; - size_t longueur_questure; - struct flock lock; struct_objet *s_objet_argument; unsigned char *tampon_lecture; + unsigned char tampon[9]; (*s_etat_processus).erreur_execution = d_ex; @@ -362,7 +366,7 @@ instruction_backspace(struct_processus * longueur_questure = 256; - if ((tampon_lecture = malloc(longueur_questure * + if ((tampon_lecture = malloc(((size_t) longueur_questure) * sizeof(unsigned char))) == NULL) { (*s_etat_processus).erreur_systeme = @@ -383,16 +387,16 @@ instruction_backspace(struct_processus * longueur_effective = longueur_questure; } - if (fseek((*descripteur).descripteur_c, position_initiale, - SEEK_SET) != 0) + if (fseek((*descripteur).descripteur_c, + (long) position_initiale, SEEK_SET) != 0) { (*s_etat_processus).erreur_systeme = d_es_erreur_fichier; return; } - longueur_effective = fread(tampon_lecture, - (size_t) sizeof(unsigned char), longueur_effective, + longueur_effective = (integer8) fread(tampon_lecture, + sizeof(unsigned char), (size_t) longueur_effective, (*descripteur).descripteur_c); pointeur = longueur_effective - 1; @@ -466,27 +470,46 @@ instruction_backspace(struct_processus * position_finale--; } - if (fseek((*descripteur).descripteur_c, position_initiale, - SEEK_SET) != 0) + if (fseek((*descripteur).descripteur_c, + (long) position_initiale, SEEK_SET) != 0) { (*s_etat_processus).erreur_systeme = d_es_erreur_fichier; return; } - longueur_effective = fread(tampon_lecture, - (size_t) sizeof(unsigned char), longueur_effective, + longueur_effective = (integer8) fread(tampon_lecture, + sizeof(unsigned char), (size_t) longueur_effective, (*descripteur).descripteur_c); pointeur = longueur_effective - 1; 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] == '"') { - presence_chaine = (presence_chaine == d_vrai) - ? d_faux : d_vrai; + if (pointeur > 0) + { + // 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 { @@ -500,14 +523,17 @@ instruction_backspace(struct_processus * } } - if (niveau == 0) - { - presence_indicateur = d_vrai; - } - else + if (guillemets_a_cheval == d_faux) { - position_finale--; - pointeur--; + if (niveau == 0) + { + presence_indicateur = d_vrai; + } + else + { + position_finale--; + pointeur--; + } } } } while((longueur_effective == longueur_questure) && @@ -523,7 +549,7 @@ instruction_backspace(struct_processus * return; } - if (fseek((*descripteur).descripteur_c, position_finale, + if (fseek((*descripteur).descripteur_c, (long) position_finale, SEEK_SET) != 0) { liberation(s_etat_processus, s_objet_argument); @@ -540,6 +566,143 @@ instruction_backspace(struct_processus * /* * 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 @@ -1346,7 +1509,7 @@ instruction_bessel(struct_processus *s_e } (*((real8 *) (*s_objet_resultat).objet)) = - gsl_sf_bessel_Yn((double) ((*((real8 *) + gsl_sf_bessel_Yn((int) ((*((real8 *) (*s_objet_argument_2).objet))), (double) ((*((real8 *) (*s_objet_argument_1).objet)))); @@ -1375,7 +1538,7 @@ instruction_bessel(struct_processus *s_e } (*((real8 *) (*s_objet_resultat).objet)) = - gsl_sf_bessel_In((double) ((*((real8 *) + gsl_sf_bessel_In((int) ((*((real8 *) (*s_objet_argument_2).objet))), (double) ((*((real8 *) (*s_objet_argument_1).objet)))); @@ -1404,7 +1567,7 @@ instruction_bessel(struct_processus *s_e } (*((real8 *) (*s_objet_resultat).objet)) = - gsl_sf_bessel_Kn((double) ((*((real8 *) + gsl_sf_bessel_Kn((int) ((*((real8 *) (*s_objet_argument_2).objet))), (double) ((*((real8 *) (*s_objet_argument_1).objet))));