--- rpl/src/sequenceur.c	2011/07/22 07:38:42	1.40
+++ rpl/src/sequenceur.c	2013/03/27 21:26:11	1.71
@@ -1,7 +1,7 @@
 /*
 ================================================================================
-  RPL/2 (R) version 4.1.1
-  Copyright (C) 1989-2011 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.
 
@@ -29,7 +29,7 @@
 ================================================================================
   Entrées : structure sur l'état du processus
 --------------------------------------------------------------------------------
-  Sorties : Néant
+  Sorties : néant
 --------------------------------------------------------------------------------
   Effets de bord : néant
 ================================================================================
@@ -44,10 +44,14 @@ sequenceur(struct_processus *s_etat_proc
 	struct_objet				*s_objet_evaluation;
 	struct_objet				*s_sous_objet;
 
+	integer8					niveau;
+	integer8					position_courante;
+
 	logical1					drapeau_appel_definition;
 	logical1					drapeau_fin;
 	logical1					drapeau_then;
 	logical1					erreur;
+	logical1					presence_compteur;
 
 	static logical1				completion_valide = d_faux;
 
@@ -63,10 +67,8 @@ sequenceur(struct_processus *s_etat_proc
 	unsigned char				tampon_retour;
 	unsigned char				*t_ligne;
 
-	unsigned long				i;
-	unsigned long				j;
-	unsigned long				niveau;
-	unsigned long				position_courante;
+	Keymap						ancien_keymap;
+	Keymap						nouveau_keymap;
 
 	(*s_etat_processus).retour_routine_evaluation = 'N';
 
@@ -78,12 +80,12 @@ sequenceur(struct_processus *s_etat_proc
 		{
 			if ((*s_etat_processus).langue == 'F')
 			{
-				printf("[%d] Exécution récursive de niveau %lu\n",
+				printf("[%d] Exécution récursive de niveau %lld\n",
 						(int) getpid(), (*s_etat_processus).niveau_recursivite);
 			}
 			else
 			{
-				printf("[%d] %lu level recursive execution\n",
+				printf("[%d] %lld level recursive execution\n",
 						(int) getpid(), (*s_etat_processus).niveau_recursivite);
 			}
 		}
@@ -109,9 +111,6 @@ sequenceur(struct_processus *s_etat_proc
 --------------------------------------------------------------------------------
 */
 
