--- rpl/src/evaluation.c 2013/03/05 16:20:47 1.70 +++ rpl/src/evaluation.c 2013/04/01 15:29:34 1.76 @@ -1,6 +1,6 @@ /* ================================================================================ - RPL/2 (R) version 4.1.13 + RPL/2 (R) version 4.1.14 Copyright (C) 1989-2013 Dr. BERTRAND Joël This file is part of RPL/2. @@ -48,6 +48,13 @@ evaluation(struct_processus *s_etat_proc { integer8 i; integer8 j; + integer8 k; + integer8 l; + integer8 niveau_initial; + integer8 nombre_termes; + integer8 registre_hauteur_pile_operationnelle; + integer8 registre_position_courante; + logical1 drapeau_then; logical1 erreur_evaluation; @@ -89,17 +96,9 @@ evaluation(struct_processus *s_etat_proc unsigned char registre_test_2; unsigned char registre_type_evaluation; - unsigned int registre_erreur_execution; - unsigned int registre_erreur_systeme; - unsigned int registre_exception; - - unsigned long k; - unsigned long l; - unsigned long niveau_initial; - unsigned long nombre_termes; - unsigned long registre_hauteur_pile_operationnelle; - unsigned long registre_niveau_courant; - unsigned long registre_position_courante; + int registre_erreur_execution; + int registre_erreur_systeme; + int registre_exception; void (*fonction)(); @@ -292,13 +291,13 @@ evaluation(struct_processus *s_etat_proc if (presence_variable_partagee == d_faux) { (*s_etat_processus).position_courante = - (*((unsigned long *) ((*(*(*s_etat_processus) + (*((integer8 *) ((*(*(*s_etat_processus) .pointeur_variable_courante).objet).objet))); } else { (*s_etat_processus).position_courante = - (*((unsigned long *) (*s_copie_variable_partagee) + (*((integer8 *) (*s_copie_variable_partagee) .objet)); liberation(s_etat_processus, s_copie_variable_partagee); } @@ -325,6 +324,8 @@ evaluation(struct_processus *s_etat_proc if (sequenceur(s_etat_processus) == d_erreur) { + depilement_pile_systeme(s_etat_processus); + (*s_etat_processus).evaluation_forcee = registre_evaluation_forcee; (*s_etat_processus).mode_execution_programme = @@ -410,7 +411,8 @@ evaluation(struct_processus *s_etat_proc .niveau_courant = (*s_etat_processus) .niveau_courant; - empilement_pile_systeme(s_etat_processus); + // ICI + //empilement_pile_systeme(s_etat_processus); if (presence_variable_partagee == d_faux) { @@ -423,6 +425,8 @@ evaluation(struct_processus *s_etat_proc profilage(s_etat_processus, NULL); } + depilement_pile_systeme(s_etat_processus); + (*s_etat_processus).evaluation_expression_compilee = registre_evaluation_expression_compilee; @@ -445,6 +449,8 @@ evaluation(struct_processus *s_etat_proc profilage(s_etat_processus, NULL); } + depilement_pile_systeme(s_etat_processus); + (*s_etat_processus).evaluation_expression_compilee = registre_evaluation_expression_compilee; @@ -464,7 +470,6 @@ evaluation(struct_processus *s_etat_proc } depilement_pile_systeme(s_etat_processus); - depilement_pile_systeme(s_etat_processus); if ((*s_etat_processus).erreur_systeme != d_es) { @@ -715,10 +720,6 @@ evaluation(struct_processus *s_etat_proc registre_retour_definition = (*(*s_etat_processus).l_base_pile_systeme) .retour_definition; (*(*s_etat_processus).l_base_pile_systeme).retour_definition = 'N'; - /* - (*(*s_etat_processus).l_base_pile_systeme).pointeur_adresse_retour = - s_objet; - */ l_element_courant = (struct_liste_chainee *) (*s_objet).objet; autorisation_empilement_programme = (*s_etat_processus) @@ -3386,6 +3387,8 @@ evaluation(struct_processus *s_etat_proc liberation(s_etat_processus, s_objet_evalue); } + depilement_pile_systeme(s_etat_processus); + (*s_etat_processus).instruction_courante = instruction_courante; return(d_erreur); @@ -3405,8 +3408,7 @@ evaluation(struct_processus *s_etat_proc .niveau_courant; (*s_etat_processus).position_courante = - (*((unsigned long *) - ((*(*(*s_etat_processus) + (*((integer8 *) ((*(*(*s_etat_processus) .pointeur_variable_courante).objet).objet))); if ((*s_etat_processus).profilage == d_vrai) @@ -3470,6 +3472,8 @@ evaluation(struct_processus *s_etat_proc liberation(s_etat_processus, s_objet_evalue); } + depilement_pile_systeme(s_etat_processus); + (*s_etat_processus).instruction_courante = instruction_courante; (*s_etat_processus).mode_execution_programme = @@ -5871,6 +5875,378 @@ evaluation(struct_processus *s_etat_proc (*s_etat_processus).instruction_courante = instruction_courante; + (*s_etat_processus).exception = d_ep; + (*s_etat_processus).erreur_execution = d_ex; + + erreur_evaluation = d_erreur; + } + else + { + // On ne détruit pas les variables pour les inclure + // dans le fichier rpl-core. + + (*s_etat_processus).gel_liste_variables = d_vrai; + + registre_erreur_execution = + (*s_etat_processus).erreur_execution; + registre_exception = + (*s_etat_processus).exception; + registre_erreur_systeme = + (*s_etat_processus).erreur_systeme; + + (*s_etat_processus).s_objet_errone = s_objet; + (*s_etat_processus).s_objet_erreur = + (*l_element_courant).donnee; + + l_element_courant = (*l_element_courant).suivant; + + while(l_element_courant != NULL) + { + if ((*(*l_element_courant).donnee).type == FCT) + { + (*s_etat_processus).instruction_courante = + (*((struct_fonction *) + (*(*l_element_courant).donnee) + .objet)).nom_fonction; + fonction = (*((struct_fonction *) + (*(*l_element_courant).donnee) + .objet)).fonction; + + if (recherche_variable(s_etat_processus, + (*s_etat_processus) + .instruction_courante) == d_faux) + { + (*s_etat_processus).erreur_systeme + = d_es; + + /* + * Traitement de la pile système par les + * différentes instructions. + */ + + if (TEST(instruction_if) || + TEST(instruction_iferr) || + TEST(instruction_do) || + TEST(instruction_while) || + TEST(instruction_for) || + TEST(instruction_forall) || + TEST(instruction_start) || + TEST(instruction_select) || + TEST(instruction_case) || + TEST(instruction_critical) || + TEST(vers_niveau_superieur)) + { + if (TEST(vers_niveau_superieur)) + { + analyse(s_etat_processus, + vers_niveau_superieur); + + if ((*s_etat_processus) + .erreur_systeme != d_es) + { + if (presence_egalite == + d_vrai) + { + liberation( + s_etat_processus, + s_objet_evalue); + } + + (*s_etat_processus) + .instruction_courante = + instruction_courante; + return(d_erreur); + } + } + else if (TEST(instruction_for) || + TEST(instruction_forall) || + TEST(instruction_start)) + { + empilement_pile_systeme( + s_etat_processus); + + if ((*s_etat_processus) + .erreur_systeme != d_es) + { + if (presence_egalite == + d_vrai) + { + liberation( + s_etat_processus, + s_objet_evalue); + } + + (*s_etat_processus) + .instruction_courante = + instruction_courante; + return(d_erreur); + } + + (*(*s_etat_processus) + .l_base_pile_systeme) + .type_cloture = 'L'; + } + else + { + empilement_pile_systeme( + s_etat_processus); + + if ((*s_etat_processus) + .erreur_systeme != d_es) + { + if (presence_egalite == + d_vrai) + { + liberation( + s_etat_processus, + s_objet_evalue); + } + + (*s_etat_processus) + .instruction_courante = + instruction_courante; + return(d_erreur); + } + } + } + else if (TEST(instruction_end) || + TEST(instruction_next) || + TEST(instruction_step) || + TEST(vers_niveau_inferieur)) + { + if (TEST(vers_niveau_inferieur)) + { + analyse(s_etat_processus, + vers_niveau_inferieur); + + if ((*s_etat_processus) + .erreur_systeme != d_es) + { + if (presence_egalite == + d_vrai) + { + liberation( + s_etat_processus, + s_objet_evalue); + } + + (*s_etat_processus) + .instruction_courante = + instruction_courante; + return(d_erreur); + } + } + else if ((TEST(instruction_next) || + TEST(instruction_step)) && + ((*(*s_etat_processus) + .l_base_pile_systeme) + .type_cloture != 'L')) + { + /* + * Libération des compteurs + * de boucle + */ + + presence_compteur = + (((*(*s_etat_processus) + .l_base_pile_systeme) + .type_cloture == 'F') || + ((*(*s_etat_processus) + .l_base_pile_systeme) + .type_cloture == 'A')) + ? d_vrai : d_faux; + + if (((*(*s_etat_processus) + .l_base_pile_systeme) + .type_cloture != 'S') && + (presence_compteur == + d_faux)) + { + (*s_etat_processus) + .erreur_execution = + d_ex_erreur_traitement_boucle; + + if (presence_egalite == + d_vrai) + { + liberation( + s_etat_processus, + s_objet_evalue); + } + + (*s_etat_processus) + .instruction_courante = + instruction_courante; + return(d_erreur); + } + + if (presence_compteur == d_vrai) + { + if (recherche_variable( + s_etat_processus, + (*(*s_etat_processus) + .l_base_pile_systeme) + .nom_variable) == + d_faux) + { + (*s_etat_processus) + .erreur_systeme = d_es; + (*s_etat_processus) + .erreur_execution = + d_ex_erreur_traitement_boucle; + + if (presence_egalite == + d_vrai) + { + liberation( + s_etat_processus, + s_objet_evalue); + } + + (*s_etat_processus) + .instruction_courante = + instruction_courante; + return(d_erreur); + } + + if ((*(*s_etat_processus) + .pointeur_variable_courante) + .objet == NULL) + { + (*s_etat_processus) + .erreur_systeme = d_es; + (*s_etat_processus) + .erreur_execution = + d_ex_variable_partagee; + + if (presence_egalite == + d_vrai) + { + liberation( + s_etat_processus, + s_objet_evalue); + } + + (*s_etat_processus) + .instruction_courante = + instruction_courante; + return(d_erreur); + } + + (*s_etat_processus) + .niveau_courant--; + + if ( + retrait_variables_par_niveau( + s_etat_processus) == d_erreur) + { + if (presence_egalite == + d_vrai) + { + liberation( + s_etat_processus, + s_objet_evalue); + } + + (*s_etat_processus) + .instruction_courante = + instruction_courante; + return(d_erreur); + } + } + + depilement_pile_systeme( + s_etat_processus); + } + else + { + // Traitement spécifique pour la + // fin d'une section critique + + if ((*s_etat_processus) + .l_base_pile_systeme == + NULL) + { + (*s_etat_processus) + .erreur_systeme = + d_es_end_incoherent; + + if (presence_egalite == + d_vrai) + { + liberation( + s_etat_processus, + s_objet_evalue); + } + + (*s_etat_processus) + .instruction_courante = + instruction_courante; + return(d_erreur); + } + + if ((*(*s_etat_processus) + .l_base_pile_systeme) + .type_cloture == 'Q') + { + if (pthread_mutex_unlock( + &mutex_sections_critiques) + != 0) + { + (*s_etat_processus) + .erreur_systeme = + d_es_processus; + + if (presence_egalite == + d_vrai) + { + liberation( + s_etat_processus, + s_objet_evalue); + } + + (*s_etat_processus) + .instruction_courante = + instruction_courante; + return(d_erreur); + } + + (*s_etat_processus) + .sections_critiques--; + } + + depilement_pile_systeme( + s_etat_processus); + + if ((*s_etat_processus) + .erreur_systeme != d_es) + { + if (presence_egalite == + d_vrai) + { + liberation( + s_etat_processus, + s_objet_evalue); + } + + (*s_etat_processus) + .instruction_courante = + instruction_courante; + return(d_erreur); + } + } + } + } + } + + l_element_courant = + (*l_element_courant).suivant; + } + + (*s_etat_processus).mode_execution_programme = + registre_mode_execution_programme; + (*s_etat_processus).instruction_courante = + instruction_courante; if (presence_egalite == d_vrai) { liberation(s_etat_processus, s_objet_evalue); @@ -6120,7 +6496,7 @@ evaluation(struct_processus *s_etat_proc if (presence_variable_partagee == d_faux) { (*s_etat_processus).position_courante = - (*((unsigned long *) + (*((integer8 *) ((*(*(*s_etat_processus) .pointeur_variable_courante) .objet).objet))); @@ -6128,7 +6504,7 @@ evaluation(struct_processus *s_etat_proc else { (*s_etat_processus).position_courante = - (*((unsigned long *) + (*((integer8 *) (*s_copie_variable_partagee).objet)); liberation(s_etat_processus, s_copie_variable_partagee); @@ -6165,6 +6541,8 @@ evaluation(struct_processus *s_etat_proc s_objet_evalue); } + depilement_pile_systeme(s_etat_processus); + (*s_etat_processus).instruction_courante = instruction_courante; (*s_etat_processus).mode_execution_programme = @@ -6373,14 +6751,12 @@ evaluation(struct_processus *s_etat_proc (*(*s_etat_processus).l_base_pile_systeme) .niveau_courant = (*s_etat_processus) .niveau_courant; - empilement_pile_systeme(s_etat_processus); if (evaluation(s_etat_processus, s_copie_variable_partagee, type_evaluation) == d_erreur) { depilement_pile_systeme(s_etat_processus); - depilement_pile_systeme(s_etat_processus); liberation(s_etat_processus, s_copie_variable_partagee); @@ -6408,7 +6784,6 @@ evaluation(struct_processus *s_etat_proc } depilement_pile_systeme(s_etat_processus); - depilement_pile_systeme(s_etat_processus); liberation(s_etat_processus, s_copie_variable_partagee);