/*
================================================================================
  RPL/2 (R) version 4.1.20
  Copyright (C) 1989-2015 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"


/*
================================================================================
  Fonction '->'
================================================================================
  Entrées : structure processus
--------------------------------------------------------------------------------
  Sorties :
--------------------------------------------------------------------------------
  Effets de bord : néant
================================================================================
*/

void
instruction_fleche(struct_processus *s_etat_processus)
{
	struct_liste_chainee				*l_element_courant;
	struct_liste_chainee				*l_emplacement_valeurs;

	struct_objet						*s_objet;
	struct_objet						*s_objet_elementaire;
	struct_objet						*s_expression_algebrique;

	struct_variable						s_variable;

	struct_variable_partagee			s_variable_partagee;
	struct_variable_statique			s_variable_statique;

	logical1							fin_scrutation;
	logical1							presence_expression_algebrique;

	pthread_mutexattr_t					attributs_mutex;

	union_position_variable				position_variable;

	unsigned char						instruction_valide;
	unsigned char						*tampon;
	unsigned char						test_instruction;

	integer8							i;
	integer8							nombre_variables;

	void								(*fonction)();

	(*s_etat_processus).erreur_execution = d_ex;

	if ((*s_etat_processus).affichage_arguments == 'Y')
	{
		printf("\n  -> ");

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(création de variables locales)\n\n");
		}
		else
		{
			printf("(create local variables)\n\n");
		}

		printf("    n: %s, %s, %s, %s, %s, %s,\n"
				"       %s, %s, %s, %s, %s,\n"
				"       %s, %s, %s, %s, %s,\n"
				"       %s, %s, %s, %s,\n"
				"       %s, %s\n",
				d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
				d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
				d_SQL, d_SLB, d_PRC, d_MTX);
		printf("    ...\n");
		printf("    1: %s, %s, %s, %s, %s, %s,\n"
				"       %s, %s, %s, %s, %s,\n"
				"       %s, %s, %s, %s, %s,\n"
				"       %s, %s, %s, %s,\n"
				"       %s, %s\n",
				d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
				d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
				d_SQL, d_SLB, d_PRC, d_MTX);

		if ((*s_etat_processus).langue == 'F')
		{
			printf("  Utilisation :\n\n");
		}
		else
		{
			printf("  Usage:\n\n");
		}

		printf("    -> (variables) %s\n\n", d_RPN);

		printf("    -> (variables) %s\n", d_ALG);

		return;
	}
	else if ((*s_etat_processus).test_instruction == 'Y')
	{
		(*s_etat_processus).nombre_arguments = -1;
		return;
	}

	if (test_cfsf(s_etat_processus, 31) == d_vrai)
	{
		if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
		{
			return;
		}
	}

	(*s_etat_processus).autorisation_empilement_programme = 'N';

