--- rpl/src/sequenceur.c	2012/10/01 11:05:09	1.58
+++ rpl/src/sequenceur.c	2019/02/03 14:41:30	1.105
@@ -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.31
+  Copyright (C) 1989-2019 Dr. BERTRAND Joël
 
   This file is part of RPL/2.
 
@@ -25,13 +25,13 @@
 
 /*
 ================================================================================
-  Boucle principale de l'interprète RPL/2
+  Boucle principale de l'interprète RPL/2
 ================================================================================
-  Entrées : structure sur l'état du processus
+  Entrées : structure sur l'état du processus
 --------------------------------------------------------------------------------
-  Sorties : Néant
+  Sorties : néant
 --------------------------------------------------------------------------------
-  Effets de bord : néant
+  Effets de bord : néant
 ================================================================================
 */
 
@@ -44,6 +44,9 @@ 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;
@@ -61,12 +64,8 @@ sequenceur(struct_processus *s_etat_proc
 	unsigned char				*message;
 	unsigned char				*registre;
 	unsigned char				*tampon;
-	unsigned char				tampon_retour;
 	unsigned char				*t_ligne;
 
-	unsigned long				niveau;
-	unsigned long				position_courante;
-
 	Keymap						ancien_keymap;
 	Keymap						nouveau_keymap;
 
@@ -80,12 +79,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);
 			}
 		}
