--- rpl/src/instructions_s4.c 2010/03/04 10:17:53 1.4 +++ rpl/src/instructions_s4.c 2016/03/01 22:12:34 1.57 @@ -1,7 +1,7 @@ /* ================================================================================ - RPL/2 (R) version 4.0.12 - Copyright (C) 1989-2010 Dr. BERTRAND Joël + RPL/2 (R) version 4.1.25 + Copyright (C) 1989-2016 Dr. BERTRAND Joël This file is part of RPL/2. @@ -20,7 +20,7 @@ */ -#include "rpl.conv.h" +#include "rpl-conv.h" /* @@ -38,10 +38,6 @@ void instruction_steq(struct_processus *s_etat_processus) { - logical1 presence_variable; - - long i; - struct_objet *s_objet; struct_variable s_variable; @@ -93,83 +89,21 @@ instruction_steq(struct_processus *s_eta return; } - if (recherche_variable(s_etat_processus, "EQ") == d_vrai) + if (recherche_variable_globale(s_etat_processus, "EQ") == d_vrai) { - /* - * La variable préexiste. Il faut tester si celle-ci est globale - * (de niveau 1). - */ - - i = (*s_etat_processus).position_variable_courante; - presence_variable = d_faux; - - while(i >= 0) + if ((*(*s_etat_processus).pointeur_variable_courante) + .variable_verrouillee == d_vrai) { - if ((strcmp((*s_etat_processus).s_liste_variables[i].nom, "EQ") - == 0) && ((*s_etat_processus).s_liste_variables[i] - .niveau == 1)) - { - presence_variable = d_vrai; - break; - } - i--; - } - - (*s_etat_processus).position_variable_courante = i; - - if (presence_variable == d_vrai) - { - if ((*s_etat_processus).s_liste_variables[(*s_etat_processus) - .position_variable_courante].variable_verrouillee == - d_vrai) - { - liberation(s_etat_processus, s_objet); + liberation(s_etat_processus, s_objet); - (*s_etat_processus).erreur_execution = - d_ex_variable_verrouillee; - return; - } - - if ((*s_etat_processus).s_liste_variables[i].objet == NULL) - { - liberation(s_etat_processus, s_objet); - - (*s_etat_processus).erreur_execution = d_ex_variable_partagee; - return; - } - - liberation(s_etat_processus, - (*s_etat_processus).s_liste_variables[(*s_etat_processus) - .position_variable_courante].objet); - - (*s_etat_processus).s_liste_variables[(*s_etat_processus) - .position_variable_courante].objet = s_objet; + (*s_etat_processus).erreur_execution = + d_ex_variable_verrouillee; + return; } - else - { - if ((s_variable.nom = malloc(3 * sizeof(unsigned char))) == NULL) - { - (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; - return; - } - - strcpy(s_variable.nom, "EQ"); - s_variable.niveau = 1; - - /* - * Le niveau 0 correspond aux définitions. Les variables - * commencent à 1 car elles sont toujours incluses dans - * une définition. - */ - - s_variable.objet = s_objet; - if (creation_variable(s_etat_processus, &s_variable, 'V', 'P') - == d_erreur) - { - return; - } - } + liberation(s_etat_processus, + (*(*s_etat_processus).pointeur_variable_courante).objet); + (*(*s_etat_processus).pointeur_variable_courante).objet = s_objet; } else { @@ -177,6 +111,9 @@ instruction_steq(struct_processus *s_eta * La variable n'existe pas et on crée une variable globale. */ + (*s_etat_processus).erreur_systeme = d_es; + (*s_etat_processus).erreur_execution = d_ex; + if ((s_variable.nom = malloc(3 * sizeof(unsigned char))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; @@ -199,8 +136,6 @@ instruction_steq(struct_processus *s_eta { return; } - - (*s_etat_processus).erreur_systeme = d_es; } return; @@ -611,6 +546,7 @@ instruction_store(struct_processus *s_et file *fichier; logical1 i45; + logical1 i48; logical1 i49; logical1 i50; @@ -618,6 +554,8 @@ instruction_store(struct_processus *s_et struct_objet *s_objet_argument_2; unsigned char *ligne; + unsigned char *ligne_convertie; + unsigned char registre; (*s_etat_processus).erreur_execution = d_ex; @@ -710,10 +648,12 @@ instruction_store(struct_processus *s_et } i45 = test_cfsf(s_etat_processus, 45); + i48 = test_cfsf(s_etat_processus, 48); i49 = test_cfsf(s_etat_processus, 49); i50 = test_cfsf(s_etat_processus, 50); cf(s_etat_processus, 45); + cf(s_etat_processus, 48); cf(s_etat_processus, 49); cf(s_etat_processus, 50); @@ -723,23 +663,45 @@ instruction_store(struct_processus *s_et return; } + registre = (*s_etat_processus).autorisation_conversion_chaine; + (*s_etat_processus).autorisation_conversion_chaine = 'N'; + + ligne = formateur(s_etat_processus, 0, s_objet_argument_2); + + if ((ligne_convertie = transliteration(s_etat_processus, + ligne, d_locale, "UTF-8")) == NULL) + { + free(ligne); + + liberation(s_etat_processus, s_objet_argument_1); + liberation(s_etat_processus, s_objet_argument_2); + return; + } + + free(ligne); + ligne = ligne_convertie; + + (*s_etat_processus).autorisation_conversion_chaine = registre; + if ((*s_objet_argument_2).type == CHN) { - if (fprintf(fichier, "\"%s\"\n", ligne = formateur(s_etat_processus, - 0, s_objet_argument_2)) < 0) + if (fprintf(fichier, "\"%s\"\n", ligne) < 0) { (*s_etat_processus).erreur_systeme = d_es_erreur_fichier; return; } + + (*s_etat_processus).autorisation_conversion_chaine = registre; } else { - if (fprintf(fichier, "%s\n", ligne = formateur(s_etat_processus, - 0, s_objet_argument_2)) < 0) + if (fprintf(fichier, "%s\n", ligne) < 0) { (*s_etat_processus).erreur_systeme = d_es_erreur_fichier; return; } + + (*s_etat_processus).autorisation_conversion_chaine = registre; } free(ligne); @@ -759,6 +721,15 @@ instruction_store(struct_processus *s_et cf(s_etat_processus, 45); } + if (i48 == d_vrai) + { + sf(s_etat_processus, 48); + } + else + { + cf(s_etat_processus, 48); + } + if (i49 == d_vrai) { sf(s_etat_processus, 49); @@ -876,8 +847,8 @@ instruction_stws(struct_processus *s_eta return; } - (*((logical8 *) (*s_objet_binaire).objet)) = (*((integer8 *) - (*s_objet_argument).objet)) - 1; + (*((logical8 *) (*s_objet_binaire).objet)) = (logical8) ((*((integer8 *) + (*s_objet_argument).objet)) - 1); i43 = test_cfsf(s_etat_processus, 43); i44 = test_cfsf(s_etat_processus, 44); @@ -911,15 +882,15 @@ instruction_stws(struct_processus *s_eta { if (valeur_binaire[i] == '0') { - cf(s_etat_processus, j++); + cf(s_etat_processus, (unsigned char) j++); } else { - sf(s_etat_processus, j++); + sf(s_etat_processus, (unsigned char) j++); } } - for(; j <= 42; cf(s_etat_processus, j++)); + for(; j <= 42; cf(s_etat_processus, (unsigned char) j++)); free(valeur_binaire); } @@ -1548,10 +1519,6 @@ instruction_star_s(struct_processus *s_e void instruction_stos(struct_processus *s_etat_processus) { - logical1 presence_variable; - - long i; - struct_objet *s_objet; struct_variable s_variable; @@ -1601,83 +1568,21 @@ instruction_stos(struct_processus *s_eta return; } - if (recherche_variable(s_etat_processus, ds_sdat) == d_vrai) + if (recherche_variable_globale(s_etat_processus, ds_sdat) == d_vrai) { - /* - * La variable préexiste. Il faut tester si celle-ci est globale - * (de niveau 1). - */ - - i = (*s_etat_processus).position_variable_courante; - presence_variable = d_faux; - - while(i >= 0) - { - if ((strcmp((*s_etat_processus).s_liste_variables[i].nom, ds_sdat) - == 0) && ((*s_etat_processus).s_liste_variables[i] - .niveau == 1)) - { - presence_variable = d_vrai; - break; - } - i--; - } - - (*s_etat_processus).position_variable_courante = i; - - if (presence_variable == d_vrai) + if ((*(*s_etat_processus).pointeur_variable_courante) + .variable_verrouillee == d_vrai) { - if ((*s_etat_processus).s_liste_variables[(*s_etat_processus) - .position_variable_courante].variable_verrouillee == - d_vrai) - { - liberation(s_etat_processus, s_objet); + liberation(s_etat_processus, s_objet); - (*s_etat_processus).erreur_execution = - d_ex_variable_verrouillee; - return; - } - - if ((*s_etat_processus).s_liste_variables[i].objet == NULL) - { - liberation(s_etat_processus, s_objet); - - (*s_etat_processus).erreur_execution = d_ex_variable_partagee; - return; - } - - liberation(s_etat_processus, - (*s_etat_processus).s_liste_variables[(*s_etat_processus) - .position_variable_courante].objet); - - (*s_etat_processus).s_liste_variables[(*s_etat_processus) - .position_variable_courante].objet = s_objet; + (*s_etat_processus).erreur_execution = + d_ex_variable_verrouillee; + return; } - else - { - if ((s_variable.nom = malloc(6 * sizeof(unsigned char))) == NULL) - { - (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; - return; - } - - strcpy(s_variable.nom, ds_sdat); - s_variable.niveau = 1; - - /* - * Le niveau 0 correspond aux définitions. Les variables - * commencent à 1 car elles sont toujours incluses dans - * une définition. - */ - s_variable.objet = s_objet; - - if (creation_variable(s_etat_processus, &s_variable, 'V', 'P') - == d_erreur) - { - return; - } - } + liberation(s_etat_processus, + (*(*s_etat_processus).pointeur_variable_courante).objet); + (*(*s_etat_processus).pointeur_variable_courante).objet = s_objet; } else { @@ -1685,6 +1590,9 @@ instruction_stos(struct_processus *s_eta * La variable n'existe pas et on crée une variable globale. */ + (*s_etat_processus).erreur_systeme = d_es; + (*s_etat_processus).erreur_execution = d_ex; + if ((s_variable.nom = malloc(6 * sizeof(unsigned char))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; @@ -1707,8 +1615,6 @@ instruction_stos(struct_processus *s_eta { return; } - - (*s_etat_processus).erreur_systeme = d_es; } return;