/*
--------------------------------------------------------------------------------
  Boucler jusqu'au prochain '<<' ou jusqu'à la prochaine expression algébrique
--------------------------------------------------------------------------------
*/

	test_instruction = (*s_etat_processus).test_instruction;
	instruction_valide = (*s_etat_processus).instruction_valide;
	presence_expression_algebrique = d_faux;

	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] Recherche des variables locales\n", (int) getpid());
		}
		else
		{
			printf("[%d] Searching for local variables\n", (int) getpid());
		}

		fflush(stdout);
	}

	nombre_variables = 0;

	if ((*s_etat_processus).mode_execution_programme == 'Y')
	{
		/*
		 * Le programme est exécuté normalement.
		 */

		tampon = (*s_etat_processus).instruction_courante;

		do
		{
			if (recherche_instruction_suivante(s_etat_processus) == d_erreur)
			{
				(*s_etat_processus).instruction_courante = tampon;
				return;
			}

			if (strcmp((*s_etat_processus).instruction_courante, "<<") == 0)
			{
				fin_scrutation = d_vrai;
				(*s_etat_processus).test_instruction = 'N';
			}
			else
			{
				fin_scrutation = d_faux;
				(*s_etat_processus).test_instruction = 'Y';
			}

			analyse(s_etat_processus, NULL);

			if ((*s_etat_processus).instruction_valide == 'N')
			{
				(*s_etat_processus).type_en_cours = NON;
				recherche_type(s_etat_processus);

				if ((*s_etat_processus).erreur_execution != d_ex)
				{
					(*s_etat_processus).instruction_courante = tampon;
					return;
				}
				
				if ((*(*(*s_etat_processus).l_base_pile).donnee).type == ALG)
				{
					(*s_etat_processus).niveau_courant++;
					fin_scrutation = d_vrai;
					presence_expression_algebrique = d_vrai;

					if (depilement(s_etat_processus, &((*s_etat_processus)
							.l_base_pile), &s_expression_algebrique)
							== d_erreur)
					{
						(*s_etat_processus).erreur_execution =
								d_ex_manque_argument;
						(*s_etat_processus).instruction_courante = tampon;
						return;
					}
				}
				else if ((*(*(*s_etat_processus).l_base_pile).donnee)
						.type != NOM)
				{
					(*s_etat_processus).erreur_execution = d_ex_nom_invalide;
					(*s_etat_processus).instruction_courante = tampon;
					return;
				}
				else if ((*((struct_nom *) (*(*(*s_etat_processus).l_base_pile)
						.donnee).objet)).symbole == d_vrai)
				{
					(*s_etat_processus).niveau_courant++;
					fin_scrutation = d_vrai;
					presence_expression_algebrique = d_vrai;

					if (depilement(s_etat_processus, &((*s_etat_processus)
							.l_base_pile), &s_expression_algebrique)
							== d_erreur)
					{
						(*s_etat_processus).erreur_execution =
								d_ex_manque_argument;
						(*s_etat_processus).instruction_courante = tampon;
						return;
					}
				}
				else
				{
					nombre_variables = nombre_variables + 1;
				}
			}
			else
			{
				if (fin_scrutation == d_faux)
				{
					(*s_etat_processus).erreur_execution = d_ex_nom_reserve;
					(*s_etat_processus).instruction_courante = tampon;
					return;
				}
			}

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

		(*s_etat_processus).instruction_courante = tampon;
	}
	else
	{
		/*
		 * Une expression est en cours d'évaluation.
		 */

		l_element_courant = (*(*s_etat_processus).expression_courante).suivant;
		tampon = (*s_etat_processus).instruction_courante;

		do
		{
			if ((*(*l_element_courant).donnee).type == FCT)
			{
				fonction = (*((struct_fonction *) (*(*l_element_courant)
						.donnee).objet)).fonction;

				if (fonction == instruction_vers_niveau_superieur)
				{
					fin_scrutation = d_vrai;
					(*s_etat_processus).test_instruction = 'N';

					analyse(s_etat_processus,
							instruction_vers_niveau_superieur);
				}
				else
				{
					(*s_etat_processus).expression_courante = l_element_courant;
					(*s_etat_processus).erreur_execution = d_ex_nom_invalide;
					return;
				}
			}
			else if ((*(*l_element_courant).donnee).type == ALG)
			{
				(*s_etat_processus).niveau_courant++;
				fin_scrutation = d_vrai;
				presence_expression_algebrique = d_vrai;

				s_expression_algebrique = (*l_element_courant).donnee;
			}
			else if ((*(*l_element_courant).donnee).type != NOM)
			{
				(*s_etat_processus).expression_courante = l_element_courant;
				(*s_etat_processus).erreur_execution = d_ex_nom_invalide;
				return;
			}
			else if ((*((struct_nom *) (*(*l_element_courant).donnee).objet))
					.symbole == d_vrai)
			{
				(*s_etat_processus).niveau_courant++;
				fin_scrutation = d_vrai;
				presence_expression_algebrique = d_vrai;

				s_expression_algebrique = (*l_element_courant).donnee;
			}
			else
			{
				if ((s_objet_elementaire = copie_objet(s_etat_processus,
						(*l_element_courant).donnee, 'P')) == NULL)
				{
					(*s_etat_processus).expression_courante = l_element_courant;
					(*s_etat_processus).erreur_systeme =
							d_es_allocation_memoire;
					return;
				}

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

				nombre_variables = nombre_variables + 1;
				fin_scrutation = d_faux;
			}

			(*s_etat_processus).expression_courante = l_element_courant;
			l_element_courant = (*l_element_courant).suivant;
		} while((fin_scrutation == d_faux) && (l_element_courant != NULL));

		(*s_etat_processus).objet_courant =
				(*(*s_etat_processus).expression_courante).donnee;
		(*s_etat_processus).instruction_courante = tampon;

		if (fin_scrutation == d_faux)
		{
			(*s_etat_processus).erreur_execution = d_ex_erreur_evaluation;
			return;
		}
	}

	if (nombre_variables < 1)
	{
		(*s_etat_processus).erreur_execution = d_ex_absence_variable;
		return;
	}

	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] Nombre de variables de niveau %lld : %lld\n",
					(int) getpid(),
					(*s_etat_processus).niveau_courant, nombre_variables);
		}
		else
		{
			printf("[%d] Number of level %lld variables : %lld\n",
					(int) getpid(),
					(*s_etat_processus).niveau_courant, nombre_variables);
		}

		fflush(stdout);
	}

	l_emplacement_valeurs = (*s_etat_processus).l_base_pile;

	for(i = 0; i < nombre_variables; i++)
	{
		if (l_emplacement_valeurs == NULL)
		{
			(*s_etat_processus).erreur_execution = d_ex_manque_argument;
			return;
		}

		l_emplacement_valeurs = (*l_emplacement_valeurs).suivant;
	}

	l_element_courant = l_emplacement_valeurs;

	for(i = 0; i < nombre_variables; i++)
	{
		if (l_element_courant == NULL)
		{
			(*s_etat_processus).erreur_execution = d_ex_manque_argument;
			return;
		}

		l_element_courant = (*l_element_courant).suivant;
	}

	for(i = 0; i < nombre_variables; i++)
	{
		if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
				&s_objet) == d_erreur)
		{
			(*s_etat_processus).erreur_execution = d_ex_manque_argument;
			return;
		}

		if ((s_variable.nom = malloc((strlen(
				(*((struct_nom *) (*s_objet).objet)).nom) + 1) *
				sizeof(unsigned char))) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		strcpy(s_variable.nom, (*((struct_nom *) (*s_objet).objet)).nom);

		if ((*s_etat_processus).debug == d_vrai)
			if (((*s_etat_processus).type_debug &
					d_debug_variables) != 0)
		{
			printf("[%d] Variable %s\n", (int) getpid(), s_variable.nom);
			fflush(stdout);
		}

		s_variable.niveau = (*s_etat_processus).niveau_courant;

		// Si le drapeau creation_variables_statiques est positionné,
		// on recherche une entrée dans la table des variables statiques.
		// Si cette entrée existe, on affecte à la variable créée l'objet
		// contenu dans la table des variables statiques. Dans le cas contraire,
		// on crée une entrée dans la table des variables statiques avec
		// ce qui se trouve dans la pile.

		if ((*s_etat_processus).l_base_pile_systeme == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_pile_vide;
			return;
		}

		/*
		 * Vérification de l'unicité de la variable pour un niveau donné
		 */

		if (recherche_variable(s_etat_processus, s_variable.nom) == d_vrai)
		{
			if ((*s_etat_processus).niveau_courant ==
					(*(*s_etat_processus).pointeur_variable_courante).niveau)
			{
				liberation(s_etat_processus, s_objet);
				free(s_variable.nom);

				(*s_etat_processus).erreur_execution = d_ex_creation_variable;
				return;
			}
		}

		(*s_etat_processus).erreur_systeme = d_es;

		if ((*(*s_etat_processus).l_base_pile_systeme)
				.creation_variables_statiques == d_vrai)
		{
			if ((*s_etat_processus).mode_execution_programme == 'Y')
			{
				position_variable.adresse =
						(*s_etat_processus).position_courante;
			}
			else
			{
				position_variable.pointeur =
						(*s_etat_processus).objet_courant;
			}

			if (recherche_variable_statique(s_etat_processus, s_variable.nom,
					position_variable,
					((*s_etat_processus).mode_execution_programme == 'Y')
					? 'P' : 'E') != NULL)
			{
				// Variable statique à utiliser

				if ((*s_etat_processus).mode_execution_programme == 'Y')
				{
					s_variable.origine = 'P';
				}
				else
				{
					s_variable.origine = 'E';
				}

				s_variable.objet = (*(*s_etat_processus)
						.pointeur_variable_statique_courante).objet;
				(*(*s_etat_processus).pointeur_variable_statique_courante)
						.objet = NULL;
			}
			else
			{
				// Variable statique à créer

				s_variable_statique.objet = NULL;
				(*s_etat_processus).erreur_systeme = d_es;

				if ((s_variable_statique.nom = malloc((strlen(s_variable.nom)
						+ 1) * sizeof(unsigned char))) == NULL)
				{
					(*s_etat_processus).erreur_systeme =
							d_es_allocation_memoire;
					return;
				}

				strcpy(s_variable_statique.nom, s_variable.nom);

				if ((*s_etat_processus).mode_execution_programme == 'Y')
				{
					s_variable_statique.origine = 'P';
					s_variable_statique.niveau = 0;
					s_variable_statique.variable_statique.adresse =
							(*s_etat_processus).position_courante;
				}
				else
				{
					s_variable_statique.origine = 'E';

					/*
					 * Si la variable est appelée depuis une expression
					 * compilée (variable de niveau 0), la variable statique
					 * est persistante (niveau 0). Dans le cas contraire, elle
					 * est persistante à l'expression (niveau courant).
					 */

					if ((*s_etat_processus).evaluation_expression_compilee
							== 'Y')
					{
						s_variable_statique.niveau = 0;
					}
					else
					{
						s_variable_statique.niveau =
								(*s_etat_processus).niveau_courant;
					}

					s_variable_statique.variable_statique.pointeur =
							(*s_etat_processus).objet_courant;
				}

				if (creation_variable_statique(s_etat_processus,
						&s_variable_statique) == d_erreur)
				{
					return;
				}

				s_variable.objet = (*l_emplacement_valeurs).donnee;
				(*l_emplacement_valeurs).donnee = NULL;
			}
		}
		else if ((*(*s_etat_processus).l_base_pile_systeme)
				.creation_variables_partagees == d_vrai)
		{
			if ((*s_etat_processus).mode_execution_programme == 'Y')
			{
				position_variable.adresse =
						(*s_etat_processus).position_courante;
			}
			else
			{
				position_variable.pointeur =
						(*s_etat_processus).objet_courant;
			}

			if (pthread_mutex_lock(&mutex_creation_variable_partagee) != 0)
			{
				(*s_etat_processus).erreur_systeme = d_es_processus;
				return;
			}

			if (recherche_variable_partagee(s_etat_processus, s_variable.nom,
					position_variable,
					((*s_etat_processus).mode_execution_programme == 'Y')
					? 'P' : 'E') != NULL)
			{
				// Variable partagée à utiliser

				if (pthread_mutex_unlock(&mutex_creation_variable_partagee)
						!= 0)
				{
					(*s_etat_processus).erreur_systeme = d_es_processus;
					return;
				}

				if (pthread_mutex_unlock(&((*(*s_etat_processus)
						.pointeur_variable_partagee_courante).mutex)) != 0)
				{
					(*s_etat_processus).erreur_systeme = d_es_processus;
					return;
				}

				// Les champs niveau, variable_statique, variable_partagee
				// et variable_verrouillee sont renseignés lors de l'appel
				// à la fonction creation_variable().

				if ((*s_etat_processus).mode_execution_programme == 'Y')
				{
					s_variable.origine = 'P';
				}
				else
				{
					s_variable.origine = 'E';
				}

				s_variable.objet = NULL;
			}
			else
			{
				// Variable partagée à créer

				(*s_etat_processus).erreur_systeme = d_es;

				if ((s_variable_partagee.nom = malloc((strlen(s_variable.nom)
						+ 1) * sizeof(unsigned char))) == NULL)
				{
					(*s_etat_processus).erreur_systeme =
							d_es_allocation_memoire;
					return;
				}

				strcpy(s_variable_partagee.nom, s_variable.nom);

				if ((*s_etat_processus).mode_execution_programme == 'Y')
				{
					s_variable_partagee.origine = 'P';
					s_variable_partagee.niveau = 0;
					s_variable_partagee.variable_partagee.adresse =
							(*s_etat_processus).position_courante;
				}
				else
				{
					s_variable_partagee.origine = 'E';

					/*
					 * Si la variable est appelée depuis une expression
					 * compilée (variable de niveau 0), la variable statique
					 * est persistante (niveau 0). Dans le cas contraire, elle
					 * est persistante à l'expression (niveau courant).
					 */

					if ((*s_etat_processus).evaluation_expression_compilee
							== 'Y')
					{
						s_variable_partagee.niveau = 0;
					}
					else
					{
						s_variable_partagee.niveau =
								(*s_etat_processus).niveau_courant;
					}

					s_variable_partagee.variable_partagee.pointeur =
							(*s_etat_processus).objet_courant;
				}

				// Création du mutex

				pthread_mutexattr_init(&attributs_mutex);
				pthread_mutexattr_settype(&attributs_mutex,
						PTHREAD_MUTEX_RECURSIVE);
				pthread_mutex_init(&(s_variable_partagee.mutex),
						&attributs_mutex);
				pthread_mutexattr_destroy(&attributs_mutex);

				s_variable_partagee.objet = (*l_emplacement_valeurs).donnee;
				(*l_emplacement_valeurs).donnee = NULL;

				if (creation_variable_partagee(s_etat_processus,
						&s_variable_partagee) == d_erreur)
				{
					return;
				}

				s_variable.objet = NULL;

				if (pthread_mutex_unlock(&mutex_creation_variable_partagee)
						!= 0)
				{
					(*s_etat_processus).erreur_systeme = d_es_processus;
					return;
				}
			}
		}
		else
		{
			s_variable.objet = (*l_emplacement_valeurs).donnee;
			(*l_emplacement_valeurs).donnee = NULL;
		}

		l_emplacement_valeurs = (*l_emplacement_valeurs).suivant;

		if (creation_variable(s_etat_processus, &s_variable,
				((*(*s_etat_processus).l_base_pile_systeme)
				.creation_variables_statiques == d_vrai) ? 'S' : 'V',
				((*(*s_etat_processus).l_base_pile_systeme)
				.creation_variables_partagees == d_vrai) ? 'S' : 'P')
				== d_erreur)
		{
			return;
		}

		liberation(s_etat_processus, s_objet);
	}

	// Les prochaines variables créées seront forcément du type volatile et
	// seront obligatoirement privées.

	if ((*s_etat_processus).l_base_pile_systeme == NULL)
	{
		(*s_etat_processus).erreur_systeme = d_es_pile_vide;
		return;
	}

	(*(*s_etat_processus).l_base_pile_systeme).creation_variables_statiques
			= d_faux;
	(*(*s_etat_processus).l_base_pile_systeme).creation_variables_partagees
			= d_faux;

	for(i = 0; i < nombre_variables; i++)
	{
		if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
				&s_objet) == d_erreur)
		{
			(*s_etat_processus).erreur_execution = d_ex_manque_argument;
			return;
		}

		liberation(s_etat_processus, s_objet);
	}

	(*s_etat_processus).test_instruction = test_instruction;
	(*s_etat_processus).instruction_valide = instruction_valide;

	/*
	 * Traitement le cas échéant de l'expression algébrique
	 */

	if (presence_expression_algebrique == d_vrai)
	{
		evaluation(s_etat_processus, s_expression_algebrique, 'N');

		if ((*s_etat_processus).mode_execution_programme == 'Y')
		{
			liberation(s_etat_processus, s_expression_algebrique);
		}

		(*s_etat_processus).autorisation_empilement_programme = 'Y';
		(*s_etat_processus).niveau_courant--;

		if (retrait_variables_par_niveau(s_etat_processus) == d_erreur)
		{
			return;
		}
	}

	return;
}