@@ -93,7 +92,7 @@ sequenceur(struct_processus *s_etat_proc
 		{
 			if ((*s_etat_processus).langue == 'F')
 			{
-				printf("[%d] Exécution\n", (int) getpid());
+				printf("[%d] Exécution\n", (int) getpid());
 			}
 			else
 			{
@@ -106,7 +105,7 @@ sequenceur(struct_processus *s_etat_proc
 
 /*
 --------------------------------------------------------------------------------
-  Boucle de l'interprète RPL/2
+  Boucle de l'interprète RPL/2
   On boucle tant qu'on n'a pas une bonne raison de sortir...
 --------------------------------------------------------------------------------
 */
@@ -117,7 +116,7 @@ sequenceur(struct_processus *s_etat_proc
 
 /*
 --------------------------------------------------------------------------------
-  Recherche de l'instruction suivante dans les définitions chaînées
+  Recherche de l'instruction suivante dans les définitions chaînées
 --------------------------------------------------------------------------------
 */
 
@@ -198,12 +197,6 @@ sequenceur(struct_processus *s_etat_proc
 				funlockfile(stdin);
 				funlockfile(stdout);
 
-				if ((*s_etat_processus).var_volatile_requete_arret != 0)
-				{
-					(*s_etat_processus).requete_arret = 'Y';
-					break;
-				}
-
 				if (ligne != NULL)
 				{
 					if ((t_ligne = transliteration(s_etat_processus, ligne,
@@ -217,7 +210,7 @@ sequenceur(struct_processus *s_etat_proc
 					free(ligne);
 					ligne = t_ligne;
 
-					if ((ligne = compactage(ligne)) == NULL)
+					if ((ligne = compactage(s_etat_processus, ligne)) == NULL)
 					{
 						(*s_etat_processus).erreur_systeme =
 								d_es_allocation_memoire;
@@ -266,6 +259,13 @@ sequenceur(struct_processus *s_etat_proc
 					sprintf(ligne, "dup");
 				}
 
+				if ((*s_etat_processus).var_volatile_requete_arret != 0)
+				{
+					free(ligne);
+					(*s_etat_processus).requete_arret = 'Y';
+					break;
+				}
+
 				add_history(ligne);
 				stifle_history(ds_longueur_historique);
 
@@ -296,6 +296,7 @@ sequenceur(struct_processus *s_etat_proc
 					tampon = (*s_etat_processus).instruction_courante;
 					(*s_etat_processus).instruction_courante = ligne;
 
+					(*s_etat_processus).type_en_cours = NON;
 					recherche_type(s_etat_processus);
 
 					(*s_etat_processus).instruction_courante = tampon;
@@ -334,8 +335,15 @@ sequenceur(struct_processus *s_etat_proc
 					}
 					else
 					{
-						tampon_retour = (*(*s_etat_processus)
-								.l_base_pile_systeme).retour_definition;
+						position_courante =
+								(*s_etat_processus).position_courante;
+						empilement_pile_systeme(s_etat_processus);
+
+						if ((*s_etat_processus).erreur_systeme != d_es)
+						{
+							return(d_erreur);
+						}
+
 						(*(*s_etat_processus).l_base_pile_systeme)
 								.retour_definition = 'Y';
 
@@ -349,24 +357,25 @@ sequenceur(struct_processus *s_etat_proc
 
 							if ((*s_etat_processus).langue == 'F')
 							{
-								printf("+++Erreur : Défaut d'argument\n");
+								printf("+++Erreur : Défaut d'argument\n");
 							}
 							else
 							{
 								printf("+++Error : Too few arguments\n");
 							}
 
-							(*(*s_etat_processus).l_base_pile_systeme)
-									.retour_definition = tampon_retour;
+							depilement_pile_systeme(s_etat_processus);
+
+							if ((*s_etat_processus).erreur_systeme != d_es)
+							{
+								return(d_erreur);
+							}
 
 							fflush(stdout);
 						}
 						else if (evaluation(s_etat_processus, s_objet, 'I') ==
 								d_erreur)
 						{
-							(*(*s_etat_processus).l_base_pile_systeme)
-									.retour_definition = tampon_retour;
-
 							if ((*s_etat_processus).erreur_systeme != d_es)
 							{
 								if (test_cfsf(s_etat_processus, 51) == d_faux)
@@ -452,8 +461,8 @@ sequenceur(struct_processus *s_etat_proc
 							liberation(s_etat_processus, s_objet);
 						}
 
-						(*(*s_etat_processus).l_base_pile_systeme)
-								.retour_definition = tampon_retour;
+						(*s_etat_processus).position_courante =
+								position_courante;
 					}
 				}
 				else if ((*s_etat_processus).invalidation_message_erreur
@@ -517,8 +526,8 @@ sequenceur(struct_processus *s_etat_proc
 
 /*
 --------------------------------------------------------------------------------
-  Dans le cas où une instruction est retournée, celle-ci est évaluée. Dans le
-  cas contraire, l'interprète renvoie un message d'erreur et s'interrompt.
+  Dans le cas où une instruction est retournée, celle-ci est évaluée. Dans le
+  cas contraire, l'interprète renvoie un message d'erreur et s'interrompt.
 --------------------------------------------------------------------------------
 */
 
@@ -527,11 +536,13 @@ sequenceur(struct_processus *s_etat_proc
 
 /*
 --------------------------------------------------------------------------------
-  Scrutation des mots clef du langage RPL/2 et exécution le cas échéant
-  de l'action associée.
+  Scrutation des mots clef du langage RPL/2 et exécution le cas échéant
+  de l'action associée.
 --------------------------------------------------------------------------------
 */
 
+			(*s_etat_processus).instruction_sensible = 'N';
+
 			analyse(s_etat_processus, NULL);
 
 			if ((*s_etat_processus).traitement_cycle_exit != 'N')
@@ -557,7 +568,7 @@ sequenceur(struct_processus *s_etat_proc
 			
 /*
 --------------------------------------------------------------------------------
-  L'instruction ne correspond pas à l'un des mots clef du langage RPL/2.
+  L'instruction ne correspond pas à l'un des mots clef du langage RPL/2.
 --------------------------------------------------------------------------------
 */
 
@@ -572,62 +583,51 @@ sequenceur(struct_processus *s_etat_proc
 
 /*
 --------------------------------------------------------------------------------
-  L'instruction est une variable partagée
+  L'instruction est une variable partagée
 --------------------------------------------------------------------------------
 */
 
-						if ((*s_etat_processus).debug == d_vrai)
-							if (((*s_etat_processus).type_debug &
-									d_debug_variables) != 0)
+						if (recherche_variable_partagee(s_etat_processus,
+								(*(*s_etat_processus)
+								.pointeur_variable_courante).nom,
+								(*(*s_etat_processus)
+								.pointeur_variable_courante).variable_partagee,
+								'P') != NULL)
 						{
-							if ((*s_etat_processus).langue == 'F')
+							// La variable existe.
+
+							if ((*s_etat_processus).debug == d_vrai)
+								if (((*s_etat_processus).type_debug &
+										d_debug_variables) != 0)
 							{
-								printf("[%d] Empilement de la variable "
-										"partagée %s de type %d\n",
+								if ((*s_etat_processus).langue == 'F')
+								{
+									printf("[%d] Évaluation de la variable "
+										"partagée %s de type %d\n",
 										(int) getpid(), (*s_etat_processus)
 										.instruction_courante,
 										(*(*(*s_etat_processus)
-										.pointeur_variable_courante).objet)
-										.type);
-							}
-							else
-							{
-								printf("[%d] Pushing %s as %d type shared "
-										"variable \n", (int) getpid(),
+										.pointeur_variable_partagee_courante)
+										.objet).type);
+								}
+								else
+								{
+									printf("[%d] Pushing %s as %d type shared "
+										"variable\n", (int) getpid(),
 										(*s_etat_processus)
 										.instruction_courante,
 										(*(*(*s_etat_processus)
-										.pointeur_variable_courante).objet)
-										.type);
-							}
-
-							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);
-						}
+										.pointeur_variable_partagee_courante)
+										.objet).type);
+								}
 
-						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)
-						{
-							// La variable existe.
+								fflush(stdout);
+							}
 
 							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;
@@ -635,45 +635,54 @@ 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)
+							if ((*s_etat_processus).debug == d_vrai)
+								if (((*s_etat_processus).type_debug &
+										d_debug_variables) != 0)
 							{
-								(*s_etat_processus).erreur_systeme =
-										d_es_processus;
-								return(d_erreur);
-							}
+								if ((*s_etat_processus).langue == 'F')
+								{
+									printf("[%d] Tentative d'accès à la "
+										"variable partagée non définie %s\n",
+										(int) getpid(), (*s_etat_processus)
+										.instruction_courante);
+								}
+								else
+								{
+									printf("[%d] Trying to access to undefined "
+										"shared variable %s\n",
+										(int) getpid(),
+										(*s_etat_processus)
+										.instruction_courante);
+								}
 
-							recherche_type(s_etat_processus);
+								fflush(stdout);
+							}
 						}
 					}
 
 /*
 --------------------------------------------------------------------------------
-  L'instruction est une variable automatique (évaluation lors de l'empilement).
+  L'instruction est une variable automatique (évaluation lors de l'empilement).
 --------------------------------------------------------------------------------
 */
 
@@ -684,7 +693,7 @@ sequenceur(struct_processus *s_etat_proc
 /*
 --------------------------------------------------------------------------------
   L'instruction est une variable de type 'adresse' pointant sur une
-  définition. Un branchement est effectué à cette adresse.
+  définition. Un branchement est effectué à cette adresse.
 --------------------------------------------------------------------------------
 */
 
@@ -694,8 +703,8 @@ sequenceur(struct_processus *s_etat_proc
 						{
 							if ((*s_etat_processus).langue == 'F')
 							{
-								printf("[%d] Branchement à la"
-										" définition %s\n", (int) getpid(),
+								printf("[%d] Branchement à la"
+										" définition %s\n", (int) getpid(),
 										(*s_etat_processus)
 										.instruction_courante);
 							}
@@ -733,6 +742,8 @@ sequenceur(struct_processus *s_etat_proc
 								}
 							}
 
+							(*s_etat_processus).debug_programme = d_faux;
+
 							(*(*s_etat_processus).l_base_pile_systeme)
 									.adresse_retour = (*s_etat_processus)
 									.position_courante;
@@ -745,7 +756,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)));
@@ -761,7 +772,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)
@@ -794,14 +805,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
@@ -809,19 +820,22 @@ sequenceur(struct_processus *s_etat_proc
 
 /*
 --------------------------------------------------------------------------------
-  L'instruction est une donnée à empiler.
+  L'instruction est une donnée à empiler.
 --------------------------------------------------------------------------------
 */
 
 					(*s_etat_processus).erreur_systeme = d_es;
+					(*s_etat_processus).type_en_cours = NON;
 					recherche_type(s_etat_processus);
 
 					if ((*s_etat_processus).autorisation_nom_implicite == 'N')
 					{
 						if ((*s_etat_processus).l_base_pile == NULL)
 						{
-							if ((*s_etat_processus).erreur_execution !=
-									d_ex_nom_implicite)
+							if (((*s_etat_processus).erreur_execution !=
+									d_ex_nom_implicite) &&
+									((*s_etat_processus).erreur_execution !=
+									d_ex_syntaxe))
 							{
 								(*s_etat_processus).erreur_execution =
 										d_ex_manque_argument;
@@ -837,10 +851,10 @@ sequenceur(struct_processus *s_etat_proc
 								(*s_etat_processus).erreur_execution =
 										d_ex_nom_implicite;
 
-								// Si le niveau de récursivité est non nul, on
+								// Si le niveau de récursivité est non nul, on
 								// arrive ici depuis la fonction
-								// recherche_type(). On retourne à cette
-								// dernière en indiquant une erreur.
+								// recherche_type(). On retourne à cette
+								// dernière en indiquant une erreur.
 
 								if ((*s_etat_processus).niveau_recursivite != 0)
 								{
@@ -852,7 +866,7 @@ sequenceur(struct_processus *s_etat_proc
 						}
 					}
 
-					// Le séquenceur est appelé depuis la routine d'évaluation
+					// Le séquenceur est appelé depuis la routine d'évaluation
 
 					if ((*s_etat_processus).evaluation_forcee == 'Y')
 					{
@@ -877,7 +891,7 @@ sequenceur(struct_processus *s_etat_proc
 						liberation(s_etat_processus, s_objet_evaluation);
 					}
 
-					// Le séquenceur est appelé depuis la routine de
+					// Le séquenceur est appelé depuis la routine de
 					// recherche de type
 
 					else if ((*s_etat_processus).recherche_type == 'Y')
@@ -901,7 +915,8 @@ sequenceur(struct_processus *s_etat_proc
 */
 
 				if ((instruction_majuscule = conversion_majuscule(
-						(*s_etat_processus).instruction_courante)) == NULL)
+						s_etat_processus, (*s_etat_processus)
+						.instruction_courante)) == NULL)
 				{
 					(*s_etat_processus).erreur_systeme =
 							d_es_allocation_memoire;
@@ -922,12 +937,13 @@ sequenceur(struct_processus *s_etat_proc
 					(*((struct_fonction *) (*s_objet).objet))
 							.nombre_arguments = 0;
 
-					if ((*s_etat_processus).instruction_intrinseque == 'Y')
+					if (((*s_etat_processus).instruction_intrinseque == 'Y') &&
+							((*s_etat_processus).instruction_sensible == 'N'))
 					{
 						if (((*((struct_fonction *) (*s_objet).objet))
 								.nom_fonction = conversion_majuscule(
-								(*s_etat_processus).instruction_courante))
-								== NULL)
+								s_etat_processus, (*s_etat_processus)
+								.instruction_courante)) == NULL)
 						{
 							(*s_etat_processus).erreur_systeme =
 									d_es_allocation_memoire;
@@ -975,8 +991,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
 		{
@@ -1001,7 +1017,7 @@ sequenceur(struct_processus *s_etat_proc
 
 /*
 --------------------------------------------------------------------------------
-  Traitement des arrêts simples
+  Traitement des arrêts simples
 --------------------------------------------------------------------------------
 */
 
@@ -1017,7 +1033,7 @@ sequenceur(struct_processus *s_etat_proc
 				{
 					if (strncmp(getenv("LANG"), "fr", 2) == 0)
 					{
-						printf("[%d] Arrêt\n", (int) getpid());
+						printf("[%d] Arrêt\n", (int) getpid());
 					}
 					else
 					{
@@ -1039,7 +1055,7 @@ sequenceur(struct_processus *s_etat_proc
 
 		/*
 		 * On ne sort pas du debugger en cas d'une erreur sur un programme
-		 * en cours de débogage.
+		 * en cours de débogage.
 		 */
 
 		if ((((*s_etat_processus).erreur_execution != d_ex) ||
@@ -1089,13 +1105,13 @@ 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);
 		}
 
 /*
 --------------------------------------------------------------------------------
-  Test de fin d'exécution du programme RPL/2
+  Test de fin d'exécution du programme RPL/2
 --------------------------------------------------------------------------------
 */
 
@@ -1174,7 +1190,7 @@ sequenceur(struct_processus *s_etat_proc
 						if ((*(*s_etat_processus).pointeur_variable_courante)
 								.objet == NULL)
 						{
-							// Variable partagée
+							// Variable partagée
 						}
 						else if ((*(*(*s_etat_processus)
 								.pointeur_variable_courante).objet).type == ADR)
@@ -1199,7 +1215,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)));
@@ -1212,7 +1228,8 @@ sequenceur(struct_processus *s_etat_proc
 					{
 						(*s_etat_processus).erreur_systeme = d_es;
 						instruction_majuscule = conversion_majuscule(
-								(*s_etat_processus).instruction_courante);
+								s_etat_processus, (*s_etat_processus)
+								.instruction_courante);
 
 						if (instruction_majuscule == NULL)
 						{
@@ -1221,8 +1238,8 @@ sequenceur(struct_processus *s_etat_proc
 						}
 
 						/*
-						 * Traitement de la pile système par les
-						 * différentes instructions.
+						 * Traitement de la pile système par les
+						 * différentes instructions.
 						 */
 
 						if ((strcmp(instruction_majuscule, "IF") == 0) ||
@@ -1296,7 +1313,7 @@ sequenceur(struct_processus *s_etat_proc
 									.l_base_pile_systeme).type_cloture != 'L'))
 							{
 								/*
-								 * Libération des compteurs de boucle.
+								 * Libération des compteurs de boucle.
 								 */
 
 								presence_compteur = (((*(*s_etat_processus)
@@ -1331,7 +1348,7 @@ sequenceur(struct_processus *s_etat_proc
 
 									(*s_etat_processus).niveau_courant--;
 
-									if (retrait_variable_par_niveau(
+									if (retrait_variables_par_niveau(
 											s_etat_processus) == d_erreur)
 									{
 										return(d_erreur);
@@ -1347,7 +1364,7 @@ sequenceur(struct_processus *s_etat_proc
 							}
 							else
 							{
-								// Traitement spécifique pour la fin
+								// Traitement spécifique pour la fin
 								// d'une section critique
 
 								if ((*s_etat_processus).l_base_pile_systeme
@@ -1400,6 +1417,7 @@ sequenceur(struct_processus *s_etat_proc
 					}
 					
 					instruction_majuscule = conversion_majuscule(
+							s_etat_processus,
 							(*s_etat_processus).instruction_courante);
 
 					if (instruction_majuscule == NULL)
@@ -1462,7 +1480,7 @@ sequenceur(struct_processus *s_etat_proc
 
 /*
 --------------------------------------------------------------------------------
-  Messages d'erreur à afficher le cas échéant
+  Messages d'erreur à afficher le cas échéant
 --------------------------------------------------------------------------------
 */
 
@@ -1511,7 +1529,7 @@ sequenceur(struct_processus *s_etat_proc
 		if ((*s_etat_processus).var_volatile_processus_pere == 0)
 		{
 			envoi_signal_processus((*s_etat_processus).pid_processus_pere,
-					rpl_sigalrm);
+					rpl_sigalrm, d_faux);
 		}
 		else
 		{