/*
================================================================================
  RPL/2 (R) version 4.1.6
  Copyright (C) 1989-2012 Dr. BERTRAND Joël

  This file is part of RPL/2.

  RPL/2 is free software; you can redistribute it and/or modify it
  under the terms of the CeCILL V2 License as published by the french
  CEA, CNRS and INRIA.
 
  RPL/2 is distributed in the hope that it will be useful, but WITHOUT
  ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  FITNESS FOR A PARTICULAR PURPOSE.  See the CeCILL V2 License
  for more details.
 
  You should have received a copy of the CeCILL License
  along with RPL/2. If not, write to info@cecill.info.
================================================================================
*/


#include "rpl-conv.h"


/*
================================================================================
  Boucle principale de l'interprète RPL/2
================================================================================
  Entrées : structure sur l'état du processus
--------------------------------------------------------------------------------
  Sorties : Néant
--------------------------------------------------------------------------------
  Effets de bord : néant
================================================================================
*/

logical1
sequenceur(struct_processus *s_etat_processus)
{
	struct_liste_chainee		*l_element_courant;

	struct_objet				*s_objet;
	struct_objet				*s_objet_evaluation;
	struct_objet				*s_sous_objet;

	logical1					drapeau_appel_definition;
	logical1					drapeau_fin;
	logical1					drapeau_then;
	logical1					erreur;

	static logical1				completion_valide = d_faux;

	struct sigaction			action;
	struct sigaction			action_defaut;
	struct sigaction			action_defaut2;

	unsigned char				*instruction_majuscule;
	unsigned char				*ligne;
	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;

	(*s_etat_processus).retour_routine_evaluation = 'N';

	if ((*s_etat_processus).debug == d_vrai)
		if (((*s_etat_processus).type_debug &
				d_debug_appels_fonctions) != 0)
	{
		if ((*s_etat_processus).niveau_recursivite != 0)
		{
			if ((*s_etat_processus).langue == 'F')
			{
				printf("[%d] Exécution récursive de niveau %lu\n",
						(int) getpid(), (*s_etat_processus).niveau_recursivite);
			}
			else
			{
				printf("[%d] %lu level recursive execution\n",
						(int) getpid(), (*s_etat_processus).niveau_recursivite);
			}
		}
		else
		{
			if ((*s_etat_processus).langue == 'F')
			{
				printf("[%d] Exécution\n", (int) getpid());
			}
			else
			{
				printf("[%d] Execution\n", (int) getpid());
			}
		}

		fflush(stdout);
	}

/*
--------------------------------------------------------------------------------
  Boucle de l'interprète RPL/2
  On boucle tant qu'on n'a pas une bonne raison de sortir...
--------------------------------------------------------------------------------
*/

	do
	{
		drapeau_appel_definition = d_faux;

/*
--------------------------------------------------------------------------------
  Recherche de l'instruction suivante dans les définitions chaînées
--------------------------------------------------------------------------------
*/

		if ((erreur = recherche_instruction_suivante(s_etat_processus))
				== d_erreur)
		{
			return(d_erreur);
		}

		if (((*s_etat_processus).debug_programme == d_vrai) &&
				((*s_etat_processus).niveau_recursivite == 0))
		{
			/*
			 * Traitement de la commande HALT (debug)
			 */

			action.sa_handler = SIG_IGN;
			action.sa_flags = SA_NODEFER | SA_ONSTACK;

			(*s_etat_processus).execution_pas_suivant = d_faux;
			(*s_etat_processus).traitement_instruction_halt = d_vrai;

			if (completion_valide == d_faux)
			{
				initialisation_completion();
				completion_valide = d_vrai;
			}

			while((*s_etat_processus).execution_pas_suivant == d_faux)
			{
				if ((*s_etat_processus).hauteur_pile_operationnelle != 0)
				{
					fprintf(stdout, "\n");
				}

				affichage_pile(s_etat_processus, (*s_etat_processus)
						.l_base_pile, 1);

				if ((*s_etat_processus).mode_interactif == 'N')
				{
					printf("[%d] Instruction : %s\n", (int) getpid(),
							(*s_etat_processus).instruction_courante);
					fflush(stdout);
				}

				if (sigaction(SIGINT, &action, &action_defaut) != 0)
				{
					(*s_etat_processus).erreur_systeme = d_es_signal;
					return(d_erreur);
				}

				if (sigaction(SIGTSTP, &action, &action_defaut2) != 0)
				{
					(*s_etat_processus).erreur_systeme = d_es_signal;
					return(d_erreur);
				}

				(*s_etat_processus).var_volatile_requete_arret = 0;
				(*s_etat_processus).var_volatile_requete_arret2 = 0;

				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);

				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,
							(*s_etat_processus).localisation, d_locale))
							== NULL)
					{
						free((*s_etat_processus).instruction_courante);
						return(d_erreur);
					}

					free(ligne);
					ligne = t_ligne;

					if ((ligne = compactage(ligne)) == NULL)
					{
						(*s_etat_processus).erreur_systeme =
								d_es_allocation_memoire;
						return(d_erreur);
					}
				}

				if (sigaction(SIGINT, &action_defaut, NULL) != 0)
				{
					(*s_etat_processus).erreur_systeme = d_es_signal;
					return(d_erreur);
				}

				if (sigaction(SIGTSTP, &action_defaut2, NULL) != 0)
				{
					(*s_etat_processus).erreur_systeme = d_es_signal;
					return(d_erreur);
				}

				if (ligne == NULL)
				{
					if ((ligne = (unsigned char *) malloc(6 *
							sizeof(unsigned char))) == NULL)
					{
						(*s_etat_processus).erreur_systeme =
								d_es_allocation_memoire;
						return(d_erreur);
					}

					sprintf(ligne, "abort");
					fprintf(stdout, "%s\n", ligne);
				}
				else if (((*ligne) == d_code_fin_chaine) &&
						((*s_etat_processus).l_base_pile != NULL))
				{
					free(ligne);

					if ((ligne = (unsigned char *) malloc(4 *
							sizeof(unsigned char))) == NULL)
					{
						(*s_etat_processus).erreur_systeme =
								d_es_allocation_memoire;
						return(d_erreur);
					}

					sprintf(ligne, "dup");
				}

				add_history(ligne);
				stifle_history(ds_longueur_historique);

				position_courante = (*s_etat_processus).position_courante;
				tampon = (*s_etat_processus).definitions_chainees;
				registre = (*s_etat_processus).instruction_courante;
				(*s_etat_processus).definitions_chainees = ligne;

				if (analyse_syntaxique(s_etat_processus) == d_absence_erreur)
				{
					(*s_etat_processus).instruction_courante = registre;
					(*s_etat_processus).position_courante = position_courante;
					(*s_etat_processus).definitions_chainees = tampon;

					if ((tampon = (unsigned char *) malloc((strlen(ligne) + 7) *
							sizeof(unsigned char))) == NULL)
					{
						(*s_etat_processus).erreur_systeme =
								d_es_allocation_memoire;
						return(d_erreur);
					}

					sprintf(tampon, "<< %s >>", ligne);

					free(ligne);
					ligne = tampon;

					tampon = (*s_etat_processus).instruction_courante;
					(*s_etat_processus).instruction_courante = ligne;

					recherche_type(s_etat_processus);

					(*s_etat_processus).instruction_courante = tampon;

					if ((((*s_etat_processus).erreur_execution != d_ex) ||
							((*s_etat_processus).erreur_systeme != d_es)) &&
							((*s_etat_processus).invalidation_message_erreur
							== d_faux))
					{
						if ((*s_etat_processus).erreur_execution != d_ex)
						{
							(*s_etat_processus).erreur_scrutation = d_vrai;
						}

						if (test_cfsf(s_etat_processus, 51) == d_faux)
						{
							printf("%s", ds_beep);
						}

						if ((message = messages(s_etat_processus)) == NULL)
						{
							free((*s_etat_processus).instruction_courante);
							return(d_erreur);
						}

						printf("%s [%d]\n", message, (int) getpid());

						free(message);

						(*s_etat_processus).erreur_execution = d_ex;

						if ((*s_etat_processus).erreur_systeme != d_es)
						{
							return(d_erreur);
						}
					}
					else
					{
						tampon_retour = (*(*s_etat_processus)
								.l_base_pile_systeme).retour_definition;
						(*(*s_etat_processus).l_base_pile_systeme)
								.retour_definition = 'Y';

					 	if (depilement(s_etat_processus, &((*s_etat_processus)
							.l_base_pile), &s_objet) == d_erreur)
						{
							if (test_cfsf(s_etat_processus, 51) == d_faux)
							{
								printf("%s", ds_beep);
							}

							if ((*s_etat_processus).langue == 'F')
							{
								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;

							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)
								{
									printf("%s", ds_beep);
								}

								if ((message = messages(s_etat_processus))
										== NULL)
								{
									free((*s_etat_processus)
											.instruction_courante);
									return(d_erreur);
								}

								printf("%s [%d]\n", message, (int) getpid());

								free(message);
								free((*s_etat_processus).instruction_courante);
								return(d_erreur);
							}
							else if ((*s_etat_processus)
									.invalidation_message_erreur == d_faux)
							{
								(*s_etat_processus).erreur_execution =
										(*s_etat_processus)
										.derniere_erreur_evaluation;

								if (test_cfsf(s_etat_processus, 51) == d_faux)
								{
									printf("%s", ds_beep);
								}

								if ((message = messages(s_etat_processus))
										== NULL)
								{
									free((*s_etat_processus)
											.instruction_courante);
									return(d_erreur);
								}

								printf("%s [%d]\n", message, (int) getpid());
								free(message);

								if (test_cfsf(s_etat_processus, 31) == d_vrai)
								{
									l_element_courant = (*s_etat_processus)
											.l_base_pile_last;

									while(l_element_courant != NULL)
									{
										if ((s_sous_objet = copie_objet(
												s_etat_processus,
												(*l_element_courant).donnee,
												'P')) == NULL)
										{
											(*s_etat_processus).erreur_systeme =
													d_es_allocation_memoire;
											return(d_erreur);
										}

										if (empilement(s_etat_processus,
												&((*s_etat_processus)
												.l_base_pile),
												s_sous_objet) == d_erreur)
										{
											return(d_erreur);
										}

										l_element_courant = (*l_element_courant)
												.suivant;
									}
								}

								(*s_etat_processus).erreur_execution = d_ex;
								(*s_etat_processus).exception = d_ep;
							}

							liberation(s_etat_processus, s_objet);
						}
						else
						{	
							liberation(s_etat_processus, s_objet);
						}

						(*(*s_etat_processus).l_base_pile_systeme)
								.retour_definition = tampon_retour;
					}
				}
				else if ((*s_etat_processus).invalidation_message_erreur
						== d_faux)
				{
					(*s_etat_processus).instruction_courante = registre;
					(*s_etat_processus).position_courante = position_courante;
					(*s_etat_processus).definitions_chainees = tampon;

					if (test_cfsf(s_etat_processus, 51) == d_faux)
					{
						printf("%s", ds_beep);
					}

					if ((message = messages(s_etat_processus)) == NULL)
					{
						free((*s_etat_processus).instruction_courante);
						free(ligne);
						return(d_erreur);
					}

					free(message);

					if ((*s_etat_processus).langue == 'F')
					{
						printf("+++Erreur : Erreur de syntaxe\n");
					}
					else
					{
						printf("+++Error : Syntax error\n");
					}

					fflush(stdout);
				}

				free(ligne);
			}

			(*s_etat_processus).traitement_instruction_halt = d_faux;
		}

		if ((*s_etat_processus).debug == d_vrai)
			if (((*s_etat_processus).type_debug &
					d_debug_fonctions_intrinseques) != 0)
		{
			if ((*s_etat_processus).langue == 'F')
			{
				printf("[%d] Instruction %s\n",
						(int) getpid(),
						(*s_etat_processus).instruction_courante);
			}
			else
			{
				printf("[%d] %s instruction\n",
						(int) getpid(),
						(*s_etat_processus).instruction_courante);
			}

			fflush(stdout);
		}

