--- rpl/src/evaluation.c	2012/12/17 21:22:43	1.65
+++ rpl/src/evaluation.c	2015/03/25 09:46:46	1.90
@@ -1,7 +1,7 @@
 /*
 ================================================================================
-  RPL/2 (R) version 4.1.11
-  Copyright (C) 1989-2012 Dr. BERTRAND Joël
+  RPL/2 (R) version 4.1.21
+  Copyright (C) 1989-2015 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;
@@ -84,22 +91,13 @@ evaluation(struct_processus *s_etat_proc
 	unsigned char					registre_evaluation_forcee;
 	unsigned char					registre_instruction_valide;
 	unsigned char					registre_mode_execution_programme;
-	unsigned char					registre_retour_definition;
 	unsigned char					registre_test;
 	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 +290,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 +323,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,8 +410,6 @@ evaluation(struct_processus *s_etat_proc
 						.niveau_courant = (*s_etat_processus)
 						.niveau_courant;
 
-				empilement_pile_systeme(s_etat_processus);
-
 				if (presence_variable_partagee == d_faux)
 				{
 					if (evaluation(s_etat_processus, (*(*s_etat_processus)
@@ -423,6 +421,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 +445,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 +466,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)
 				{
@@ -712,12 +713,6 @@ evaluation(struct_processus *s_etat_proc
 		 * Exécution de la séquence d'instructions
 		 */
 
-		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)
 				.autorisation_empilement_programme;
@@ -763,18 +758,8 @@ evaluation(struct_processus *s_etat_proc
 								(*s_etat_processus)
 								.evaluation_expression_compilee;
 
-						if (((*(*s_etat_processus).pointeur_variable_courante)
-								.origine == 'E') && ((*(*s_etat_processus)
-								.pointeur_variable_courante).niveau == 0))
-						{
-							(*s_etat_processus).evaluation_expression_compilee
-									= 'Y';
-						}
-						else
-						{
-							(*s_etat_processus).evaluation_expression_compilee
-									= 'N';
-						}
+						(*s_etat_processus).evaluation_expression_compilee
+								= 'Y';
 
 						analyse(s_etat_processus, (*((struct_fonction *)
 								(*(*l_element_courant).donnee).objet))
@@ -3384,6 +3369,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);
@@ -3403,8 +3390,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)
@@ -3468,6 +3454,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 =
@@ -6241,7 +6229,6 @@ evaluation(struct_processus *s_etat_proc
 									registre_mode_execution_programme;
 							(*s_etat_processus).instruction_courante =
 									instruction_courante;
-
 							if (presence_egalite == d_vrai)
 							{
 								liberation(s_etat_processus, s_objet_evalue);
@@ -6491,7 +6478,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)));
@@ -6499,7 +6486,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);
@@ -6536,6 +6523,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 =
@@ -6544,7 +6533,7 @@ evaluation(struct_processus *s_etat_proc
 							}
 
 							(*s_etat_processus).evaluation_forcee =
-								registre_evaluation_forcee;
+									registre_evaluation_forcee;
 							(*s_etat_processus).instruction_courante =
 									instruction_courante;
 							(*s_etat_processus).mode_execution_programme = 'N';
@@ -6679,18 +6668,18 @@ evaluation(struct_processus *s_etat_proc
 									}
 								}
 
-								registre_niveau_courant = (*(*s_etat_processus)
-										.l_base_pile_systeme).niveau_courant;
-								registre_retour_definition =
-										(*(*s_etat_processus)
-										.l_base_pile_systeme).retour_definition;
+								empilement_pile_systeme(s_etat_processus);
 
 								(*(*s_etat_processus).l_base_pile_systeme)
 										.retour_definition = 'Y';
 								(*(*s_etat_processus).l_base_pile_systeme)
 										.niveau_courant = (*s_etat_processus)
 										.niveau_courant;