/*
================================================================================
  Fonction '->list'
================================================================================
  Entrées : structure processus
--------------------------------------------------------------------------------
  Sorties :
--------------------------------------------------------------------------------
  Effets de bord : néant
================================================================================
*/

void
instruction_fleche_list(struct_processus *s_etat_processus)
{
	struct_liste_chainee			*l_element_courant;

	struct_objet					*s_objet;

	integer8						i;
	integer8						nombre_elements;

    (*s_etat_processus).erreur_execution = d_ex;

	if ((*s_etat_processus).affichage_arguments == 'Y')
	{
		printf("\n  ->LIST ");

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(création d'une liste)\n\n");
		}
		else
		{
			printf("(create list)\n\n");
		}

		printf("    n: %s, %s, %s, %s, %s, %s,\n"
				"       %s, %s, %s, %s, %s,\n"
				"       %s, %s, %s, %s, %s,\n"
				"       %s, %s\n",
				d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
				d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
		printf("    ...\n");
		printf("    2: %s, %s, %s, %s, %s, %s,\n"
				"       %s, %s, %s, %s, %s,\n"
				"       %s, %s, %s, %s, %s,\n"
				"       %s, %s\n",
				d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
				d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
		printf("    1: %s\n", d_INT);
		printf("->  1: %s\n", d_LST);

		return;
	}
	else if ((*s_etat_processus).test_instruction == 'Y')
	{
		(*s_etat_processus).nombre_arguments = -1;
		return;
	}

	if (test_cfsf(s_etat_processus, 31) == d_vrai)
	{
		if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
		{
			return;
		}
	}

	if ((*s_etat_processus).hauteur_pile_operationnelle == 0)
	{
		(*s_etat_processus).erreur_execution = d_ex_manque_argument;
		return;
	}

	if ((*(*(*s_etat_processus).l_base_pile).donnee).type != INT)
	{
		(*s_etat_processus).erreur_execution = d_ex_argument_invalide;
		return;
	}

	nombre_elements = (*((integer8 *) (*(*(*s_etat_processus).l_base_pile)
			.donnee).objet));

	if (nombre_elements < 0)
	{

/*
-- Opération absurde autorisée sur le calculateur HP-28S -----------------------
*/

		(*s_etat_processus).erreur_execution = d_ex_argument_invalide;
		return;
	}

	if (nombre_elements >= (*s_etat_processus).hauteur_pile_operationnelle)
	{
		(*s_etat_processus).erreur_execution = d_ex_manque_argument;
		return;
	}

	if (test_cfsf(s_etat_processus, 31) == d_vrai)
	{
		if (empilement_pile_last(s_etat_processus, nombre_elements + 1)
				== d_erreur)
		{
			return;
		}
	}

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

	liberation(s_etat_processus, s_objet);
	l_element_courant = NULL;

	for(i = 0; i < nombre_elements; i++)
	{
		if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
				&s_objet) == d_erreur)
		{
			return;
		}

		if (empilement(s_etat_processus, &l_element_courant, s_objet)
				== d_erreur)
		{
			return;
		}
	}

	if ((s_objet = allocation(s_etat_processus, LST)) == NULL)
	{
		(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
		return;
	}

	(*s_objet).objet = (void *) l_element_courant;

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

    return;
}


/*
================================================================================
  Fonction 'for'
================================================================================
  Entrées : structure processus
--------------------------------------------------------------------------------
  Sorties :
--------------------------------------------------------------------------------
  Effets de bord : néant
================================================================================
*/

void
instruction_for(struct_processus *s_etat_processus)
{
	struct_objet						*s_objet_1;
	struct_objet						*s_objet_2;
	struct_objet						*s_objet_3;

	struct_variable						s_variable;

	unsigned char						instruction_valide;
	unsigned char						*tampon;
	unsigned char						test_instruction;

    (*s_etat_processus).erreur_execution = d_ex;

	if ((*s_etat_processus).affichage_arguments == 'Y')
	{
		printf("\n  FOR ");

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(boucle définie avec compteur)\n\n");
		}
		else
		{
			printf("(define a counter-based loop)\n\n");
		}

		if ((*s_etat_processus).langue == 'F')
		{
			printf("  Utilisation :\n\n");
		}
		else
		{
			printf("  Usage:\n\n");
		}

		printf("    %s/%s %s/%s FOR (variable)\n", d_INT, d_REL,
				d_INT, d_REL);
		printf("        (expression)\n");
		printf("        [EXIT]/[CYCLE]\n");
		printf("        ...\n");
		printf("    NEXT\n\n");

		printf("    %s/%s %s/%s FOR (variable)\n", d_INT, d_REL,
				d_INT, d_REL);
		printf("        (expression)\n");
		printf("        [EXIT]/[CYCLE]\n");
		printf("        ...\n");
		printf("    %s/%s STEP\n", d_INT, d_REL);

		return;
	}
	else if ((*s_etat_processus).test_instruction == 'Y')
	{
		(*s_etat_processus).nombre_arguments = -1;
		return;
	}

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

	if (test_cfsf(s_etat_processus, 31) == d_vrai)
	{
		if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
		{
			return;
		}
	}

	if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
			&s_objet_1) == d_erreur)
	{
		(*s_etat_processus).erreur_execution = d_ex_manque_argument;
		return;
	}

	if (((*s_objet_1).type != INT) &&
			((*s_objet_1).type != REL))
	{
		liberation(s_etat_processus, s_objet_1);

		(*s_etat_processus).erreur_execution = d_ex_erreur_traitement_boucle;
		return;
	}

	if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
			&s_objet_2) == d_erreur)
	{
		liberation(s_etat_processus, s_objet_1);

		(*s_etat_processus).erreur_execution = d_ex_manque_argument;
		return;
	}

	if (((*s_objet_2).type != INT) && ((*s_objet_2).type != REL))
	{
		liberation(s_etat_processus, s_objet_1);
		liberation(s_etat_processus, s_objet_2);

		(*s_etat_processus).erreur_execution = d_ex_erreur_traitement_boucle;
		return;
	}

	empilement_pile_systeme(s_etat_processus);

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

	if ((*s_etat_processus).mode_execution_programme == 'Y')
	{
		tampon = (*s_etat_processus).instruction_courante;
		test_instruction = (*s_etat_processus).test_instruction;
		instruction_valide = (*s_etat_processus).instruction_valide;
		(*s_etat_processus).test_instruction = 'Y';

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

		analyse(s_etat_processus, NULL);

		if ((*s_etat_processus).instruction_valide == 'Y')
		{
			liberation(s_etat_processus, s_objet_1);
			liberation(s_etat_processus, s_objet_2);

			free((*s_etat_processus).instruction_courante);
			(*s_etat_processus).instruction_courante = tampon;
			(*s_etat_processus).instruction_valide = instruction_valide;
			(*s_etat_processus).test_instruction = test_instruction;

			depilement_pile_systeme(s_etat_processus);

			(*s_etat_processus).erreur_execution = d_ex_nom_reserve;
			return;
		}

		(*s_etat_processus).type_en_cours = NON;
		recherche_type(s_etat_processus);

		free((*s_etat_processus).instruction_courante);
		(*s_etat_processus).instruction_courante = tampon;
		(*s_etat_processus).instruction_valide = instruction_valide;
		(*s_etat_processus).test_instruction = test_instruction;

		if ((*s_etat_processus).erreur_execution != d_ex)
		{
			liberation(s_etat_processus, s_objet_1);
			liberation(s_etat_processus, s_objet_2);

			depilement_pile_systeme(s_etat_processus);
			return;
		}

		if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
				&s_objet_3) == d_erreur)
		{
			liberation(s_etat_processus, s_objet_1);
			liberation(s_etat_processus, s_objet_2);

			depilement_pile_systeme(s_etat_processus);

			(*s_etat_processus).erreur_execution = d_ex_manque_argument;
			return;
		}

		(*(*s_etat_processus).l_base_pile_systeme)
				.origine_routine_evaluation = 'N';
	}
	else
	{
		if ((*s_etat_processus).expression_courante == NULL)
		{
			depilement_pile_systeme(s_etat_processus);
			(*s_etat_processus).erreur_execution = d_ex_manque_argument;
			return;
		}

		(*s_etat_processus).expression_courante = (*(*s_etat_processus)
				.expression_courante).suivant;

		if ((s_objet_3 = copie_objet(s_etat_processus,
				(*(*s_etat_processus).expression_courante)
				.donnee, 'P')) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		(*(*s_etat_processus).l_base_pile_systeme)
				.origine_routine_evaluation = 'Y';
	}

	if ((*s_objet_3).type != NOM)
	{
		liberation(s_etat_processus, s_objet_1);
		liberation(s_etat_processus, s_objet_2);

		depilement_pile_systeme(s_etat_processus);

		(*s_etat_processus).erreur_execution = d_ex_erreur_traitement_boucle;
		return;
	}
	else if ((*((struct_nom *) (*s_objet_3).objet)).symbole == d_vrai)
	{
		liberation(s_etat_processus, s_objet_1);
		liberation(s_etat_processus, s_objet_2);

		depilement_pile_systeme(s_etat_processus);

		(*s_etat_processus).erreur_execution = d_ex_erreur_traitement_boucle;
		return;
	}

	(*s_etat_processus).niveau_courant++;

	if ((s_variable.nom = malloc((strlen(
			(*((struct_nom *) (*s_objet_3).objet)).nom) + 1) *
			sizeof(unsigned char))) == NULL)
	{
		(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
		return;
	}

	strcpy(s_variable.nom, (*((struct_nom *) (*s_objet_3).objet)).nom);
	s_variable.niveau = (*s_etat_processus).niveau_courant;
	s_variable.objet = s_objet_2;

	if (creation_variable(s_etat_processus, &s_variable, 'V', 'P') == d_erreur)
	{
		return;
	}

	liberation(s_etat_processus, s_objet_3);

	(*(*s_etat_processus).l_base_pile_systeme).limite_indice_boucle = s_objet_1;

	if ((*s_etat_processus).mode_execution_programme == 'Y')
	{
		(*(*s_etat_processus).l_base_pile_systeme).adresse_retour =
				(*s_etat_processus).position_courante;
	}
	else
	{
		(*(*s_etat_processus).l_base_pile_systeme).pointeur_objet_retour =
				(*s_etat_processus).expression_courante;
	}

	(*(*s_etat_processus).l_base_pile_systeme).type_cloture = 'F';

	if (((*(*s_etat_processus).l_base_pile_systeme).nom_variable =
			malloc((strlen(s_variable.nom) + 1) *
			sizeof(unsigned char))) == NULL)
	{
		(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
		return;
	}

	strcpy((*(*s_etat_processus).l_base_pile_systeme).nom_variable,
			s_variable.nom);

	return;
}


/*
================================================================================
  Fonction 'fc?'
================================================================================
  Entrées : structure processus
--------------------------------------------------------------------------------
  Sorties :
--------------------------------------------------------------------------------
  Effets de bord : néant
================================================================================
*/

void
instruction_fc_test(struct_processus *s_etat_processus)
{
	struct_objet				*s_objet_argument;
	struct_objet				*s_objet_resultat;

    (*s_etat_processus).erreur_execution = d_ex;

	if ((*s_etat_processus).affichage_arguments == 'Y')
	{
		printf("\n  FC? ");

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(teste si un drapeau est désarmé)\n\n");
		}
		else
		{
			printf("(test if flag is clear)\n\n");
		}

		printf("    1: %s\n", d_INT);
		printf("->  1: %s\n", d_INT);

		return;
	}
	else if ((*s_etat_processus).test_instruction == 'Y')
	{
		(*s_etat_processus).nombre_arguments = -1;
		return;
	}
	
	if (test_cfsf(s_etat_processus, 31) == d_vrai)
	{
		if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
		{
			return;
		}
	}

	if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
			&s_objet_argument) == d_erreur)
	{
		(*s_etat_processus).erreur_execution = d_ex_manque_argument;
		return;
	}

	if ((*s_objet_argument).type == INT)
	{
		if (((*((integer8 *) (*s_objet_argument).objet)) < 1) ||
				((*((integer8 *) (*s_objet_argument).objet)) > 64))
		{
			liberation(s_etat_processus, s_objet_argument);

			(*s_etat_processus).erreur_execution = d_ex_drapeau_inexistant;
			return;
		}

		if ((s_objet_resultat = allocation(s_etat_processus, INT))
				== NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		if (test_cfsf(s_etat_processus, (unsigned char) (*((integer8 *)
				(*s_objet_argument).objet))) == d_vrai)
		{
			(*((integer8 *) (*s_objet_resultat).objet)) = 0;
		}
		else
		{
			(*((integer8 *) (*s_objet_resultat).objet)) = -1;
		}
	}
	else
	{
		liberation(s_etat_processus, s_objet_argument);

		(*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
		return;
	}

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

	liberation(s_etat_processus, s_objet_argument);

	return;
}


/*
================================================================================
  Fonction 'fs?'
================================================================================
  Entrées : structure processus
--------------------------------------------------------------------------------
  Sorties :
--------------------------------------------------------------------------------
  Effets de bord : néant
================================================================================
*/

void
instruction_fs_test(struct_processus *s_etat_processus)
{
	struct_objet				*s_objet_argument;
	struct_objet				*s_objet_resultat;

    (*s_etat_processus).erreur_execution = d_ex;

	if ((*s_etat_processus).affichage_arguments == 'Y')
	{
		printf("\n  FS? ");

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(teste si un drapeau est armé)\n\n");
		}
		else
		{
			printf("(test if flag is set)\n\n");
		}

		printf("    1: %s\n", d_INT);
		printf("->  1: %s\n", d_INT);

		return;
	}
	else if ((*s_etat_processus).test_instruction == 'Y')
	{
		(*s_etat_processus).nombre_arguments = -1;
		return;
	}
	
	if (test_cfsf(s_etat_processus, 31) == d_vrai)
	{
		if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
		{
			return;
		}
	}

	if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
			&s_objet_argument) == d_erreur)
	{
		(*s_etat_processus).erreur_execution = d_ex_manque_argument;
		return;
	}

	if ((*s_objet_argument).type == INT)
	{
		if (((*((integer8 *) (*s_objet_argument).objet)) < 1) ||
				((*((integer8 *) (*s_objet_argument).objet)) > 64))
		{
			liberation(s_etat_processus, s_objet_argument);

			(*s_etat_processus).erreur_execution = d_ex_drapeau_inexistant;
			return;
		}

		if ((s_objet_resultat = allocation(s_etat_processus, INT))
				== NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		if (test_cfsf(s_etat_processus, (unsigned char) (*((integer8 *)
				(*s_objet_argument).objet))) == d_vrai)
		{
			(*((integer8 *) (*s_objet_resultat).objet)) = -1;
		}
		else
		{
			(*((integer8 *) (*s_objet_resultat).objet)) = 0;
		}
	}
	else
	{
		liberation(s_etat_processus, s_objet_argument);

		(*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
		return;
	}

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

	liberation(s_etat_processus, s_objet_argument);

	return;
}


/*
================================================================================
  Fonction 'fs?s'
================================================================================
  Entrées : structure processus
--------------------------------------------------------------------------------
  Sorties :
--------------------------------------------------------------------------------
  Effets de bord : néant
================================================================================
*/

void
instruction_fs_test_s(struct_processus *s_etat_processus)
{
    (*s_etat_processus).erreur_execution = d_ex;

	if ((*s_etat_processus).affichage_arguments == 'Y')
	{
		printf("\n  FS?S ");

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(teste si un drapeau est armé et arme le drapeau)\n\n");
		}
		else
		{
			printf("(test if flag is set and set flag)\n\n");
		}

		printf("    1: %s\n", d_INT);
		printf("->  1: %s\n", d_INT);

		return;
	}
	else if ((*s_etat_processus).test_instruction == 'Y')
	{
		(*s_etat_processus).nombre_arguments = -1;
		return;
	}
	
	instruction_dup(s_etat_processus);

	if (((*s_etat_processus).erreur_systeme != d_es) ||
			((*s_etat_processus).erreur_execution != d_ex))
	{
		return;
	}

	instruction_fs_test(s_etat_processus);

	if (((*s_etat_processus).erreur_systeme != d_es) ||
			((*s_etat_processus).erreur_execution != d_ex))
	{
		return;
	}

	if (((*s_etat_processus).erreur_systeme != d_es) ||
			((*s_etat_processus).erreur_execution != d_ex))
	{
		return;
	}

	instruction_swap(s_etat_processus);

	if (((*s_etat_processus).erreur_systeme != d_es) ||
			((*s_etat_processus).erreur_execution != d_ex))
	{
		return;
	}

	instruction_sf(s_etat_processus);

	return;
}