-	i = 0;
-	j = 0;
-
 	do
 	{
 		drapeau_appel_definition = d_faux;
@@ -182,8 +181,20 @@ sequenceur(struct_processus *s_etat_proc
 				flockfile(stdin);
 				flockfile(stdout);
 
+				ancien_keymap = rl_get_keymap();
+				nouveau_keymap = rl_copy_keymap(ancien_keymap);
+				rl_set_keymap(nouveau_keymap);
+
+				rl_bind_key(NEWLINE, readline_analyse_syntaxique);
+				rl_bind_key(RETURN, readline_analyse_syntaxique);
+				rl_bind_key(CTRL('g'), readline_effacement);
+				rl_done = 0;
+
 				ligne = readline("RPL/2> ");
 
+				rl_set_keymap(ancien_keymap);
+				rl_free(nouveau_keymap);
+
 				funlockfile(stdin);
 				funlockfile(stdout);
 
@@ -571,7 +582,7 @@ sequenceur(struct_processus *s_etat_proc
 						{
 							if ((*s_etat_processus).langue == 'F')
 							{
-								printf("[%d] Empilement de la variable "
+								printf("[%d] Évaluation de la variable "
 										"partagée %s de type %d\n",
 										(int) getpid(), (*s_etat_processus)
 										.instruction_courante,
@@ -582,7 +593,7 @@ sequenceur(struct_processus *s_etat_proc
 							else
 							{
 								printf("[%d] Pushing %s as %d type shared "
-										"variable \n", (int) getpid(),
+										"variable\n", (int) getpid(),
 										(*s_etat_processus)
 										.instruction_courante,
 										(*(*(*s_etat_processus)
@@ -593,30 +604,19 @@ sequenceur(struct_processus *s_etat_proc
 							fflush(stdout);
 						}
 
-						if (pthread_mutex_lock(&((*(*s_etat_processus)
-								.s_liste_variables_partagees).mutex)) != 0)
-						{
-							(*s_etat_processus).erreur_systeme =
-									d_es_processus;
-							return(d_erreur);
-						}
-
 						if (recherche_variable_partagee(s_etat_processus,
 								(*(*s_etat_processus)
 								.pointeur_variable_courante).nom,
 								(*(*s_etat_processus)
 								.pointeur_variable_courante).variable_partagee,
-								'P') == d_vrai)
+								'P') != NULL)
 						{
 							// La variable existe.
 
 							if ((s_objet = copie_objet(s_etat_processus,
 									(*(*s_etat_processus)
-									.s_liste_variables_partagees)
-									.table[(*(*s_etat_processus)
-									.s_liste_variables_partagees)
-									.position_variable].objet, 'P'))
-									== NULL)
+									.pointeur_variable_partagee_courante)
+									.objet, 'P')) == NULL)
 							{
 								(*s_etat_processus).erreur_systeme =
 										d_es_allocation_memoire;
@@ -624,39 +624,26 @@ sequenceur(struct_processus *s_etat_proc
 							}
 
 							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(d_erreur);
 							}
 
-							if (empilement(s_etat_processus,
-									&((*s_etat_processus).l_base_pile),
-									s_objet) == d_erreur)
+							if (evaluation(s_etat_processus, s_objet, 'E')
+									== d_erreur)
 							{
-								(*s_etat_processus).erreur_systeme =
-										d_es_allocation_memoire;
+								liberation(s_etat_processus, s_objet);
 								return(d_erreur);
 							}
+
+							liberation(s_etat_processus, s_objet);
 						}
 						else
 						{
 							// La variable n'existe plus.
-
-							(*s_etat_processus).erreur_systeme = d_es;
-
-							if (pthread_mutex_unlock(&((*(*s_etat_processus)
-									.s_liste_variables_partagees).mutex))
-									!= 0)
-							{
-								(*s_etat_processus).erreur_systeme =
-										d_es_processus;
-								return(d_erreur);
-							}
-
-							recherche_type(s_etat_processus);
 						}
 					}
 
@@ -734,7 +721,7 @@ sequenceur(struct_processus *s_etat_proc
 									.niveau_courant;
 
 							(*s_etat_processus).position_courante =
-									(*((unsigned long *)
+									(*((integer8 *)
 									((*(*(*s_etat_processus)
 									.pointeur_variable_courante)
 									.objet).objet)));
@@ -750,7 +737,7 @@ sequenceur(struct_processus *s_etat_proc
 						{
 							if ((*s_etat_processus).langue == 'F')
 							{
-								printf("[%d] Empilement de la variable "
+								printf("[%d] Évaluation de la variable "
 										"%s de type %d\n",
 										(int) getpid(),
 										(*s_etat_processus)
@@ -783,14 +770,14 @@ sequenceur(struct_processus *s_etat_proc
 							return(d_erreur);
 						}
 
-						if (empilement(s_etat_processus,
-								&((*s_etat_processus).l_base_pile),
-								s_objet) == d_erreur)
+						if (evaluation(s_etat_processus, s_objet, 'E')
+								== d_erreur)
 						{
-							(*s_etat_processus).erreur_systeme =
-									d_es_allocation_memoire;
+							liberation(s_etat_processus, s_objet);
 							return(d_erreur);
 						}
+
+						liberation(s_etat_processus, s_objet);
 					}
 				}
 				else
@@ -964,8 +951,8 @@ sequenceur(struct_processus *s_etat_proc
 				free(instruction_majuscule);
 			}
 
-			erreur |= (((*s_etat_processus).erreur_execution != d_ex)
-					? d_erreur : d_absence_erreur);
+			erreur = (logical1) (erreur | (((*s_etat_processus)
+					.erreur_execution != d_ex) ? d_erreur : d_absence_erreur));
 		}
 		else
 		{
@@ -1078,7 +1065,7 @@ sequenceur(struct_processus *s_etat_proc
 			(*s_etat_processus).exception = d_ep;
 			erreur = d_absence_erreur;
 
-			(*s_etat_processus).position_courante -=
+			(*s_etat_processus).position_courante -= (integer8)
 					strlen((*s_etat_processus).instruction_courante);
 		}
 
@@ -1188,7 +1175,7 @@ sequenceur(struct_processus *s_etat_proc
 									.niveau_courant;
 
 							(*s_etat_processus).position_courante =
-									(*((unsigned long *)
+									(*((integer8 *)
 									((*(*(*s_etat_processus)
 									.pointeur_variable_courante)
 									.objet).objet)));
@@ -1219,8 +1206,12 @@ sequenceur(struct_processus *s_etat_proc
 								(strcmp(instruction_majuscule, "DO") == 0) ||
 								(strcmp(instruction_majuscule, "WHILE") == 0) ||
 								(strcmp(instruction_majuscule, "FOR") == 0) ||
+								(strcmp(instruction_majuscule, "FORALL") == 0)
+								||
 								(strcmp(instruction_majuscule, "START") == 0) ||
 								(strcmp(instruction_majuscule, "SELECT") == 0)
+								||
+								(strcmp(instruction_majuscule, "CRITICAL") == 0)
 								|| (strcmp(instruction_majuscule, "CASE") == 0)
 							   	|| (strcmp(instruction_majuscule, "<<") == 0))
 						{
@@ -1228,6 +1219,21 @@ sequenceur(struct_processus *s_etat_proc
 							{
 								analyse(s_etat_processus, NULL);
 							}
+							else if ((strcmp(instruction_majuscule, "FOR") == 0)
+									|| (strcmp(instruction_majuscule, "FORALL")
+									== 0) || (strcmp(instruction_majuscule,
+									"START") == 0))
+							{
+								empilement_pile_systeme(s_etat_processus);
+
+								if ((*s_etat_processus).erreur_systeme != d_es)
+								{
+									return(d_erreur);
+								}
+
+								(*(*s_etat_processus).l_base_pile_systeme)
+										.type_cloture = 'L';
+							}
 							else
 							{
 								empilement_pile_systeme(s_etat_processus);
@@ -1260,8 +1266,88 @@ sequenceur(struct_processus *s_etat_proc
 									return(d_absence_erreur);
 								}
 							}
+							else if (((strcmp(instruction_majuscule, "NEXT")
+									== 0) || (strcmp(instruction_majuscule,
+									"STEP") == 0)) && ((*(*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))
+								{
+									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)
+									{
+										return(d_erreur);
+									}
+
+									if ((*(*s_etat_processus)
+											.pointeur_variable_courante).objet
+											== NULL)
+									{
+										return(d_erreur);
+									}
+
+									(*s_etat_processus).niveau_courant--;
+
+									if (retrait_variables_par_niveau(
+											s_etat_processus) == d_erreur)
+									{
+										return(d_erreur);
+									}
+								}
+
+								depilement_pile_systeme(s_etat_processus);
+
+								if ((*s_etat_processus).erreur_systeme != d_es)
+								{
+									return(d_erreur);
+								}
+							}
 							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_processus;
+									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;
+										return(d_erreur);
+									}
+
+									(*s_etat_processus).sections_critiques--;
+								}
+
 								depilement_pile_systeme(s_etat_processus);
 
 								if ((*s_etat_processus).erreur_systeme != d_es)
@@ -1302,8 +1388,10 @@ sequenceur(struct_processus *s_etat_proc
 							(strcmp(instruction_majuscule, "DO") == 0) ||
 							(strcmp(instruction_majuscule, "WHILE") == 0) ||
 							(strcmp(instruction_majuscule, "FOR") == 0) ||
+							(strcmp(instruction_majuscule, "FORALL") == 0) ||
 							(strcmp(instruction_majuscule, "START") == 0) ||
 							(strcmp(instruction_majuscule, "SELECT") == 0)
+							|| (strcmp(instruction_majuscule, "CRITICAL") == 0)
 							|| (strcmp(instruction_majuscule, "CASE") == 0)
 							|| (strcmp(instruction_majuscule, "<<") == 0))
 					{
@@ -1398,7 +1486,8 @@ sequenceur(struct_processus *s_etat_proc
 
 		if ((*s_etat_processus).var_volatile_processus_pere == 0)
 		{
-			kill((*s_etat_processus).pid_processus_pere, SIGALRM);
+			envoi_signal_processus((*s_etat_processus).pid_processus_pere,
+					rpl_sigalrm);
 		}
 		else
 		{