-								empilement_pile_systeme(s_etat_processus);
+								(*(*s_etat_processus).l_base_pile_systeme)
+										.pointeur_objet_retour =
+										l_element_courant;
+								(*(*s_etat_processus).l_base_pile_systeme)
+										.origine_routine_evaluation = 'Y';
 
 								if (evaluation(s_etat_processus,
 										(*(*s_etat_processus)
@@ -6699,13 +6688,6 @@ evaluation(struct_processus *s_etat_proc
 								{
 									depilement_pile_systeme(s_etat_processus);
 
-									(*(*s_etat_processus).l_base_pile_systeme)
-											.niveau_courant =
-											registre_niveau_courant;
-									(*(*s_etat_processus).l_base_pile_systeme)
-											.retour_definition =
-											registre_retour_definition;
-
 									if ((*s_etat_processus).profilage == d_vrai)
 									{
 										profilage(s_etat_processus, NULL);
@@ -6730,12 +6712,358 @@ evaluation(struct_processus *s_etat_proc
 
 								depilement_pile_systeme(s_etat_processus);
 
+								if ((((*s_etat_processus).erreur_execution !=
+										d_ex) || ((*s_etat_processus)
+										.erreur_systeme != d_es)) &&
+										((*s_etat_processus).arret_si_exception
+										== d_faux))
+								{
+									// Reprise sur erreur.
+
+//==============================================================================
+//  Réindentation
+//==============================================================================
+
+			drapeau_then = d_faux;
+
+			while(drapeau_then == d_faux)
+			{
+				l_registre_atome = l_element_courant;
+				l_element_courant = (*l_element_courant).suivant;
+
+				if (l_element_courant == NULL)
+				{
+					/*
+					 * La fin de l'expression est atteinte,
+					 * le sequenceur reprend la main.
+					 */
+
+					if (presence_egalite == d_vrai)
+					{
+						liberation(s_etat_processus, s_objet_evalue);
+					}
+
+					(*s_etat_processus).mode_execution_programme =
+							registre_mode_execution_programme;
+					return(d_absence_erreur);
+				}
+
+				if ((*(*l_element_courant).donnee).type == FCT)
+				{
+					(*s_etat_processus).instruction_courante =
+							(*((struct_fonction *)
+							(*(*l_element_courant).donnee)
+							.objet)).nom_fonction;
+
+					if (recherche_variable(s_etat_processus,
+							(*s_etat_processus).instruction_courante) == d_faux)
+					{
+						(*s_etat_processus).erreur_systeme = d_es;
+						fonction = (*((struct_fonction *)
+								(*(*l_element_courant).donnee)
+								.objet)).fonction;
+
+						/*
+						 * 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))
+							{
+								registre_exception = (*s_etat_processus)
+									.exception;
+								registre_erreur_execution = (*s_etat_processus)
+									.erreur_execution;
+
+								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);
+								}
+
+								(*s_etat_processus).exception
+										= registre_exception;
+								(*s_etat_processus).erreur_execution =
+									registre_erreur_execution;
+							}
+							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)
-										.niveau_courant =
-										registre_niveau_courant;
+										.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))
+							{
+								registre_exception = (*s_etat_processus)
+										.exception;
+								registre_erreur_execution = (*s_etat_processus)
+										.erreur_execution;
+
+								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);
+								}
+
+								(*s_etat_processus).exception
+										= registre_exception;
+								(*s_etat_processus).erreur_execution =
+										registre_erreur_execution;
+							}
+							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;
+
+										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);
+								}
+							}
+						}
+						else if (TEST(instruction_then))
+						{
+							if ((*(*s_etat_processus).l_base_pile_systeme)
+									.clause == 'R')
+							{
 								(*(*s_etat_processus).l_base_pile_systeme)
-										.retour_definition =
-									   	registre_retour_definition;
+										.clause = 'X';
+								instruction_then(s_etat_processus);
+								drapeau_then = d_vrai;
+							}
+						}
+					}
+				}
+			}
+
+			(*s_etat_processus).expression_courante =
+					l_element_courant;
+			(*s_etat_processus).instruction_courante =
+					instruction_courante;
+
+			(*s_etat_processus).exception = d_ep;
+			(*s_etat_processus).erreur_execution = d_ex;
+
+//==============================================================================
+//  Fin de la réindentation
+//==============================================================================
+								}
 							}
 							else
 							{
@@ -6758,14 +7086,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);
@@ -6793,7 +7119,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);
@@ -7179,9 +7504,6 @@ evaluation(struct_processus *s_etat_proc
 				(*s_etat_processus).autorisation_empilement_programme =
 						autorisation_empilement_programme;
 				(*s_etat_processus).instruction_courante = instruction_courante;
-				(*(*s_etat_processus).l_base_pile_systeme).retour_definition =
-						registre_retour_definition;
-
 				return(d_erreur);
 			}
 
@@ -7194,9 +7516,6 @@ evaluation(struct_processus *s_etat_proc
 				(*s_etat_processus).autorisation_empilement_programme =
 						autorisation_empilement_programme;
 				(*s_etat_processus).instruction_courante = instruction_courante;
-				(*(*s_etat_processus).l_base_pile_systeme).retour_definition =
-						registre_retour_definition;
-
 				return(d_erreur);
 			}
 		}
@@ -7204,8 +7523,6 @@ evaluation(struct_processus *s_etat_proc
 		(*s_etat_processus).autorisation_empilement_programme =
 				autorisation_empilement_programme;
 		(*s_etat_processus).instruction_courante = instruction_courante;
-		(*(*s_etat_processus).l_base_pile_systeme).retour_definition =
-				registre_retour_definition;
 	}
 	else if ((*s_objet).type == FCT)
 	{