/*
================================================================================
  Fonction 'fs?c'
================================================================================
  Entrées : structure processus
--------------------------------------------------------------------------------
  Sorties :
--------------------------------------------------------------------------------
  Effets de bord : néant
================================================================================
*/

void
instruction_fs_test_c(struct_processus *s_etat_processus)
{
    (*s_etat_processus).erreur_execution = d_ex;

	if ((*s_etat_processus).affichage_arguments == 'Y')
	{
		printf("\n  FS?C ");

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(teste si un drapeau est armé et désarme le drapeau)\n\n");
		}
		else
		{
			printf("(test if flag is set and clear flag)\n\n");
		}

		printf("    1: %s\n", d_INT);
		printf("->  1: %s\n", d_INT);

		return;
	}
	else if ((*s_etat_processus).test_instruction == 'Y')
	{
		(*s_etat_processus).nombre_arguments = -1;
		return;
	}
	
	instruction_dup(s_etat_processus);

	if (((*s_etat_processus).erreur_systeme != d_es) ||
			((*s_etat_processus).erreur_execution != d_ex))
	{
		return;
	}

	instruction_fs_test(s_etat_processus);

	if (((*s_etat_processus).erreur_systeme != d_es) ||
			((*s_etat_processus).erreur_execution != d_ex))
	{
		return;
	}

	if (((*s_etat_processus).erreur_systeme != d_es) ||
			((*s_etat_processus).erreur_execution != d_ex))
	{
		return;
	}

	instruction_swap(s_etat_processus);

	if (((*s_etat_processus).erreur_systeme != d_es) ||
			((*s_etat_processus).erreur_execution != d_ex))
	{
		return;
	}

	instruction_cf(s_etat_processus);

	return;
}