/*
--------------------------------------------------------------------------------
  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.
--------------------------------------------------------------------------------
*/

		if (erreur == d_absence_erreur)
		{

/*
--------------------------------------------------------------------------------
  Scrutation des mots clef du langage RPL/2 et exécution le cas échéant
  de l'action associée.
--------------------------------------------------------------------------------
*/

			analyse(s_etat_processus, NULL);

			if ((*s_etat_processus).traitement_cycle_exit != 'N')
			{
				switch((*s_etat_processus).traitement_cycle_exit)
				{
					case 'C' :
					{
						instruction_cycle(s_etat_processus);
						break;
					}

					case 'E' :
					{
						instruction_exit(s_etat_processus);
						break;
					}
				}
			}

			if ((*s_etat_processus).instruction_valide == 'N')
			{
			
/*
--------------------------------------------------------------------------------
  L'instruction ne correspond pas à l'un des mots clef du langage RPL/2.
--------------------------------------------------------------------------------
*/

				if ((recherche_variable(s_etat_processus,
						(*s_etat_processus).instruction_courante) ==
						d_vrai) && ((*s_etat_processus)
						.autorisation_evaluation_nom == 'Y'))
				{
					if ((*(*s_etat_processus).pointeur_variable_courante)
							.objet == NULL)
					{

/*
--------------------------------------------------------------------------------
  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 ((*s_etat_processus).langue == 'F')
							{
								printf("[%d] Empilement 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(),
										(*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);
						}

						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.

							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)
							{
								(*s_etat_processus).erreur_systeme =
										d_es_allocation_memoire;
								return(d_erreur);
							}

							if (pthread_mutex_unlock(&((*(*s_etat_processus)
									.s_liste_variables_partagees).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)
							{
								(*s_etat_processus).erreur_systeme =
										d_es_allocation_memoire;
								return(d_erreur);
							}
						}
						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);
						}
					}

/*
--------------------------------------------------------------------------------
  L'instruction est une variable automatique (évaluation lors de l'empilement).
--------------------------------------------------------------------------------
*/

					else if ((*(*(*s_etat_processus).pointeur_variable_courante)
							.objet).type == ADR)
					{

/*
--------------------------------------------------------------------------------
  L'instruction est une variable de type 'adresse' pointant sur une
  définition. Un branchement est effectué à cette adresse.
--------------------------------------------------------------------------------
*/

						if ((*s_etat_processus).debug == d_vrai)
							if (((*s_etat_processus).type_debug &
									d_debug_appels_fonctions) != 0)
						{
							if ((*s_etat_processus).langue == 'F')
							{
								printf("[%d] Branchement à la"
										" définition %s\n", (int) getpid(),
										(*s_etat_processus)
										.instruction_courante);
							}
							else
							{
								printf("[%d] Execution : "
										"Branching at %s definition\n",
										(int) getpid(), (*s_etat_processus)
										.instruction_courante);
							}

							fflush(stdout);
						}

						(*s_etat_processus).autorisation_empilement_programme =
								'N';

						empilement_pile_systeme(s_etat_processus);

						if ((*s_etat_processus).erreur_systeme != d_es)
						{
							erreur = d_erreur;
						}
						else
						{
							if ((*s_etat_processus).profilage == d_vrai)
							{
								profilage(s_etat_processus,
										(*s_etat_processus)
										.instruction_courante);

								if ((*s_etat_processus).erreur_systeme != d_es)
								{
									return(d_erreur);
								}
							}

							(*(*s_etat_processus).l_base_pile_systeme)
									.adresse_retour = (*s_etat_processus)
									.position_courante;

							(*(*s_etat_processus).l_base_pile_systeme)
									.retour_definition = 'Y';

							(*(*s_etat_processus).l_base_pile_systeme)
									.niveau_courant = (*s_etat_processus)
									.niveau_courant;

							(*s_etat_processus).position_courante =
									(*((unsigned long *)
									((*(*(*s_etat_processus)
									.pointeur_variable_courante)
									.objet).objet)));

							drapeau_appel_definition = d_vrai;
						}
					}
					else
					{
						if ((*s_etat_processus).debug == d_vrai)
							if (((*s_etat_processus).type_debug &
									d_debug_variables) != 0)
						{
							if ((*s_etat_processus).langue == 'F')
							{
								printf("[%d] Empilement de la variable "
										"%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 variable "
										"\n", (int) getpid(),
										(*s_etat_processus)
										.instruction_courante,
										(*(*(*s_etat_processus)
										.pointeur_variable_courante).objet)
										.type);
							}

							fflush(stdout);
						}

						if ((s_objet = copie_objet(s_etat_processus,
								(*(*s_etat_processus)
								.pointeur_variable_courante).objet, 'P'))
								== NULL)
						{
							(*s_etat_processus).erreur_systeme =
									d_es_allocation_memoire;
							return(d_erreur);
						}

						if (empilement(s_etat_processus,
								&((*s_etat_processus).l_base_pile),
								s_objet) == d_erreur)
						{
							(*s_etat_processus).erreur_systeme =
									d_es_allocation_memoire;
							return(d_erreur);
						}
					}
				}
				else
				{

/*
--------------------------------------------------------------------------------
  L'instruction est une donnée à empiler.
--------------------------------------------------------------------------------
*/

					(*s_etat_processus).erreur_systeme = d_es;
					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)
							{
								(*s_etat_processus).erreur_execution =
										d_ex_manque_argument;
							}
						}
						else if ((*(*(*s_etat_processus).l_base_pile).donnee)
								.type == NOM)
						{
							if ((*((struct_nom *) (*(*(*s_etat_processus)
									.l_base_pile).donnee).objet)).symbole
									== d_faux)
							{
								(*s_etat_processus).erreur_execution =
										d_ex_nom_implicite;

								// 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.

								if ((*s_etat_processus).niveau_recursivite != 0)
								{
									free((*s_etat_processus)
											.instruction_courante);
									return(d_erreur);
								}
							}
						}
					}

					// Le séquenceur est appelé depuis la routine d'évaluation

					if ((*s_etat_processus).evaluation_forcee == 'Y')
					{
						if (depilement(s_etat_processus,
								&((*s_etat_processus).l_base_pile),
								&s_objet_evaluation) == d_erreur)
						{
							free((*s_etat_processus).instruction_courante);
							(*s_etat_processus).erreur_execution =
									d_ex_manque_argument;
							return(d_erreur);
						}

						if (evaluation(s_etat_processus, s_objet_evaluation,
								'N') == d_erreur)
						{
							free((*s_etat_processus).instruction_courante);
							liberation(s_etat_processus, s_objet_evaluation);
							return(d_erreur);
						}

						liberation(s_etat_processus, s_objet_evaluation);
					}

					// Le séquenceur est appelé depuis la routine de
					// recherche de type

					else if ((*s_etat_processus).recherche_type == 'Y')
					{
						if ((*s_etat_processus).erreur_execution != d_ex)
						{
							free((*s_etat_processus).instruction_courante);
							return(d_erreur);
						}
					}
				}
			}
			else if (((*s_etat_processus).test_instruction == 'Y') &&
					((*s_etat_processus).instruction_valide == 'Y'))
			{

/*
--------------------------------------------------------------------------------
  Permet de traiter les fonctions dans les objets de type liste
--------------------------------------------------------------------------------
*/

				if ((instruction_majuscule = conversion_majuscule(
						(*s_etat_processus).instruction_courante)) == NULL)
				{
					(*s_etat_processus).erreur_systeme =
							d_es_allocation_memoire;
					return(d_erreur);
				}

				if ((strcmp((*s_etat_processus).instruction_courante, "<<")
						!= 0) && (strcmp((*s_etat_processus)
						.instruction_courante, ">>") != 0))
				{
					if ((s_objet = allocation(s_etat_processus, FCT)) == NULL)
					{
						(*s_etat_processus).erreur_systeme =
								d_es_allocation_memoire;
						return(d_erreur);
					}

					(*((struct_fonction *) (*s_objet).objet))
							.nombre_arguments = 0;

					if ((*s_etat_processus).instruction_intrinseque == 'Y')
					{
						if (((*((struct_fonction *) (*s_objet).objet))
								.nom_fonction = conversion_majuscule(
								(*s_etat_processus).instruction_courante))
								== NULL)
						{
							(*s_etat_processus).erreur_systeme =
									d_es_allocation_memoire;
							return(d_erreur);
						}
					}
					else
					{
						if (((*((struct_fonction *) (*s_objet).objet))
								.nom_fonction = (unsigned char *) malloc(
								(strlen((*s_etat_processus)
								.instruction_courante)
								+ 1) * sizeof(unsigned char))) == NULL)
						{
							(*s_etat_processus).erreur_systeme =
									d_es_allocation_memoire;
							return(d_erreur);
						}

						strcpy((*((struct_fonction *) (*s_objet).objet))
								.nom_fonction, (*s_etat_processus)
								.instruction_courante);
					}

					(*((struct_fonction *) (*s_objet).objet)).fonction =
							analyse_instruction(s_etat_processus,
							(*s_etat_processus).instruction_courante);

					if (empilement(s_etat_processus,
							&((*s_etat_processus).l_base_pile), s_objet) ==
							d_erreur)
					{
						(*s_etat_processus).erreur_systeme =
								d_es_allocation_memoire;
						return(d_erreur);
					}
				}
				else
				{
					(*s_etat_processus).test_instruction = 'N';
					analyse(s_etat_processus, NULL);
					(*s_etat_processus).test_instruction = 'Y';
				}

				free(instruction_majuscule);
			}

			erreur |= (((*s_etat_processus).erreur_execution != d_ex)
					? d_erreur : d_absence_erreur);
		}
		else
		{
			printf("\n");

			if ((*s_etat_processus).langue == 'F')
			{
				printf("+++Erreur : Argument %s invalide\n",
						(*s_etat_processus).instruction_courante);
			}
			else
			{
				printf("+++Error : Invalid %s argument\n",
						(*s_etat_processus).instruction_courante);
			}

			fflush(stdout);

			free((*s_etat_processus).instruction_courante);
			return(d_erreur);
		}

