/*
================================================================================
  RPL/2 (R) version 4.1.32
  Copyright (C) 1989-2020 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 'idn'
================================================================================
  Entrées : pointeur sur une struct_processus
--------------------------------------------------------------------------------
  Sorties :
--------------------------------------------------------------------------------
  Effets de bord : néant
================================================================================
*/

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

	logical1							argument_nom;
	logical1							variable_partagee;

	integer8							i;
	integer8							j;

	(*s_etat_processus).erreur_execution = d_ex;

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

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(matrice identité)\n\n");
		}
		else
		{
			printf("(identity matrix)\n\n");
		}

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

		printf("    1: %s\n", d_NOM);
		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 == NOM)
	{
		argument_nom = d_vrai;

		if (recherche_variable(s_etat_processus, (*((struct_nom *)
				(*s_objet_argument).objet)).nom) == d_faux)
		{
			(*s_etat_processus).erreur_systeme = d_es;
			(*s_etat_processus).erreur_execution = d_ex_variable_non_definie;

			liberation(s_etat_processus, s_objet_argument);

			return;
		}

		liberation(s_etat_processus, s_objet_argument);

		if ((*(*s_etat_processus).pointeur_variable_courante)
				.variable_verrouillee == d_vrai)
		{
			(*s_etat_processus).erreur_execution = d_ex_variable_verrouillee;
			return;
		}

		s_objet_argument = (*(*s_etat_processus).pointeur_variable_courante)
				.objet;

		if (s_objet_argument == NULL)
		{
			if (recherche_variable_partagee(s_etat_processus,
					(*(*s_etat_processus).pointeur_variable_courante).nom,
					(*(*s_etat_processus).pointeur_variable_courante)
					.variable_partagee, (*(*s_etat_processus)
					.pointeur_variable_courante).origine) == NULL)
			{
				(*s_etat_processus).erreur_systeme = d_es;
				(*s_etat_processus).erreur_execution =
						d_ex_variable_non_definie;

				return;
			}

			s_objet_argument = (*(*s_etat_processus)
					.pointeur_variable_partagee_courante).objet;
			variable_partagee = d_vrai;
		}
		else
		{
			variable_partagee = d_faux;
		}
	}
	else
	{
		argument_nom = d_faux;
		variable_partagee = d_faux;
	}