/*
================================================================================
  Fonction 'fc?s'
================================================================================
  Entrées : structure processus
--------------------------------------------------------------------------------
  Sorties :
--------------------------------------------------------------------------------
  Effets de bord : néant
================================================================================
*/

void
instruction_fc_test_s(struct_processus *s_etat_processus)
{
    (*s_etat_processus).erreur_execution = d_ex;

	if ((*s_etat_processus).affichage_arguments == 'Y')
	{
		printf("\n  FC?S ");

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(teste si un drapeau est désarmé et arme le drapeau)\n\n");
		}
		else
		{
			printf("(test if flag is clear and set flag)\n\n");
		}

		printf("    1: %s\n", d_INT);
		printf("->  1: %s\n", d_INT);

		return;
	}
	else if ((*s_etat_processus).test_instruction == 'Y')
	{
		(*s_etat_processus).nombre_arguments = -1;
		return;
	}
	
	instruction_dup(s_etat_processus);

	if (((*s_etat_processus).erreur_systeme != d_es) ||
			((*s_etat_processus).erreur_execution != d_ex))
	{
		return;
	}

	instruction_fc_test(s_etat_processus);

	if (((*s_etat_processus).erreur_systeme != d_es) ||
			((*s_etat_processus).erreur_execution != d_ex))
	{
		return;
	}

	if (((*s_etat_processus).erreur_systeme != d_es) ||
			((*s_etat_processus).erreur_execution != d_ex))
	{
		return;
	}

	instruction_swap(s_etat_processus);

	if (((*s_etat_processus).erreur_systeme != d_es) ||
			((*s_etat_processus).erreur_execution != d_ex))
	{
		return;
	}

	instruction_sf(s_etat_processus);

	return;
}


/*
================================================================================
  Fonction 'fc?c'
================================================================================
  Entrées : structure processus
--------------------------------------------------------------------------------
  Sorties :
--------------------------------------------------------------------------------
  Effets de bord : néant
================================================================================
*/