/*
--------------------------------------------------------------------------------
  Traitement des arrêts simples
--------------------------------------------------------------------------------
*/

		if ((*s_etat_processus).var_volatile_requete_arret2 != 0)
		{
			if ((*s_etat_processus).debug_programme == d_vrai)
			{
				(*s_etat_processus).var_volatile_requete_arret2 = 0;
			}
			else
			{
				if ((*s_etat_processus).var_volatile_requete_arret2 == -1)
				{
					if (strncmp(getenv("LANG"), "fr", 2) == 0)
					{
						printf("[%d] Arrêt\n", (int) getpid());
					}
					else
					{
						printf("[%d] Break\n", (int) getpid());
					}

					(*s_etat_processus).var_volatile_requete_arret2 = 1;

					fflush(stdout);
				}

				if ((*s_etat_processus).niveau_recursivite == 0)
				{
					(*s_etat_processus).debug_programme = d_vrai;
					(*s_etat_processus).var_volatile_requete_arret2 = 0;
				}
			}
		}

		/*
		 * On ne sort pas du debugger en cas d'une erreur sur un programme
		 * en cours de débogage.
		 */

		if ((((*s_etat_processus).erreur_execution != d_ex) ||
				((*s_etat_processus).exception != d_ep)) &&
				((*s_etat_processus).debug_programme == d_vrai))
		{
			if (test_cfsf(s_etat_processus, 31) == d_vrai)
			{
				l_element_courant = (*s_etat_processus).l_base_pile_last;

				while(l_element_courant != NULL)
				{
					if ((s_objet = copie_objet(s_etat_processus,
							(*l_element_courant).donnee, 'P')) == NULL)
					{
						(*s_etat_processus).erreur_systeme =
								d_es_allocation_memoire;
						return(d_erreur);
					}

					if (empilement(s_etat_processus, &((*s_etat_processus)
							.l_base_pile), s_objet) == d_erreur)
					{
						return(d_erreur);
					}

					l_element_courant = (*l_element_courant).suivant;
				}
			}

			if (test_cfsf(s_etat_processus, 51) == d_faux)
			{
				printf("%s", ds_beep);
			}

			if ((message = messages(s_etat_processus)) == NULL)
			{
				free((*s_etat_processus).instruction_courante);
				return(d_erreur);
			}

			printf("%s [%d]\n", message, (int) getpid());

			free(message);

			(*s_etat_processus).erreur_execution = d_ex;
			(*s_etat_processus).exception = d_ep;
			erreur = d_absence_erreur;

			(*s_etat_processus).position_courante -=
					strlen((*s_etat_processus).instruction_courante);
		}