/*
--------------------------------------------------------------------------------
  L'argument est la dimension de la matrice identité à créer ou une
  matrice carée dont les dimensions seront prises pour créer une matrice
  identité.
--------------------------------------------------------------------------------
*/

	if (((*s_objet_argument).type == INT) ||
			((*s_objet_argument).type == MIN) ||
			((*s_objet_argument).type == MRL) ||
			((*s_objet_argument).type == MCX))
	{
		if ((s_objet_resultat = allocation(s_etat_processus, MIN))
				== NULL)
		{
			if (variable_partagee == d_vrai)
			{
				if (pthread_mutex_unlock(&((*(*s_etat_processus)
						.pointeur_variable_partagee_courante).mutex)) != 0)
				{
					(*s_etat_processus).erreur_systeme = d_es_processus;
					return;
				}
			}

			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		if ((*s_objet_argument).type == INT)
		{
			(*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
					(*((integer8 *) (*s_objet_argument).objet));
			(*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
					(*((integer8 *) (*s_objet_argument).objet));
		}
		else
		{
			(*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
					(*((struct_matrice *) (*s_objet_argument).objet))
					.nombre_lignes;
			(*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
					(*((struct_matrice *) (*s_objet_argument).objet))
					.nombre_colonnes;

			if ((*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes
					!= (*((struct_matrice *) (*s_objet_resultat).objet))
					.nombre_colonnes)
			{
				if (variable_partagee == d_vrai)
				{
					if (pthread_mutex_unlock(&((*(*s_etat_processus)
							.pointeur_variable_partagee_courante).mutex)) != 0)
					{
						(*s_etat_processus).erreur_systeme = d_es_processus;
						return;
					}
				}

				if (argument_nom == d_faux)
				{
					liberation(s_etat_processus, s_objet_argument);
				}

				free((struct_matrice *) (*s_objet_resultat).objet);
				free(s_objet_resultat);

				(*s_etat_processus).erreur_execution =
						d_ex_dimensions_invalides;

				return;
			}
		}

		if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
				malloc(((size_t) (*((struct_matrice *) (*s_objet_resultat)
				.objet)).nombre_lignes) * sizeof(integer8 *))) == NULL)
		{
			if (variable_partagee == d_vrai)
			{
				if (pthread_mutex_unlock(&((*(*s_etat_processus)
						.pointeur_variable_partagee_courante).mutex)) != 0)
				{
					(*s_etat_processus).erreur_systeme = d_es_processus;
					return;
				}
			}

			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		for(i = 0; i < (*((struct_matrice *) (*s_objet_resultat).objet))
				.nombre_lignes; i++)
		{
			if ((((integer8 **) (*((struct_matrice *) (*s_objet_resultat)
					.objet)).tableau)[i] = malloc(((size_t)
					(*((struct_matrice *) (*s_objet_resultat).objet))
					.nombre_colonnes) * sizeof(integer8))) == NULL)
			{
				if (variable_partagee == d_vrai)
				{
					if (pthread_mutex_unlock(&((*(*s_etat_processus)
							.pointeur_variable_partagee_courante).mutex)) != 0)
					{
						(*s_etat_processus).erreur_systeme = d_es_processus;
						return;
					}
				}

				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
				return;
			}

			for(j = 0; j < (*((struct_matrice *) (*s_objet_resultat).objet))
					.nombre_colonnes; j++)
			{
				((integer8 **) (*((struct_matrice *) (*s_objet_resultat)
						.objet)).tableau)[i][j] = (i == j) ? 1 : 0;
			}
		}
	}

/*
--------------------------------------------------------------------------------
  Réalisation de la fonction IDN impossible
--------------------------------------------------------------------------------
*/

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

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

	if (argument_nom == d_faux)
	{
		if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
				s_objet_resultat) == d_erreur)
		{
			return;
		}
	}
	else
	{
		if (variable_partagee == d_vrai)
		{
			(*(*s_etat_processus).pointeur_variable_courante).objet = NULL;
			(*(*s_etat_processus).pointeur_variable_partagee_courante).objet =
					s_objet_resultat;

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

	return;
}


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

void
instruction_ifft(struct_processus *s_etat_processus)
{
	integer4					erreur;
	integer4					inverse;
	integer4					nombre_colonnes;
	integer4					nombre_lignes;

	struct_complexe16			*matrice_f77;

	struct_objet				*s_objet_argument;
	struct_objet				*s_objet_longueur_fft;
	struct_objet				*s_objet_resultat;

	logical1					presence_longueur_fft;

	integer8					i;
	integer8					j;
	integer8					k;
	integer8					longueur_fft;

	(*s_etat_processus).erreur_execution = d_ex;

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

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(transformée de Fourier inverse rapide)\n\n");
		}
		else
		{
			printf("(inverse of fast Fourier transform)\n\n");
		}

		printf("    2: %s, %s, %s\n", d_VIN, d_VRL, d_VCX);
		printf("    1: %s\n", d_INT);
		printf("->  1: %s\n\n", d_VCX);

		printf("    1: %s, %s, %s\n", d_VIN, d_VRL, d_VCX);
		printf("->  1: %s\n\n", d_VCX);

		printf("    2: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
		printf("    1: %s\n", d_INT);
		printf("->  1: %s\n\n", d_MCX);

		printf("    1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
		printf("->  1: %s\n", d_MCX);

		return;
	}
	else if ((*s_etat_processus).test_instruction == 'Y')
	{
		(*s_etat_processus).nombre_arguments = -1;
		return;
	}
	
	/*
	 * Il est possible d'imposer une longueur de FFT au premier niveau
	 * de la pile.
	 */

	if ((*s_etat_processus).l_base_pile == NULL)
	{
		(*s_etat_processus).erreur_execution = d_ex_manque_argument;
		return;
	}

	if ((*(*(*s_etat_processus).l_base_pile).donnee).type == INT)
	{
		presence_longueur_fft = d_vrai;

		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_longueur_fft) == d_erreur)
		{
			(*s_etat_processus).erreur_execution = d_ex_manque_argument;
			return;
		}

		longueur_fft = (*((integer8 *) (*s_objet_longueur_fft).objet));

		liberation(s_etat_processus, s_objet_longueur_fft);
	}
	else
	{
		presence_longueur_fft = d_faux;
		longueur_fft = 0;

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

/*
--------------------------------------------------------------------------------
  Vecteur
--------------------------------------------------------------------------------
*/

	if (((*s_objet_argument).type == VIN) ||
			((*s_objet_argument).type == VRL) ||
			((*s_objet_argument).type == VCX))
	{
		if (presence_longueur_fft == d_faux)
		{
			longueur_fft = (integer8) pow(2, ceil(log((real8)
					(*((struct_vecteur *)
					(*s_objet_argument).objet)).taille) / log((real8) 2)));

			if ((((real8) longueur_fft) / ((real8) (*((struct_vecteur *)
					(*s_objet_argument).objet)).taille)) == 2)
			{
				longueur_fft /= 2;
			}
		}

		if ((matrice_f77 = malloc(((size_t) longueur_fft) *
				sizeof(struct_complexe16))) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		if ((*s_objet_argument).type == VIN)
		{
			for(i = 0; i < (*((struct_vecteur *) (*s_objet_argument).objet))
					.taille; i++)
			{
				matrice_f77[i].partie_reelle = (real8) ((integer8 *)
						(*((struct_vecteur *) (*s_objet_argument).objet))
						.tableau)[i];
				matrice_f77[i].partie_imaginaire = (real8) 0;
			}
		}
		else if ((*s_objet_argument).type == VRL)
		{
			for(i = 0; i < (*((struct_vecteur *) (*s_objet_argument).objet))
					.taille; i++)
			{
				matrice_f77[i].partie_reelle = ((real8 *)
						(*((struct_vecteur *) (*s_objet_argument).objet))
						.tableau)[i];
				matrice_f77[i].partie_imaginaire = (real8) 0;
			}
		}
		else
		{
			for(i = 0; i < (*((struct_vecteur *) (*s_objet_argument).objet))
					.taille; i++)
			{
				matrice_f77[i].partie_reelle = ((struct_complexe16 *)
						(*((struct_vecteur *) (*s_objet_argument).objet))
						.tableau)[i].partie_reelle;
				matrice_f77[i].partie_imaginaire = ((struct_complexe16 *)
						(*((struct_vecteur *) (*s_objet_argument).objet))
						.tableau)[i].partie_imaginaire;
			}
		}

		for(; i < longueur_fft; i++)
		{
				matrice_f77[i].partie_reelle = (real8) 0;
				matrice_f77[i].partie_imaginaire = (real8) 0;
		}

		nombre_lignes = 1;
		nombre_colonnes = (integer4) longueur_fft;
		inverse = -1;

		dft(matrice_f77, &nombre_lignes, &nombre_colonnes, &inverse, &erreur);

		if (erreur != 0)
		{
			liberation(s_etat_processus, s_objet_argument);
			free(matrice_f77);

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

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

		(*((struct_vecteur *) (*s_objet_resultat).objet)).taille = longueur_fft;
		(*((struct_vecteur *) (*s_objet_resultat).objet)).tableau = matrice_f77;
	}

/*
--------------------------------------------------------------------------------
  Matrice
--------------------------------------------------------------------------------
*/

	else if (((*s_objet_argument).type == MIN) ||
			((*s_objet_argument).type == MRL) ||
			((*s_objet_argument).type == MCX))
	{
		if (presence_longueur_fft == d_faux)
		{
			longueur_fft = (integer8) pow(2, ceil(log((real8)
					(*((struct_matrice *) (*s_objet_argument).objet))
					.nombre_colonnes) / log((real8) 2)));

			if ((((real8) longueur_fft) / ((real8) (*((struct_matrice *)
					(*s_objet_argument).objet)).nombre_colonnes)) == 2)
			{
				longueur_fft /= 2;
			}
		}

		if ((matrice_f77 = malloc(((size_t) longueur_fft) *
				((size_t) (*((struct_matrice *) (*s_objet_argument).objet))
				.nombre_lignes) * sizeof(struct_complexe16))) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		if ((*s_objet_argument).type == MIN)
		{
			for(k = 0, i = 0; i < (*((struct_matrice *) (*s_objet_argument)
					.objet)).nombre_colonnes; i++)
			{
				for(j = 0; j < (*((struct_matrice *) (*s_objet_argument)
						.objet)).nombre_lignes; j++)
				{
					matrice_f77[k].partie_reelle = (real8) ((integer8 **)
							(*((struct_matrice *) (*s_objet_argument).objet))
							.tableau)[j][i];
					matrice_f77[k++].partie_imaginaire = (real8) 0;
				}
			}

			for(; k < longueur_fft * (*((struct_matrice *) (*s_objet_argument)
					.objet)).nombre_lignes; k++)
			{
				matrice_f77[k].partie_reelle = (real8) 0;
				matrice_f77[k].partie_imaginaire = (real8) 0;
			}
		}
		else if ((*s_objet_argument).type == MRL)
		{
			for(k = 0, i = 0; i < (*((struct_matrice *) (*s_objet_argument)
					.objet)).nombre_colonnes; i++)
			{
				for(j = 0; j < (*((struct_matrice *) (*s_objet_argument)
						.objet)).nombre_lignes; j++)
				{
					matrice_f77[k].partie_reelle = ((real8 **)
							(*((struct_matrice *) (*s_objet_argument).objet))
							.tableau)[j][i];
					matrice_f77[k++].partie_imaginaire = (real8) 0;
				}
			}

			for(; k < longueur_fft * (*((struct_matrice *) (*s_objet_argument)
					.objet)).nombre_lignes; k++)
			{
				matrice_f77[k].partie_reelle = (real8) 0;
				matrice_f77[k].partie_imaginaire = (real8) 0;
			}
		}
		else
		{
			for(k = 0, i = 0; i < (*((struct_matrice *) (*s_objet_argument)
					.objet)).nombre_colonnes; i++)
			{
				for(j = 0; j < (*((struct_matrice *) (*s_objet_argument)
						.objet)).nombre_lignes; j++)
				{
					matrice_f77[k].partie_reelle = ((struct_complexe16 **)
							(*((struct_matrice *) (*s_objet_argument).objet))
							.tableau)[j][i].partie_reelle;
					matrice_f77[k++].partie_imaginaire =
							((struct_complexe16 **) (*((struct_matrice *)
							(*s_objet_argument).objet)).tableau)[j][i]
							.partie_imaginaire;
				}
			}

			for(; k < longueur_fft * (*((struct_matrice *) (*s_objet_argument)
					.objet)).nombre_lignes; k++)
			{
				matrice_f77[k].partie_reelle = (real8) 0;
				matrice_f77[k].partie_imaginaire = (real8) 0;
			}
		}

		nombre_lignes = (integer4) (*((struct_matrice *)
				(*s_objet_argument).objet)).nombre_lignes;
		nombre_colonnes = (integer4) longueur_fft;
		inverse = -1;

		dft(matrice_f77, &nombre_lignes, &nombre_colonnes, &inverse, &erreur);

		if (erreur != 0)
		{
			liberation(s_etat_processus, s_objet_argument);
			free(matrice_f77);

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

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

		(*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
				(*((struct_matrice *) (*s_objet_argument).objet))
				.nombre_lignes;
		(*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
				longueur_fft;

		if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
				malloc(((size_t) (*((struct_matrice *) (*s_objet_resultat)
				.objet)).nombre_lignes) * sizeof(struct_complexe16 *))) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		for(i = 0; i < (*((struct_matrice *) (*s_objet_resultat).objet))
				.nombre_lignes; i++)
		{
			if ((((struct_complexe16 **) (*((struct_matrice *)
					(*s_objet_resultat).objet)).tableau)[i] =
					malloc(((size_t) (*((struct_matrice *)
					(*s_objet_resultat).objet)).nombre_colonnes) *
					sizeof(struct_complexe16))) == NULL)
			{
				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
				return;
			}
		}

		for(k = 0, i = 0; i < (*((struct_matrice *) (*s_objet_resultat).objet))
				.nombre_colonnes; i++)
		{
			for(j = 0; j < (*((struct_matrice *) (*s_objet_resultat).objet))
					.nombre_lignes; j++)
			{
				((struct_complexe16 **) (*((struct_matrice *)
						(*s_objet_resultat).objet)).tableau)[j][i]
						.partie_reelle = matrice_f77[k].partie_reelle;
				((struct_complexe16 **) (*((struct_matrice *)
						(*s_objet_resultat).objet)).tableau)[j][i]
						.partie_imaginaire = matrice_f77[k++].partie_imaginaire;
			}
		}

		free(matrice_f77);
	}

/*
--------------------------------------------------------------------------------
  Calcul de FFT impossible
--------------------------------------------------------------------------------
*/

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

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

	return;
}


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

void
instruction_input(struct_processus *s_etat_processus)
{
	struct_objet				*s_objet_resultat;

	unsigned char				*ptr_e;
	unsigned char				*ptr_l;
	unsigned char				*tampon;
	unsigned char				*tampon2;

	integer8					i;

	(*s_etat_processus).erreur_execution = d_ex;

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

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(attente d'une entrée)\n\n");
		}
		else
		{
			printf("(input)\n\n");
		}

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

		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_objet_resultat = allocation(s_etat_processus, CHN)) == NULL)
	{
		(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
		return;
	}

	flockfile(stdin);

	(*s_objet_resultat).objet = (void *) readline("");
	funlockfile(stdin);

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

		(*((unsigned char *) (*s_objet_resultat).objet)) =
				d_code_fin_chaine;
	}

	if ((tampon = transliteration(s_etat_processus,
			(unsigned char *) (*s_objet_resultat).objet,
			(*s_etat_processus).localisation, d_locale)) == NULL)
	{
		return;
	}

	free((unsigned char *) (*s_objet_resultat).objet);

	ptr_l = tampon;
	i = 0;

	while((*ptr_l) != d_code_fin_chaine)
	{
		if ((*ptr_l) == '\"')
		{
			i++;
		}

		ptr_l++;
	}

	if ((tampon2 = malloc((strlen(tampon) + 1 + ((size_t) i)) *
			sizeof(unsigned char))) == NULL)
	{
		(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
		return;
	}

	ptr_l = tampon;
	ptr_e = tampon2;

	while((*ptr_l) != d_code_fin_chaine)
	{
		if ((*ptr_l) == '\"')
		{
			(*ptr_e) = '\\';
			ptr_e++;
		}

		(*ptr_e) = (*ptr_l);
		ptr_e++;
		ptr_l++;
	}

	free(tampon);
	(*s_objet_resultat).objet = tampon2;

	add_history((unsigned char *) (*s_objet_resultat).objet);
	stifle_history(ds_longueur_historique);

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

	return;
}


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

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

	struct_objet					*s_objet;

	(*s_etat_processus).erreur_execution = d_ex;

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

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(indication de la variable indépendante)\n\n");
		}
		else
		{
			printf("(set independant variable)\n\n");
		}

		printf("    1: %s, %s\n", d_NOM, 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, 1) == d_erreur)
		{
			return;
		}
	}

	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_objet).type == NOM)
	{
		liberation(s_etat_processus, (*s_etat_processus).indep);
		(*s_etat_processus).indep = s_objet;
	}
	else if ((*s_objet).type == LST)
	{
		l_element_courant = (struct_liste_chainee *) (*s_objet).objet;

		if ((*(*l_element_courant).donnee).type != NOM)
		{
			liberation(s_etat_processus, s_objet);

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

		(*((struct_nom *) (*(*l_element_courant).donnee).objet)).symbole =
				d_vrai;

		l_element_courant = (*l_element_courant).suivant;

		if (!(((*(*l_element_courant).donnee).type == INT) ||
				((*(*l_element_courant).donnee).type == REL) ||
				((*(*l_element_courant).donnee).type == NOM) ||
				((*(*l_element_courant).donnee).type == ALG) ||
				((*(*l_element_courant).donnee).type == RPN)))
		{
			liberation(s_etat_processus, s_objet);

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

		l_element_courant = (*l_element_courant).suivant;

		if (!(((*(*l_element_courant).donnee).type == INT) ||
				((*(*l_element_courant).donnee).type == REL) ||
				((*(*l_element_courant).donnee).type == NOM) ||
				((*(*l_element_courant).donnee).type == ALG) ||
				((*(*l_element_courant).donnee).type == RPN)))
		{
			liberation(s_etat_processus, s_objet);

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

		l_element_courant = (*l_element_courant).suivant;

		if (l_element_courant != NULL)
		{
			liberation(s_etat_processus, s_objet);

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

		liberation(s_etat_processus, (*s_etat_processus).indep);
		(*s_etat_processus).indep = s_objet;
	}
	else
	{
		liberation(s_etat_processus, s_objet);

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

	return;
}


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

void
instruction_int(struct_processus *s_etat_processus)
{
	logical1					last_valide;

	real8						borne_maximale;
	real8						borne_minimale;
	real8						precision;

	struct_liste_chainee		*l_element_courant;

	struct_objet				*s_objet_argument_1;
	struct_objet				*s_objet_argument_2;
	struct_objet				*s_objet_argument_3;
	struct_objet				*s_objet_evalue;

	unsigned char				*nom_variable;

	(*s_etat_processus).erreur_execution = d_ex;

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

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(intégration)\n\n");
		}
		else
		{
			printf("(numerical)\n\n");
		}

		printf("    3: %s, %s, %s, %s, %s\n", d_INT, d_REL,
				d_NOM, d_ALG, d_RPN);
		printf("    2: %s\n", d_LST);
		printf("    1: %s, %s\n", d_INT, d_REL);
		printf("->  2: %s, %s\n", d_INT, d_REL);
		printf("    1: %s, %s\n\n", d_INT, d_REL);

		printf("    2: %s, %s, %s, %s\n", d_INT, d_REL, d_NOM, d_ALG);
		printf("    1: %s\n", d_NOM);
		printf("->  1: %s, %s, %s, %s\n", d_INT, d_REL, d_NOM, d_ALG);
		return;
	}
	else if ((*s_etat_processus).test_instruction == 'Y')
	{
		(*s_etat_processus).nombre_arguments = -1;
		return;
	}

	if ((*s_etat_processus).l_base_pile == NULL)
	{
		(*s_etat_processus).erreur_execution = d_ex_manque_argument;
		return;
	}

	if ((*(*(*s_etat_processus).l_base_pile).donnee).type == NOM)
	{
		// Intégration symbolique

		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_argument_1) == d_erreur)
		{
			(*s_etat_processus).erreur_execution = d_ex_manque_argument;
			return;
		}

		if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
				&s_objet_argument_2) == d_erreur)
		{
			liberation(s_etat_processus, s_objet_argument_1);

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

		if (((*s_objet_argument_1).type == NOM) &&
				(((*s_objet_argument_2).type == NOM) ||
				((*s_objet_argument_2).type == ALG) ||
				((*s_objet_argument_2).type == REL) ||
				((*s_objet_argument_2).type == INT)))
		{
			if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
					s_objet_argument_2) == d_erreur)
			{
				return;
			}

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

			interface_cas(s_etat_processus, RPLCAS_INTEGRATION);
		}
		else
		{
			liberation(s_etat_processus, s_objet_argument_1);
			liberation(s_etat_processus, s_objet_argument_2);

			(*s_etat_processus).erreur_execution =
					d_ex_erreur_type_argument;
			return;
		}
	}
	else
	{
		// Intégration numérique

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

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

		if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
				&s_objet_argument_2) == d_erreur)
		{
			liberation(s_etat_processus, s_objet_argument_1);

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

		if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
				&s_objet_argument_3) == d_erreur)
		{
			liberation(s_etat_processus, s_objet_argument_1);
			liberation(s_etat_processus, s_objet_argument_2);

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

		if (((*s_objet_argument_3).type != NOM) &&
				((*s_objet_argument_3).type != ALG) &&
				((*s_objet_argument_3).type != RPN) &&
				((*s_objet_argument_3).type != REL) &&
				((*s_objet_argument_3).type != INT))
		{
			liberation(s_etat_processus, s_objet_argument_1);
			liberation(s_etat_processus, s_objet_argument_2);
			liberation(s_etat_processus, s_objet_argument_3);

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

		if ((*s_objet_argument_1).type == INT)
		{
			precision = (real8) (*((integer8 *) (*s_objet_argument_1).objet));
		}
		else if ((*s_objet_argument_1).type == REL)
		{
			precision = (*((real8 *) (*s_objet_argument_1).objet));
		}
		else
		{
			liberation(s_etat_processus, s_objet_argument_1);
			liberation(s_etat_processus, s_objet_argument_2);
			liberation(s_etat_processus, s_objet_argument_3);

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

		if ((*s_objet_argument_2).type == LST)
		{
			l_element_courant = (*s_objet_argument_2).objet;

			if ((*(*l_element_courant).donnee).type != NOM)
			{
				liberation(s_etat_processus, s_objet_argument_1);
				liberation(s_etat_processus, s_objet_argument_2);
				liberation(s_etat_processus, s_objet_argument_3);

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

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

			strcpy(nom_variable, (*((struct_nom *) (*(*l_element_courant)
					.donnee).objet)).nom);

			l_element_courant = (*l_element_courant).suivant;

			if ((*(*l_element_courant).donnee).type == INT)
			{
				borne_minimale = (real8) (*((integer8 *)
						(*(*l_element_courant).donnee).objet));
			}
			else if ((*(*l_element_courant).donnee).type == REL)
			{
				borne_minimale = (*((real8 *) (*(*l_element_courant)
						.donnee).objet));
			}
			else
			{
				if (evaluation(s_etat_processus, (*l_element_courant).donnee,
						'N') == d_erreur)
				{
					free(nom_variable);
					liberation(s_etat_processus, s_objet_argument_1);
					liberation(s_etat_processus, s_objet_argument_2);
					liberation(s_etat_processus, s_objet_argument_3);

					return;
				}

				if (depilement(s_etat_processus, &((*s_etat_processus)
						.l_base_pile), &s_objet_evalue) == d_erreur)
				{
					free(nom_variable);
					liberation(s_etat_processus, s_objet_argument_1);
					liberation(s_etat_processus, s_objet_argument_2);
					liberation(s_etat_processus, s_objet_argument_3);

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

				if ((*s_objet_evalue).type == INT)
				{
					borne_minimale = (real8) (*((integer8 *)
							(*s_objet_evalue).objet));
				}
				else if ((*s_objet_evalue).type == REL)
				{
					borne_minimale = (*((real8 *) (*s_objet_evalue).objet));
				}
				else
				{
					free(nom_variable);
					
					liberation(s_etat_processus, s_objet_evalue);
					liberation(s_etat_processus, s_objet_argument_1);
					liberation(s_etat_processus, s_objet_argument_2);
					liberation(s_etat_processus, s_objet_argument_3);

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

				liberation(s_etat_processus, s_objet_evalue);
			}

			l_element_courant = (*l_element_courant).suivant;

			if ((*(*l_element_courant).donnee).type == INT)
			{
				borne_maximale = (real8) (*((integer8 *)
						(*(*l_element_courant).donnee).objet));
			}
			else if ((*(*l_element_courant).donnee).type == REL)
			{
				borne_maximale = (*((real8 *) (*(*l_element_courant)
						.donnee).objet));
			}
			else
			{
				if (evaluation(s_etat_processus, (*l_element_courant).donnee,
						'N') == d_erreur)
				{
					free(nom_variable);
					liberation(s_etat_processus, s_objet_argument_1);
					liberation(s_etat_processus, s_objet_argument_2);
					liberation(s_etat_processus, s_objet_argument_3);

					return;
				}

				if (depilement(s_etat_processus, &((*s_etat_processus)
						.l_base_pile), &s_objet_evalue) == d_erreur)
				{
					free(nom_variable);
					liberation(s_etat_processus, s_objet_argument_1);
					liberation(s_etat_processus, s_objet_argument_2);
					liberation(s_etat_processus, s_objet_argument_3);

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

				if ((*s_objet_evalue).type == INT)
				{
					borne_maximale = (real8) (*((integer8 *)
							(*s_objet_evalue).objet));
				}
				else if ((*s_objet_evalue).type == REL)
				{
					borne_maximale = (*((real8 *) (*s_objet_evalue).objet));
				}
				else
				{
					free(nom_variable);

					liberation(s_etat_processus, s_objet_evalue);
					liberation(s_etat_processus, s_objet_argument_1);
					liberation(s_etat_processus, s_objet_argument_2);
					liberation(s_etat_processus, s_objet_argument_3);

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

				liberation(s_etat_processus, s_objet_evalue);
			}

			/*
			 * Le résultat est retourné sur la pile par la routine
			 */

			if (last_valide == d_vrai)
			{
				cf(s_etat_processus, 31);
			}

			integrale_romberg(s_etat_processus, s_objet_argument_3,
					nom_variable, borne_minimale, borne_maximale, precision);

			if (last_valide == d_vrai)
			{
				sf(s_etat_processus, 31);
			}

			free(nom_variable);
		}
		else
		{
			liberation(s_etat_processus, s_objet_argument_1);
			liberation(s_etat_processus, s_objet_argument_2);
			liberation(s_etat_processus, s_objet_argument_3);

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

		liberation(s_etat_processus, s_objet_argument_1);
		liberation(s_etat_processus, s_objet_argument_2);
		liberation(s_etat_processus, s_objet_argument_3);
	}

	return;
}


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

void
instruction_incr(struct_processus *s_etat_processus)
{
	logical1					variable_partagee;

	struct_objet				*s_copie_argument;
	struct_objet				*s_objet_argument;

	(*s_etat_processus).erreur_execution = d_ex;

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

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(incrémentation)\n\n");
		}
		else
		{
			printf("(incrementation)\n\n");
		}

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

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

		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 ((s_copie_argument = copie_objet(s_etat_processus,
				s_objet_argument, 'O')) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		liberation(s_etat_processus, s_objet_argument);
		s_objet_argument = s_copie_argument;

		(*((integer8 *) (*s_objet_argument).objet))++;

		if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
				s_objet_argument) == d_erreur)
		{
			return;
		}
	}
	else if ((*s_objet_argument).type == NOM)
	{
		if (recherche_variable(s_etat_processus, (*((struct_nom *)
				(*s_objet_argument).objet)).nom) == d_faux)
		{
			(*s_etat_processus).erreur_systeme = d_es;
			(*s_etat_processus).erreur_execution = d_ex_variable_non_definie;

			return;
		}

		liberation(s_etat_processus, s_objet_argument);

		if ((*(*s_etat_processus).pointeur_variable_courante)
				.variable_verrouillee == d_vrai)
		{
			(*s_etat_processus).erreur_execution = d_ex_variable_verrouillee;
			return;
		}

		if ((*(*s_etat_processus).pointeur_variable_courante).objet == NULL)
		{
			if (recherche_variable_partagee(s_etat_processus,
					(*(*s_etat_processus).pointeur_variable_courante).nom,
					(*(*s_etat_processus).pointeur_variable_courante)
					.variable_partagee, (*(*s_etat_processus)
					.pointeur_variable_courante).origine) == NULL)
			{
				(*s_etat_processus).erreur_systeme = d_es;
				(*s_etat_processus).erreur_execution =
						d_ex_variable_non_definie;

				return;
			}

			s_objet_argument = (*(*s_etat_processus)
					.pointeur_variable_partagee_courante).objet;
			variable_partagee = d_vrai;
		}
		else
		{
			s_objet_argument = (*(*s_etat_processus).pointeur_variable_courante)
					.objet;
			variable_partagee = d_faux;
		}

		if ((s_copie_argument = copie_objet(s_etat_processus,
				s_objet_argument, 'O')) == NULL)
		{
			if (variable_partagee == d_vrai)
			{
				if (pthread_mutex_unlock(&((*(*s_etat_processus)
						.pointeur_variable_partagee_courante).mutex)) != 0)
				{
					(*s_etat_processus).erreur_systeme = d_es_processus;
					return;
				}
			}

			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		liberation(s_etat_processus, s_objet_argument);

		if (variable_partagee == d_vrai)
		{
			(*(*s_etat_processus).pointeur_variable_courante).objet = NULL;
			(*(*s_etat_processus).pointeur_variable_partagee_courante).objet =
					s_copie_argument;
		}
		else
		{
			(*(*s_etat_processus).pointeur_variable_courante).objet =
					s_copie_argument;
		}

		if ((*s_copie_argument).type == INT)
		{
			(*((integer8 *) (*s_copie_argument).objet))++;

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

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

		liberation(s_etat_processus, s_objet_argument);
		return;
	}

	return;
}

// vim: ts=4