void
instruction_fc_test_c(struct_processus *s_etat_processus)
{
    (*s_etat_processus).erreur_execution = d_ex;

	if ((*s_etat_processus).affichage_arguments == 'Y')
	{
		printf("\n  FC?C ");

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(teste si un drapeau est désarmé et désarme le drapeau)"
					"\n\n");
		}
		else
		{
			printf("(test if flag is clear and clear flag)\n\n");
		}

		printf("    1: %s\n", d_INT);
		printf("->  1: %s\n", d_INT);

		return;
	}
	else if ((*s_etat_processus).test_instruction == 'Y')
	{
		(*s_etat_processus).nombre_arguments = -1;
		return;
	}
	
	instruction_dup(s_etat_processus);

	if (((*s_etat_processus).erreur_systeme != d_es) ||
			((*s_etat_processus).erreur_execution != d_ex))
	{
		return;
	}

	instruction_fc_test(s_etat_processus);

	if (((*s_etat_processus).erreur_systeme != d_es) ||
			((*s_etat_processus).erreur_execution != d_ex))
	{
		return;
	}

	if (((*s_etat_processus).erreur_systeme != d_es) ||
			((*s_etat_processus).erreur_execution != d_ex))
	{
		return;
	}

	instruction_swap(s_etat_processus);

	if (((*s_etat_processus).erreur_systeme != d_es) ||
			((*s_etat_processus).erreur_execution != d_ex))
	{
		return;
	}

	instruction_cf(s_etat_processus);

	return;
}


/*
================================================================================
  Fonction 'fact'
================================================================================
  Entrées :
--------------------------------------------------------------------------------
  Sorties :
--------------------------------------------------------------------------------
  Effets de bord : néant
================================================================================
*/

void
instruction_fact(struct_processus *s_etat_processus)
{
	logical1							depassement;

	real8								produit;

	integer8							i;
	integer8							ifact;
	integer8							tampon;

	struct_liste_chainee				*l_element_courant;
	struct_liste_chainee				*l_element_precedent;

	struct_objet						*s_copie_argument;
	struct_objet						*s_objet_argument;
	struct_objet						*s_objet_resultat;

	(*s_etat_processus).erreur_execution = d_ex;

	if ((*s_etat_processus).affichage_arguments == 'Y')
	{
		printf("\n  FACT ");

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(factorielle)\n\n");
		}
		else
		{
			printf("(factorial)\n\n");
		}

		printf("    1: %s\n", d_INT);
		printf("->  1: %s, %s\n\n", d_INT, d_REL);

		printf("    1: %s, %s\n", d_NOM, d_ALG);
		printf("->  1: %s\n\n", d_ALG);

		printf("    1: %s\n", d_RPN);
		printf("->  1: %s\n", d_RPN);

		return;
	}
	else if ((*s_etat_processus).test_instruction == 'Y')
	{
		(*s_etat_processus).nombre_arguments = 1;
		return;
	}
	
	if (test_cfsf(s_etat_processus, 31) == d_vrai)
	{
		if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
		{
			return;
		}
	}

	if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
			&s_objet_argument) == d_erreur)
	{
		(*s_etat_processus).erreur_execution = d_ex_manque_argument;
		return;
	}

/*
--------------------------------------------------------------------------------
  Calcul de la factorielle d'un entier (résultat réel)
--------------------------------------------------------------------------------
*/

	if ((*s_objet_argument).type == INT)
	{
		if ((*((integer8 *) (*s_objet_argument).objet)) < 0)
		{
			if (test_cfsf(s_etat_processus, 59) == d_vrai)
			{
				liberation(s_etat_processus, s_objet_argument);

				(*s_etat_processus).exception = d_ep_overflow;
				return;
			}
			else
			{
				if ((s_objet_resultat = allocation(s_etat_processus, REL))
						== NULL)
				{
					(*s_etat_processus).erreur_systeme =
							d_es_allocation_memoire;
					return;
				}

				(*((real8 *) (*s_objet_resultat).objet)) =
						((double) 1) / ((double) 0);
			}
		}
		else
		{
			ifact = 1;
			depassement = d_faux;

			for (i = 1; i <= (*((integer8 *) (*s_objet_argument).objet)); i++)
			{
				if (depassement_multiplication(&ifact, &i, &tampon) == d_erreur)
				{
					depassement = d_vrai;
					break;
				}

				ifact = tampon;
			}

			if (depassement == d_faux)
			{
				if ((s_objet_resultat = allocation(s_etat_processus, INT))
						== NULL)
				{
					(*s_etat_processus).erreur_systeme =
							d_es_allocation_memoire;
					return;
				}

				(*((integer8 *) (*s_objet_resultat).objet)) = ifact;
			}
			else
			{
				produit = 1;

				for (i = 1; i <= (*((integer8 *) (*s_objet_argument).objet));
						i++)
				{
					produit *= (real8) i;
				}

				if ((s_objet_resultat = allocation(s_etat_processus, REL))
						== NULL)
				{
					(*s_etat_processus).erreur_systeme =
							d_es_allocation_memoire;
					return;
				}

				(*((real8 *) (*s_objet_resultat).objet)) = produit;
			}
		}
	}

/*
--------------------------------------------------------------------------------
  Factorielle d'un nom
--------------------------------------------------------------------------------
*/

	else if ((*s_objet_argument).type == NOM)
	{
		if ((s_objet_resultat = allocation(s_etat_processus, ALG))
				== NULL)
		{
			(*s_etat_processus).erreur_systeme =
					d_es_allocation_memoire;
			return;
		}

		if (((*s_objet_resultat).objet =
				allocation_maillon(s_etat_processus)) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		l_element_courant = (*s_objet_resultat).objet;

		if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
				== NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		(*((struct_fonction *) (*(*l_element_courant).donnee).objet))
				.nombre_arguments = 0;
		(*((struct_fonction *) (*(*l_element_courant).donnee).objet))
				.fonction = instruction_vers_niveau_superieur;

		if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
				.nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
				.nom_fonction, "<<");

		if (((*l_element_courant).suivant =
				allocation_maillon(s_etat_processus)) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		l_element_courant = (*l_element_courant).suivant;
		(*l_element_courant).donnee = s_objet_argument;

		if (((*l_element_courant).suivant =
				allocation_maillon(s_etat_processus)) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		l_element_courant = (*l_element_courant).suivant;

		if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
				== NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		(*((struct_fonction *) (*(*l_element_courant).donnee).objet))
				.nombre_arguments = 1;
		(*((struct_fonction *) (*(*l_element_courant).donnee).objet))
				.fonction = instruction_fact;

		if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
				.nom_fonction = malloc(5 * sizeof(unsigned char))) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
				.nom_fonction, "FACT");

		if (((*l_element_courant).suivant =
				allocation_maillon(s_etat_processus)) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		l_element_courant = (*l_element_courant).suivant;

		if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
				== NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		(*((struct_fonction *) (*(*l_element_courant).donnee).objet))
				.nombre_arguments = 0;
		(*((struct_fonction *) (*(*l_element_courant).donnee).objet))
				.fonction = instruction_vers_niveau_inferieur;

		if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
				.nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
				.nom_fonction, ">>");

		(*l_element_courant).suivant = NULL;
		s_objet_argument = NULL;
	}

/*
--------------------------------------------------------------------------------
  Factorielle d'une expression
--------------------------------------------------------------------------------
*/

	else if (((*s_objet_argument).type == ALG) ||
			((*s_objet_argument).type == RPN))
	{
		if ((s_copie_argument = copie_objet(s_etat_processus,
				s_objet_argument, 'N')) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		l_element_courant = (struct_liste_chainee *)
				(*s_copie_argument).objet;
		l_element_precedent = l_element_courant;

		while((*l_element_courant).suivant != NULL)
		{
			l_element_precedent = l_element_courant;
			l_element_courant = (*l_element_courant).suivant;
		}

		if (((*l_element_precedent).suivant =
				allocation_maillon(s_etat_processus)) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		if (((*(*l_element_precedent).suivant).donnee =
				allocation(s_etat_processus, FCT)) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		(*((struct_fonction *) (*(*(*l_element_precedent).suivant)
				.donnee).objet)).nombre_arguments = 1;
		(*((struct_fonction *) (*(*(*l_element_precedent).suivant)
				.donnee).objet)).fonction = instruction_fact;

		if (((*((struct_fonction *) (*(*(*l_element_precedent)
				.suivant).donnee).objet)).nom_fonction =
				malloc(5 * sizeof(unsigned char))) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
				.suivant).donnee).objet)).nom_fonction, "FACT");

		(*(*l_element_precedent).suivant).suivant = l_element_courant;

		s_objet_resultat = s_copie_argument;
	}