/*
--------------------------------------------------------------------------------
  Test de fin d'exécution du programme RPL/2
--------------------------------------------------------------------------------
*/

		if (((*s_etat_processus).niveau_courant == 0) &&
				(drapeau_appel_definition != d_vrai))
		{
			drapeau_fin = d_vrai;
		}
		else if ((*s_etat_processus).requete_arret == 'Y')
		{
			drapeau_fin = d_vrai;
		}
		else if (((*s_etat_processus).var_volatile_requete_arret != 0)
				&& ((*s_etat_processus).debug_programme == d_faux))
		{
			drapeau_fin = d_vrai;

			if ((*s_etat_processus).erreur_systeme == d_es)
			{
				erreur = d_absence_erreur;
			}
		}
		else if ((*s_etat_processus).arret_si_exception == d_vrai)
		{
			drapeau_fin = d_faux;

			if ((*s_etat_processus).exception != d_ep)
			{
				erreur = d_erreur;
			}
			else if ((*s_etat_processus).erreur_systeme != d_es)
			{
				erreur = d_erreur;
			}
		}
		else if ((*s_etat_processus).arret_si_exception == d_faux)
		{
			if ((message = messages(s_etat_processus)) == NULL)
			{
				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
				return(d_erreur);
			}

			free(message);

			drapeau_fin = d_faux;

/*
--------------------------------------------------------------------------------
  Traitement des exceptions
--------------------------------------------------------------------------------
*/

			if ((*s_etat_processus).erreur_systeme != d_es)
			{
				erreur = d_erreur;
			}
			else if (((*s_etat_processus).exception != d_ep) ||
					((*s_etat_processus).erreur_execution != d_ex))
			{
				tampon = (*s_etat_processus).instruction_courante;

				while((*(*s_etat_processus).l_base_pile_systeme).clause != 'R')
				{
					erreur = recherche_instruction_suivante(s_etat_processus);

					if (erreur == d_erreur)
					{
						free((*s_etat_processus).instruction_courante);
						return(d_erreur);
					}

					if (recherche_variable(s_etat_processus,
							(*s_etat_processus).instruction_courante) == d_vrai)
					{
						if ((*(*s_etat_processus).pointeur_variable_courante)
								.objet == NULL)
						{
							// Variable partagée
						}
						else if ((*(*(*s_etat_processus)
								.pointeur_variable_courante).objet).type == ADR)
						{
							empilement_pile_systeme(s_etat_processus);

							if ((*s_etat_processus).erreur_systeme != d_es)
							{
								free((*s_etat_processus).instruction_courante);
								return(d_erreur);
							}

							(*(*s_etat_processus).l_base_pile_systeme)
									.adresse_retour = (*s_etat_processus)
									.position_courante;

							(*(*s_etat_processus).l_base_pile_systeme)
									.retour_definition = 'Y';

							(*(*s_etat_processus).l_base_pile_systeme)
									.niveau_courant = (*s_etat_processus)
									.niveau_courant;

							(*s_etat_processus).position_courante =
									(*((unsigned long *)
									((*(*(*s_etat_processus)
									.pointeur_variable_courante)
									.objet).objet)));

							(*s_etat_processus)
									.autorisation_empilement_programme = 'N';
						}
					}
					else
					{
						(*s_etat_processus).erreur_systeme = d_es;
						instruction_majuscule = conversion_majuscule(
								(*s_etat_processus).instruction_courante);

						if (instruction_majuscule == NULL)
						{
							free((*s_etat_processus).instruction_courante);
							return(d_erreur);
						}

						/*
						 * Traitement de la pile système par les
						 * différentes instructions.
						 */

						if ((strcmp(instruction_majuscule, "IF") == 0) ||
								(strcmp(instruction_majuscule, "IFERR") == 0) ||
								(strcmp(instruction_majuscule, "DO") == 0) ||
								(strcmp(instruction_majuscule, "WHILE") == 0) ||
								(strcmp(instruction_majuscule, "FOR") == 0) ||
								(strcmp(instruction_majuscule, "START") == 0) ||
								(strcmp(instruction_majuscule, "SELECT") == 0)
								|| (strcmp(instruction_majuscule, "CASE") == 0)
							   	|| (strcmp(instruction_majuscule, "<<") == 0))
						{
							if (strcmp(instruction_majuscule, "<<") == 0)
							{
								analyse(s_etat_processus, NULL);
							}
							else
							{
								empilement_pile_systeme(s_etat_processus);

								if ((*s_etat_processus).erreur_systeme != d_es)
								{
									return(d_erreur);
								}
							}
						}
						else if ((strcmp(instruction_majuscule, "END") == 0) ||
								(strcmp(instruction_majuscule, "NEXT") == 0) ||
								(strcmp(instruction_majuscule, "STEP") == 0) ||
								(strcmp(instruction_majuscule, ">>") == 0))
						{
							if (strcmp(instruction_majuscule, ">>") == 0)
							{
								analyse(s_etat_processus, NULL);

								if ((*(*s_etat_processus).l_base_pile_systeme)
										.origine_routine_evaluation == 'Y')
								{
									free(instruction_majuscule);
									free((*s_etat_processus)
											.instruction_courante);

									(*s_etat_processus).instruction_courante =
											tampon;

									return(d_absence_erreur);
								}
							}
							else
							{
								depilement_pile_systeme(s_etat_processus);

								if ((*s_etat_processus).erreur_systeme != d_es)
								{
									return(d_erreur);
								}
							}
						}

						free(instruction_majuscule);
					}

					free((*s_etat_processus).instruction_courante);
				}

				drapeau_then = d_faux;
				niveau = 0;

				do
				{
					erreur = recherche_instruction_suivante(s_etat_processus);

					if (erreur == d_erreur)
					{
						return(d_erreur);
					}
					
					instruction_majuscule = conversion_majuscule(
							(*s_etat_processus).instruction_courante);

					if (instruction_majuscule == NULL)
					{
						return(d_erreur);
					}

					if ((strcmp(instruction_majuscule, "IF") == 0) ||
							(strcmp(instruction_majuscule, "IFERR") == 0) ||
							(strcmp(instruction_majuscule, "DO") == 0) ||
							(strcmp(instruction_majuscule, "WHILE") == 0) ||
							(strcmp(instruction_majuscule, "FOR") == 0) ||
							(strcmp(instruction_majuscule, "START") == 0) ||
							(strcmp(instruction_majuscule, "SELECT") == 0)
							|| (strcmp(instruction_majuscule, "CASE") == 0)
							|| (strcmp(instruction_majuscule, "<<") == 0))
					{
						niveau++;
					}
					else if ((strcmp(instruction_majuscule, "END") == 0) ||
							(strcmp(instruction_majuscule, "NEXT") == 0) ||
							(strcmp(instruction_majuscule, "STEP") == 0) ||
							(strcmp(instruction_majuscule, ">>") == 0))
					{
						niveau--;
					}

					drapeau_then = ((strcmp(instruction_majuscule, "THEN") == 0)
							&& (niveau == 0)) ? d_vrai : d_faux;

					free(instruction_majuscule);
					free((*s_etat_processus).instruction_courante);
				} while(drapeau_then == d_faux);

				(*s_etat_processus).position_courante -= 5;
				(*s_etat_processus).instruction_courante = tampon;
				(*(*s_etat_processus).l_base_pile_systeme).clause = 'X';

				erreur = d_absence_erreur;
				(*s_etat_processus).exception = d_ep;
				(*s_etat_processus).erreur_execution = d_ex;
			}
		}
		else
		{
			drapeau_fin = d_faux;
		}

		if (erreur == d_absence_erreur)
		{
			free((*s_etat_processus).instruction_courante);
		}
	} while((erreur == d_absence_erreur) &&
			((*s_etat_processus).position_courante <
			(*s_etat_processus).longueur_definitions_chainees) &&
			(drapeau_fin == d_faux) &&
			((*s_etat_processus).retour_routine_evaluation == 'N'));

