--- rpl/src/instructions_f1.c 2010/04/07 07:16:12 1.6 +++ rpl/src/instructions_f1.c 2013/03/22 10:20:35 1.55 @@ -1,7 +1,7 @@ /* ================================================================================ - RPL/2 (R) version 4.0.13 - Copyright (C) 1989-2010 Dr. BERTRAND Joël + RPL/2 (R) version 4.1.13 + Copyright (C) 1989-2013 Dr. BERTRAND Joël This file is part of RPL/2. @@ -20,7 +20,7 @@ */ -#include "rpl.conv.h" +#include "rpl-conv.h" /* @@ -59,8 +59,8 @@ instruction_fleche(struct_processus *s_e unsigned char *tampon; unsigned char test_instruction; - unsigned long i; - unsigned long nombre_variables; + integer8 i; + integer8 nombre_variables; void (*fonction)(); @@ -271,6 +271,7 @@ instruction_fleche(struct_processus *s_e } else { + (*s_etat_processus).expression_courante = l_element_courant; (*s_etat_processus).erreur_execution = d_ex_nom_invalide; return; } @@ -285,6 +286,7 @@ instruction_fleche(struct_processus *s_e } else if ((*(*l_element_courant).donnee).type != NOM) { + (*s_etat_processus).expression_courante = l_element_courant; (*s_etat_processus).erreur_execution = d_ex_nom_invalide; return; } @@ -293,6 +295,7 @@ instruction_fleche(struct_processus *s_e if ((s_objet_elementaire = copie_objet(s_etat_processus, (*l_element_courant).donnee, 'P')) == NULL) { + (*s_etat_processus).expression_courante = l_element_courant; (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; @@ -301,6 +304,7 @@ instruction_fleche(struct_processus *s_e if (empilement(s_etat_processus, &((*s_etat_processus) .l_base_pile), s_objet_elementaire) == d_erreur) { + (*s_etat_processus).expression_courante = l_element_courant; return; } @@ -312,6 +316,8 @@ instruction_fleche(struct_processus *s_e l_element_courant = (*l_element_courant).suivant; } while((fin_scrutation == d_faux) && (l_element_courant != NULL)); + (*s_etat_processus).objet_courant = + (*(*s_etat_processus).expression_courante).donnee; (*s_etat_processus).instruction_courante = tampon; if (fin_scrutation == d_faux) @@ -333,13 +339,13 @@ instruction_fleche(struct_processus *s_e { if ((*s_etat_processus).langue == 'F') { - printf("[%d] Nombre de variables de niveau %lu : %lu\n", + printf("[%d] Nombre de variables de niveau %lld : %lld\n", (int) getpid(), (*s_etat_processus).niveau_courant, nombre_variables); } else { - printf("[%d] Number of level %lu variables : %lu\n", + printf("[%d] Number of level %lld variables : %lld\n", (int) getpid(), (*s_etat_processus).niveau_courant, nombre_variables); } @@ -351,6 +357,12 @@ instruction_fleche(struct_processus *s_e for(i = 0; i < nombre_variables; i++) { + if (l_emplacement_valeurs == NULL) + { + (*s_etat_processus).erreur_execution = d_ex_manque_argument; + return; + } + l_emplacement_valeurs = (*l_emplacement_valeurs).suivant; } @@ -416,8 +428,7 @@ instruction_fleche(struct_processus *s_e if (recherche_variable(s_etat_processus, s_variable.nom) == d_vrai) { if ((*s_etat_processus).niveau_courant == - (*s_etat_processus).s_liste_variables[(*s_etat_processus) - .position_variable_courante].niveau) + (*(*s_etat_processus).pointeur_variable_courante).niveau) { liberation(s_etat_processus, s_objet); free(s_variable.nom); @@ -446,7 +457,7 @@ instruction_fleche(struct_processus *s_e if (recherche_variable_statique(s_etat_processus, s_variable.nom, position_variable, ((*s_etat_processus).mode_execution_programme == 'Y') - ? 'P' : 'E') == d_vrai) + ? 'P' : 'E') != NULL) { // Variable statique à utiliser @@ -459,12 +470,10 @@ instruction_fleche(struct_processus *s_e s_variable.origine = 'E'; } - s_variable.objet = (*s_etat_processus) - .s_liste_variables_statiques[(*s_etat_processus) - .position_variable_statique_courante].objet; - (*s_etat_processus).s_liste_variables_statiques - [(*s_etat_processus) - .position_variable_statique_courante].objet = NULL; + s_variable.objet = (*(*s_etat_processus) + .pointeur_variable_statique_courante).objet; + (*(*s_etat_processus).pointeur_variable_statique_courante) + .objet = NULL; } else { @@ -540,8 +549,7 @@ instruction_fleche(struct_processus *s_e (*s_etat_processus).objet_courant; } - if (pthread_mutex_lock(&((*(*s_etat_processus) - .s_liste_variables_partagees).mutex)) != 0) + if (pthread_mutex_lock(&mutex_creation_variable_partagee) != 0) { (*s_etat_processus).erreur_systeme = d_es_processus; return; @@ -550,12 +558,19 @@ instruction_fleche(struct_processus *s_e if (recherche_variable_partagee(s_etat_processus, s_variable.nom, position_variable, ((*s_etat_processus).mode_execution_programme == 'Y') - ? 'P' : 'E') == d_vrai) + ? 'P' : 'E') != NULL) { // Variable partagée à utiliser + if (pthread_mutex_unlock(&mutex_creation_variable_partagee) + != 0) + { + (*s_etat_processus).erreur_systeme = d_es_processus; + return; + } + if (pthread_mutex_unlock(&((*(*s_etat_processus) - .s_liste_variables_partagees).mutex)) != 0) + .pointeur_variable_partagee_courante).mutex)) != 0) { (*s_etat_processus).erreur_systeme = d_es_processus; return; @@ -578,7 +593,6 @@ instruction_fleche(struct_processus *s_e } else { - // Variable partagée à utiliser // Variable partagee à créer (*s_etat_processus).erreur_systeme = d_es; @@ -586,6 +600,13 @@ instruction_fleche(struct_processus *s_e if ((s_variable_partagee.nom = malloc((strlen(s_variable.nom) + 1) * sizeof(unsigned char))) == NULL) { + if (pthread_mutex_unlock(&((*(*s_etat_processus) + .pointeur_variable_partagee_courante).mutex)) != 0) + { + (*s_etat_processus).erreur_systeme = d_es_processus; + return; + } + (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; @@ -635,14 +656,14 @@ instruction_fleche(struct_processus *s_e return; } - if (pthread_mutex_unlock(&((*(*s_etat_processus) - .s_liste_variables_partagees).mutex)) != 0) + s_variable.objet = NULL; + + if (pthread_mutex_unlock(&mutex_creation_variable_partagee) + != 0) { (*s_etat_processus).erreur_systeme = d_es_processus; return; } - - s_variable.objet = NULL; } } else @@ -710,7 +731,7 @@ instruction_fleche(struct_processus *s_e (*s_etat_processus).niveau_courant--; - if (retrait_variable_par_niveau(s_etat_processus) == d_erreur) + if (retrait_variables_par_niveau(s_etat_processus) == d_erreur) { return; } @@ -741,8 +762,8 @@ instruction_fleche_list(struct_processus struct_objet *s_objet; - signed long i; - signed long nombre_elements; + integer8 i; + integer8 nombre_elements; (*s_etat_processus).erreur_execution = d_ex; @@ -817,8 +838,7 @@ instruction_fleche_list(struct_processus return; } - if ((unsigned long) nombre_elements >= - (*s_etat_processus).hauteur_pile_operationnelle) + if (nombre_elements >= (*s_etat_processus).hauteur_pile_operationnelle) { (*s_etat_processus).erreur_execution = d_ex_manque_argument; return; @@ -959,8 +979,6 @@ instruction_for(struct_processus *s_etat } } - empilement_pile_systeme(s_etat_processus); - if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile), &s_objet_1) == d_erreur) { @@ -1001,6 +1019,13 @@ instruction_for(struct_processus *s_etat instruction_valide = (*s_etat_processus).instruction_valide; (*s_etat_processus).test_instruction = 'Y'; + empilement_pile_systeme(s_etat_processus); + + if ((*s_etat_processus).erreur_systeme != d_es) + { + return; + } + if ((*s_etat_processus).mode_execution_programme == 'Y') { if (recherche_instruction_suivante(s_etat_processus) == d_erreur) @@ -1018,6 +1043,8 @@ instruction_for(struct_processus *s_etat free((*s_etat_processus).instruction_courante); (*s_etat_processus).instruction_courante = tampon; + depilement_pile_systeme(s_etat_processus); + (*s_etat_processus).erreur_execution = d_ex_nom_reserve; return; } @@ -1032,6 +1059,7 @@ instruction_for(struct_processus *s_etat liberation(s_etat_processus, s_objet_1); liberation(s_etat_processus, s_objet_2); + depilement_pile_systeme(s_etat_processus); return; } @@ -1041,6 +1069,8 @@ instruction_for(struct_processus *s_etat liberation(s_etat_processus, s_objet_1); liberation(s_etat_processus, s_objet_2); + depilement_pile_systeme(s_etat_processus); + (*s_etat_processus).erreur_execution = d_ex_manque_argument; return; } @@ -1052,6 +1082,7 @@ instruction_for(struct_processus *s_etat { if ((*s_etat_processus).expression_courante == NULL) { + depilement_pile_systeme(s_etat_processus); (*s_etat_processus).erreur_execution = d_ex_manque_argument; return; } @@ -1076,6 +1107,8 @@ instruction_for(struct_processus *s_etat liberation(s_etat_processus, s_objet_1); liberation(s_etat_processus, s_objet_2); + depilement_pile_systeme(s_etat_processus); + (*s_etat_processus).erreur_execution = d_ex_erreur_traitement_boucle; return; } @@ -1084,6 +1117,8 @@ instruction_for(struct_processus *s_etat liberation(s_etat_processus, s_objet_1); liberation(s_etat_processus, s_objet_2); + depilement_pile_systeme(s_etat_processus); + (*s_etat_processus).erreur_execution = d_ex_erreur_traitement_boucle; return; } @@ -1808,7 +1843,7 @@ instruction_fact(struct_processus *s_eta for (i = 1; i <= (*((integer8 *) (*s_objet_argument).objet)); i++) { - produit *= i; + produit *= (real8) i; } if ((s_objet_resultat = allocation(s_etat_processus, REL)) @@ -2132,7 +2167,7 @@ instruction_floor(struct_processus *s_et return; } - (*((integer8 *) (*s_objet_resultat).objet)) = + (*((integer8 *) (*s_objet_resultat).objet)) = (integer8) floor((*((real8 *) (*s_objet_argument).objet))); if (!((((*((integer8 *) (*s_objet_resultat).objet)) < @@ -2764,7 +2799,7 @@ instruction_fix(struct_processus *s_etat return; } - (*((logical8 *) (*s_objet).objet)) = + (*((logical8 *) (*s_objet).objet)) = (logical8) (*((integer8 *) (*s_objet_argument).objet)); i43 = test_cfsf(s_etat_processus, 43); @@ -2802,15 +2837,15 @@ instruction_fix(struct_processus *s_etat { 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 <= 56; cf(s_etat_processus, j++)); + for(; j <= 56; cf(s_etat_processus, (unsigned char) j++)); sf(s_etat_processus, 49); cf(s_etat_processus, 50);