/*
--------------------------------------------------------------------------------
  Factorielle impossible à réaliser
--------------------------------------------------------------------------------
*/

	else
	{
		liberation(s_etat_processus, s_objet_argument);

		(*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
		return;
	}

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

	liberation(s_etat_processus, s_objet_argument);

	return;
}


/*
================================================================================
  Fonction 'floor'
================================================================================
  Entrées :
--------------------------------------------------------------------------------
  Sorties :
--------------------------------------------------------------------------------
  Effets de bord : néant
================================================================================
*/

void
instruction_floor(struct_processus *s_etat_processus)
{
	struct_liste_chainee				*l_element_courant;
	struct_liste_chainee				*l_element_precedent;

	struct_objet						*s_copie_argument;
	struct_objet						*s_objet_argument;
	struct_objet						*s_objet_resultat;

	(*s_etat_processus).erreur_execution = d_ex;

	if ((*s_etat_processus).affichage_arguments == 'Y')
	{
		printf("\n  FLOOR ");

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(valeur plancher)\n\n");
		}
		else
		{
			printf("(floor value)\n\n");
		}

		printf("    1: %s\n", d_INT);
		printf("->  1: %s\n\n", d_INT);

		printf("    1: %s\n", d_REL);
		printf("->  1: %s, %s\n\n", d_INT, d_REL);

		printf("    1: %s, %s\n", d_NOM, d_ALG);
		printf("->  1: %s\n\n", d_ALG);

		printf("    1: %s\n", d_RPN);
		printf("->  1: %s\n", d_RPN);

		return;
	}
	else if ((*s_etat_processus).test_instruction == 'Y')
	{
		(*s_etat_processus).nombre_arguments = 1;
		return;
	}
	
	if (test_cfsf(s_etat_processus, 31) == d_vrai)
	{
		if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
		{
			return;
		}
	}

	if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
			&s_objet_argument) == d_erreur)
	{
		(*s_etat_processus).erreur_execution = d_ex_manque_argument;
		return;
	}

/*
--------------------------------------------------------------------------------
  Plancher d'un entier
--------------------------------------------------------------------------------
*/

	if ((*s_objet_argument).type == INT)
	{
		s_objet_resultat = s_objet_argument;
		s_objet_argument = NULL;
	}

/*
--------------------------------------------------------------------------------
  Plancher d'un réel
--------------------------------------------------------------------------------
*/

	else if ((*s_objet_argument).type == REL)
	{
		if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		(*((integer8 *) (*s_objet_resultat).objet)) = (integer8)
				floor((*((real8 *) (*s_objet_argument).objet)));

		if (!((((*((integer8 *) (*s_objet_resultat).objet)) <
				(*((real8 *) (*s_objet_argument).objet))) && (((*((integer8 *)
				(*s_objet_resultat).objet)) + 1) > (*((real8 *)
				(*s_objet_argument).objet))))))
		{
			free((*s_objet_resultat).objet);

			if (((*s_objet_resultat).objet = malloc(sizeof(real8))) == NULL)
			{
				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
				return;
			}

			(*s_objet_resultat).type = REL;
			(*((real8 *) (*s_objet_resultat).objet)) =
					ceil((*((real8 *) (*s_objet_argument).objet)));
		}
	}

/*
--------------------------------------------------------------------------------
  Plancher d'un nom
--------------------------------------------------------------------------------
*/

	else if ((*s_objet_argument).type == NOM)
	{
		if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		if (((*s_objet_resultat).objet =
				allocation_maillon(s_etat_processus)) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		l_element_courant = (*s_objet_resultat).objet;

		if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
				== NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		(*((struct_fonction *) (*(*l_element_courant).donnee).objet))
				.nombre_arguments = 0;
		(*((struct_fonction *) (*(*l_element_courant).donnee).objet))
				.fonction = instruction_vers_niveau_superieur;

		if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
				.nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
				.nom_fonction, "<<");

		if (((*l_element_courant).suivant =
				allocation_maillon(s_etat_processus)) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		l_element_courant = (*l_element_courant).suivant;
		(*l_element_courant).donnee = s_objet_argument;

		if (((*l_element_courant).suivant =
				allocation_maillon(s_etat_processus)) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		l_element_courant = (*l_element_courant).suivant;

		if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
				== NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		(*((struct_fonction *) (*(*l_element_courant).donnee).objet))
				.nombre_arguments = 1;
		(*((struct_fonction *) (*(*l_element_courant).donnee).objet))
				.fonction = instruction_floor;

		if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
				.nom_fonction = malloc(6 * sizeof(unsigned char))) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
				.nom_fonction, "FLOOR");

		if (((*l_element_courant).suivant =
				allocation_maillon(s_etat_processus)) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		l_element_courant = (*l_element_courant).suivant;

		if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
				== NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		(*((struct_fonction *) (*(*l_element_courant).donnee).objet))
				.nombre_arguments = 0;
		(*((struct_fonction *) (*(*l_element_courant).donnee).objet))
				.fonction = instruction_vers_niveau_inferieur;

		if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
				.nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
				.nom_fonction, ">>");

		(*l_element_courant).suivant = NULL;
		s_objet_argument = NULL;
	}

/*
--------------------------------------------------------------------------------
  Plancher d'une expression
--------------------------------------------------------------------------------
*/

	else if (((*s_objet_argument).type == ALG) ||
			((*s_objet_argument).type == RPN))
	{
		if ((s_copie_argument = copie_objet(s_etat_processus,
				s_objet_argument, 'N')) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		l_element_courant = (struct_liste_chainee *)
				(*s_copie_argument).objet;
		l_element_precedent = l_element_courant;

		while((*l_element_courant).suivant != NULL)
		{
			l_element_precedent = l_element_courant;
			l_element_courant = (*l_element_courant).suivant;
		}

		if (((*l_element_precedent).suivant =
				allocation_maillon(s_etat_processus)) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		if (((*(*l_element_precedent).suivant).donnee =
				allocation(s_etat_processus, FCT)) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		(*((struct_fonction *) (*(*(*l_element_precedent).suivant)
				.donnee).objet)).nombre_arguments = 1;
		(*((struct_fonction *) (*(*(*l_element_precedent).suivant)
				.donnee).objet)).fonction = instruction_floor;

		if (((*((struct_fonction *) (*(*(*l_element_precedent)
				.suivant).donnee).objet)).nom_fonction =
				malloc(6 * sizeof(unsigned char))) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
				.suivant).donnee).objet)).nom_fonction, "FLOOR");

		(*(*l_element_precedent).suivant).suivant = l_element_courant;

		s_objet_resultat = s_copie_argument;
	}

/*
--------------------------------------------------------------------------------
  Fonction floor impossible à réaliser
--------------------------------------------------------------------------------
*/

	else
	{
		liberation(s_etat_processus, s_objet_argument);

		(*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
		return;
	}

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

	liberation(s_etat_processus, s_objet_argument);

	return;
}


/*
================================================================================
  Fonction 'fp'
================================================================================
  Entrées :
--------------------------------------------------------------------------------
  Sorties :
--------------------------------------------------------------------------------
  Effets de bord : néant
================================================================================
*/

void
instruction_fp(struct_processus *s_etat_processus)
{
	struct_liste_chainee				*l_element_courant;
	struct_liste_chainee				*l_element_precedent;

	struct_objet						*s_copie_argument;
	struct_objet						*s_objet_argument;
	struct_objet						*s_objet_resultat;

	(*s_etat_processus).erreur_execution = d_ex;

	if ((*s_etat_processus).affichage_arguments == 'Y')
	{
		printf("\n  FP ");

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(part fractionnaire)\n\n");
		}
		else
		{
			printf("(fractional part)\n\n");
		}

		printf("    1: %s, %s\n", d_INT, d_REL);
		printf("->  1: %s\n\n", d_REL);

		printf("    1: %s, %s\n", d_NOM, d_ALG);
		printf("->  1: %s\n\n", d_ALG);

		printf("    1: %s\n", d_RPN);
		printf("->  1: %s\n", d_RPN);

		return;
	}
	else if ((*s_etat_processus).test_instruction == 'Y')
	{
		(*s_etat_processus).nombre_arguments = 1;
		return;
	}
	
	if (test_cfsf(s_etat_processus, 31) == d_vrai)
	{
		if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
		{
			return;
		}
	}

	if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
			&s_objet_argument) == d_erreur)
	{
		(*s_etat_processus).erreur_execution = d_ex_manque_argument;
		return;
	}