/*
--------------------------------------------------------------------------------
  Messages d'erreur à afficher le cas échéant
--------------------------------------------------------------------------------
*/

	if ((erreur != d_absence_erreur) && ((*s_etat_processus)
			.invalidation_message_erreur == d_faux))
	{
		if (test_cfsf(s_etat_processus, 31) == d_vrai)
		{
			l_element_courant = (*s_etat_processus).l_base_pile_last;

			while(l_element_courant != NULL)
			{
				if ((s_objet = copie_objet(s_etat_processus,
						(*l_element_courant).donnee, 'P')) == NULL)
				{
					(*s_etat_processus).erreur_systeme =
							d_es_allocation_memoire;
					return(d_erreur);
				}

				if (empilement(s_etat_processus, &((*s_etat_processus)
						.l_base_pile), s_objet) == d_erreur)
				{
					return(d_erreur);
				}

				l_element_courant = (*l_element_courant).suivant;
			}
		}

		if (test_cfsf(s_etat_processus, 51) == d_faux)
		{
			printf("%s", ds_beep);
		}

		if ((message = messages(s_etat_processus)) == NULL)
		{
			return(d_erreur);
		}

		printf("%s [%d]\n", message, (int) getpid());

		free(message);
		free((*s_etat_processus).instruction_courante);

		if ((*s_etat_processus).var_volatile_processus_pere == 0)
		{
			envoi_signal_processus((*s_etat_processus).pid_processus_pere,
					rpl_sigalrm);
		}
		else
		{
			(*s_etat_processus).var_volatile_alarme = -1;
		}

		return(d_erreur);
	}

	return(d_absence_erreur);
}

// vim: ts=4