/*
--------------------------------------------------------------------------------
  fp d'un entier
--------------------------------------------------------------------------------
*/

	if ((*s_objet_argument).type == INT)
	{
		if ((s_objet_resultat = allocation(s_etat_processus, REL))
				== NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		(*((real8 *) (*s_objet_resultat).objet)) = 0;
	}

/*
--------------------------------------------------------------------------------
  fp d'un réel
--------------------------------------------------------------------------------
*/

	else if ((*s_objet_argument).type == REL)
	{
		if ((s_objet_resultat = allocation(s_etat_processus, REL))
				== NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		if ((*((real8 *) (*s_objet_argument).objet)) > 0)
		{
			(*((real8 *) (*s_objet_resultat).objet)) =
					(*((real8 *) (*s_objet_argument).objet)) -
					floor((*((real8 *) (*s_objet_argument).objet)));
		}
		else
		{
			(*((real8 *) (*s_objet_resultat).objet)) =
					(*((real8 *) (*s_objet_argument).objet)) -
					ceil((*((real8 *) (*s_objet_argument).objet)));
		}
	}

/*
--------------------------------------------------------------------------------
  fp d'un nom
--------------------------------------------------------------------------------
*/

	else if ((*s_objet_argument).type == NOM)
	{
		if ((s_objet_resultat = allocation(s_etat_processus, ALG))
				== NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		if (((*s_objet_resultat).objet =
				allocation_maillon(s_etat_processus)) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		l_element_courant = (*s_objet_resultat).objet;

		if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
				== NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		(*((struct_fonction *) (*(*l_element_courant).donnee).objet))
				.nombre_arguments = 0;
		(*((struct_fonction *) (*(*l_element_courant).donnee).objet))
				.fonction = instruction_vers_niveau_superieur;

		if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
				.nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
				.nom_fonction, "<<");

		if (((*l_element_courant).suivant =
				allocation_maillon(s_etat_processus)) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		l_element_courant = (*l_element_courant).suivant;
		(*l_element_courant).donnee = s_objet_argument;

		if (((*l_element_courant).suivant =
				allocation_maillon(s_etat_processus)) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		l_element_courant = (*l_element_courant).suivant;

		if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
				== NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		(*((struct_fonction *) (*(*l_element_courant).donnee).objet))
				.nombre_arguments = 1;
		(*((struct_fonction *) (*(*l_element_courant).donnee).objet))
				.fonction = instruction_fp;

		if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
				.nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
				.nom_fonction, "FP");

		if (((*l_element_courant).suivant =
				allocation_maillon(s_etat_processus)) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		l_element_courant = (*l_element_courant).suivant;

		if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
				== NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		(*((struct_fonction *) (*(*l_element_courant).donnee).objet))
				.nombre_arguments = 0;
		(*((struct_fonction *) (*(*l_element_courant).donnee).objet))
				.fonction = instruction_vers_niveau_inferieur;

		if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
				.nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
				.nom_fonction, ">>");

		(*l_element_courant).suivant = NULL;
		s_objet_argument = NULL;
	}

/*
--------------------------------------------------------------------------------
  fp d'une expression
--------------------------------------------------------------------------------
*/

	else if (((*s_objet_argument).type == ALG) ||
			((*s_objet_argument).type == RPN))
	{
		if ((s_copie_argument = copie_objet(s_etat_processus,
				s_objet_argument, 'N')) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		l_element_courant = (struct_liste_chainee *)
				(*s_copie_argument).objet;
		l_element_precedent = l_element_courant;

		while((*l_element_courant).suivant != NULL)
		{
			l_element_precedent = l_element_courant;
			l_element_courant = (*l_element_courant).suivant;
		}

		if (((*l_element_precedent).suivant =
				allocation_maillon(s_etat_processus)) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		if (((*(*l_element_precedent).suivant).donnee =
				allocation(s_etat_processus, FCT)) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		(*((struct_fonction *) (*(*(*l_element_precedent).suivant)
				.donnee).objet)).nombre_arguments = 1;
		(*((struct_fonction *) (*(*(*l_element_precedent).suivant)
				.donnee).objet)).fonction = instruction_fp;

		if (((*((struct_fonction *) (*(*(*l_element_precedent)
				.suivant).donnee).objet)).nom_fonction =
				malloc(3 * sizeof(unsigned char))) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
				.suivant).donnee).objet)).nom_fonction, "FP");

		(*(*l_element_precedent).suivant).suivant = l_element_courant;

		s_objet_resultat = s_copie_argument;
	}

/*
--------------------------------------------------------------------------------
  Fonction fp impossible à réaliser
--------------------------------------------------------------------------------
*/

	else
	{
		liberation(s_etat_processus, s_objet_argument);

		(*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
		return;
	}

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

	liberation(s_etat_processus, s_objet_argument);

	return;
}


/*
================================================================================
  Fonction 'fix'
================================================================================
  Entrées : pointeur sur une struct_processus
--------------------------------------------------------------------------------
  Sorties :
--------------------------------------------------------------------------------
  Effets de bord : néant
================================================================================
*/

void
instruction_fix(struct_processus *s_etat_processus)
{
	struct_objet						*s_objet_argument;
	struct_objet						*s_objet;

	logical1							i43;
	logical1							i44;

	unsigned char						*valeur_binaire;

	unsigned long						i;
	unsigned long						j;

	(*s_etat_processus).erreur_execution = d_ex;

	if ((*s_etat_processus).affichage_arguments == 'Y')
	{
		printf("\n  FIX ");

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(format virgule fixe)\n\n");
		}
		else
		{
			printf("(fixed point format)\n\n");
		}

		printf("    1: %s\n", d_INT);

		return;
	}
	else if ((*s_etat_processus).test_instruction == 'Y')
	{
		(*s_etat_processus).nombre_arguments = -1;
		return;
	}

	if (test_cfsf(s_etat_processus, 31) == d_vrai)
	{
		if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
		{
			return;
		}
	}

	if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
			&s_objet_argument) == d_erreur)
	{
		(*s_etat_processus).erreur_execution = d_ex_manque_argument;
		return;
	}

	if ((*s_objet_argument).type == INT)
	{
		if (((*((integer8 *) (*s_objet_argument).objet)) >= 0) &&
				((*((integer8 *) (*s_objet_argument).objet)) <= 15))
		{
			if ((s_objet = allocation(s_etat_processus, BIN)) == NULL)
			{
				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
				return;
			}

			(*((logical8 *) (*s_objet).objet)) = (logical8)
					(*((integer8 *) (*s_objet_argument).objet));

			i43 = test_cfsf(s_etat_processus, 43);
			i44 = test_cfsf(s_etat_processus, 44);

			sf(s_etat_processus, 44);
			cf(s_etat_processus, 43);

			if ((valeur_binaire = formateur(s_etat_processus, 0, s_objet))
					== NULL)
			{
				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
				return;
			}

			if (i43 == d_vrai)
			{
				sf(s_etat_processus, 43);
			}
			else
			{
				cf(s_etat_processus, 43);
			}

			if (i44 == d_vrai)
			{
				sf(s_etat_processus, 44);
			}
			else
			{
				cf(s_etat_processus, 44);
			}

			for(j = 53, i = strlen(valeur_binaire) - 2; i >= 2; i--)
			{
				if (valeur_binaire[i] == '0')
				{
					cf(s_etat_processus, (unsigned char) j++);
				}
				else
				{
					sf(s_etat_processus, (unsigned char) j++);
				}
			}

			for(; j <= 56; cf(s_etat_processus, (unsigned char) j++));

			sf(s_etat_processus, 49);
			cf(s_etat_processus, 50);

			free(valeur_binaire);
			liberation(s_etat_processus, s_objet);
		}
		else
		{
			liberation(s_etat_processus, s_objet_argument);

			(*s_etat_processus).erreur_execution = d_ex_argument_invalide;
			return;
		}
	}
	else
	{
		liberation(s_etat_processus, s_objet_argument);

		(*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
		return;
	}

	liberation(s_etat_processus, s_objet_argument);

	return;
}

// vim: ts=4