/*
================================================================================
  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 'getc'
================================================================================
  Entrées : pointeur sur une structure struct_processus
--------------------------------------------------------------------------------
  Sorties :
--------------------------------------------------------------------------------
  Effets de bord : néant
================================================================================
*/

void
instruction_getc(struct_processus *s_etat_processus)
{
	logical1					presence_variable;
	logical1					variable_partagee;

	struct_liste_chainee		*l_element_courant;

	struct_objet				*s_objet_argument_1;
	struct_objet				*s_objet_argument_2;
	struct_objet				*s_objet_resultat;

	integer8					i;
	integer8					j;
	integer8					colonne;
	integer8					nombre_colonnes;

	(*s_etat_processus).erreur_execution = d_ex;

	if ((*s_etat_processus).affichage_arguments == 'Y')
	{
		printf("\n  GETC ");
		
		if ((*s_etat_processus).langue == 'F')
		{
			printf("(prend une colonne)\n\n");
		}
		else
		{
			printf("(get column)\n\n");
		}

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

		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, 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_2).type == NOM)
	{
		if (recherche_variable(s_etat_processus, (*((struct_nom *)
				(*s_objet_argument_2).objet)).nom) == d_faux)
		{
			liberation(s_etat_processus, s_objet_argument_1);
			liberation(s_etat_processus, s_objet_argument_2);

			(*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_2);

		s_objet_argument_2 = (*(*s_etat_processus).pointeur_variable_courante)
				.objet;
		presence_variable = d_vrai;

		if (s_objet_argument_2 == NULL)
		{
			// Variable partagée

			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)
			{
				liberation(s_etat_processus, s_objet_argument_1);

				(*s_etat_processus).erreur_systeme = d_es;
				(*s_etat_processus).erreur_execution =
						d_ex_variable_non_definie;

				return;
			}

			s_objet_argument_2 = (*(*s_etat_processus)
					.pointeur_variable_partagee_courante).objet;
			variable_partagee = d_vrai;
		}
		else
		{
			variable_partagee = d_faux;
		}
	}
	else
	{
		presence_variable = d_faux;
		variable_partagee = d_faux;
	}

	if (((*s_objet_argument_2).type == MIN) ||
			((*s_objet_argument_2).type == MRL) ||
			((*s_objet_argument_2).type == MCX))
	{
		if ((*s_objet_argument_1).type == LST)
		{
			l_element_courant = (struct_liste_chainee *)
					(*s_objet_argument_1).objet;
			nombre_colonnes = 0;

			while(l_element_courant != NULL)
			{
				if ((*(*l_element_courant).donnee).type != INT)
				{
					liberation(s_etat_processus, s_objet_argument_1);

					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 (presence_variable == d_faux)
					{
						liberation(s_etat_processus, s_objet_argument_2);
					}

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

				if (((*((integer8 *) (*(*l_element_courant).donnee).objet))
						<= 0) || ((*((integer8 *) (*(*l_element_courant).donnee)
						.objet)) > (integer8) (*((struct_matrice *)
						(*s_objet_argument_2).objet)).nombre_colonnes))
				{
					liberation(s_etat_processus, s_objet_argument_1);

					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 (presence_variable == d_faux)
					{
						liberation(s_etat_processus, s_objet_argument_2);
					}

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

				nombre_colonnes++;
				l_element_courant = (*l_element_courant).suivant;
			}

			if (nombre_colonnes == 0)
			{
				liberation(s_etat_processus, s_objet_argument_1);

				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 (presence_variable == d_faux)
				{
					liberation(s_etat_processus, s_objet_argument_2);
				}

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

			if ((s_objet_resultat = allocation(s_etat_processus,
					(*s_objet_argument_2).type)) == 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;
			}

			(*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
					nombre_colonnes;
			(*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
					(*((struct_matrice *) (*s_objet_argument_2).objet))
					.nombre_lignes;

			switch((*((struct_matrice *) (*s_objet_resultat).objet)).type)
			{
				case 'I' :
				{
					(*s_objet_resultat).type = MIN;

					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 (((*((struct_matrice *) (*s_objet_resultat).objet))
								.tableau[i] = malloc(((size_t) 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;
						}

					}

					l_element_courant = (struct_liste_chainee *)
							(*s_objet_argument_1).objet;
					j = 0;

					while(l_element_courant != NULL)
					{
						colonne = (*((integer8 *) (*(*l_element_courant).donnee)
								.objet)) - 1;

						for(i = 0; i < (*((struct_matrice *) (*s_objet_resultat)
								.objet)).nombre_lignes; i++)
						{
							((integer8 **) (*((struct_matrice *)
									(*s_objet_resultat).objet)).tableau)[i][j] =
									((integer8 **) (*((struct_matrice *)
									(*s_objet_argument_2).objet))
									.tableau)[i][colonne];
						}

						l_element_courant = (*l_element_courant).suivant;
						j++;
					}

					break;
				}

				case 'R' :
				{
					(*s_objet_resultat).type = MRL;

					if (((*((struct_matrice *) (*s_objet_resultat).objet))
							.tableau = malloc(((size_t) (*((struct_matrice *)
							(*s_objet_resultat).objet)).nombre_lignes) *
							sizeof(real8 *))) == 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 (((*((struct_matrice *) (*s_objet_resultat).objet))
								.tableau[i] = malloc(((size_t) nombre_colonnes)
								* sizeof(real8))) == 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;
						}

					}

					l_element_courant = (struct_liste_chainee *)
							(*s_objet_argument_1).objet;
					j = 0;

					while(l_element_courant != NULL)
					{
						colonne = (*((integer8 *) (*(*l_element_courant).donnee)
								.objet)) - 1;

						for(i = 0; i < (*((struct_matrice *) (*s_objet_resultat)
								.objet)).nombre_lignes; i++)
						{
							((real8 **) (*((struct_matrice *)
									(*s_objet_resultat).objet)).tableau)[i][j] =
									((real8 **) (*((struct_matrice *)
									(*s_objet_argument_2).objet))
									.tableau)[i][colonne];
						}

						l_element_courant = (*l_element_courant).suivant;
						j++;
					}

					break;
				}

				case 'C' :
				{
					(*s_objet_resultat).type = MCX;

					if (((*((struct_matrice *) (*s_objet_resultat).objet))
							.tableau = malloc(((size_t) (*((struct_matrice *)
							(*s_objet_resultat).objet)).nombre_lignes) *
							sizeof(complex16 *))) == 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 (((*((struct_matrice *) (*s_objet_resultat).objet))
								.tableau[i] = malloc(((size_t) nombre_colonnes)
								* sizeof(complex16))) == 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;
						}

					}

					l_element_courant = (struct_liste_chainee *)
							(*s_objet_argument_1).objet;
					j = 0;

					while(l_element_courant != NULL)
					{
						colonne = (*((integer8 *) (*(*l_element_courant).donnee)
								.objet)) - 1;

						for(i = 0; i < (*((struct_matrice *) (*s_objet_resultat)
								.objet)).nombre_lignes; i++)
						{
							((complex16 **) (*((struct_matrice *)
									(*s_objet_resultat).objet)).tableau)[i][j]
									.partie_reelle =
									((complex16 **) (*((struct_matrice *)
									(*s_objet_argument_2).objet))
									.tableau)[i][colonne].partie_reelle;
							((complex16 **) (*((struct_matrice *)
									(*s_objet_resultat).objet)).tableau)[i][j]
									.partie_imaginaire =
									((complex16 **) (*((struct_matrice *)
									(*s_objet_argument_2).objet))
									.tableau)[i][colonne].partie_imaginaire;
						}

						l_element_courant = (*l_element_courant).suivant;
						j++;
					}

					break;
				}
			}
		}
		else
		{
			liberation(s_etat_processus, s_objet_argument_1);

			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 (presence_variable == d_faux)
			{
				liberation(s_etat_processus, s_objet_argument_2);
			}

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

		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 (presence_variable == d_faux)
		{
			liberation(s_etat_processus, s_objet_argument_2);
		}

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

	liberation(s_etat_processus, s_objet_argument_1);

	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 (presence_variable == d_faux)
	{
		liberation(s_etat_processus, s_objet_argument_2);
	}

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

	return;
}


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

void
instruction_getr(struct_processus *s_etat_processus)
{
	logical1					presence_variable;
	logical1					variable_partagee;

	struct_liste_chainee		*l_element_courant;

	struct_objet				*s_objet_argument_1;
	struct_objet				*s_objet_argument_2;
	struct_objet				*s_objet_resultat;

	integer8					i;
	integer8					j;
	integer8					ligne;
	integer8					nombre_lignes;

	(*s_etat_processus).erreur_execution = d_ex;

	if ((*s_etat_processus).affichage_arguments == 'Y')
	{
		printf("\n  GETR ");
		
		if ((*s_etat_processus).langue == 'F')
		{
			printf("(prend une ligne)\n\n");
		}
		else
		{
			printf("(get row)\n\n");
		}

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

		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, 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_2).type == NOM)
	{
		if (recherche_variable(s_etat_processus, (*((struct_nom *)
				(*s_objet_argument_2).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_2);

		s_objet_argument_2 = (*(*s_etat_processus).pointeur_variable_courante)
				.objet;
		presence_variable = d_vrai;

		if (s_objet_argument_2 == NULL)
		{
			// Variable partagée

			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)
			{
				liberation(s_etat_processus, s_objet_argument_1);

				(*s_etat_processus).erreur_systeme = d_es;
				(*s_etat_processus).erreur_execution =
						d_ex_variable_non_definie;

				return;
			}

			s_objet_argument_2 = (*(*s_etat_processus)
					.pointeur_variable_partagee_courante).objet;
			variable_partagee = d_vrai;
		}
		else
		{
			variable_partagee = d_faux;
		}
	}
	else
	{
		presence_variable = d_faux;
		variable_partagee = d_faux;
	}

	if (((*s_objet_argument_2).type == MIN) ||
			((*s_objet_argument_2).type == MRL) ||
			((*s_objet_argument_2).type == MCX))
	{
		if ((*s_objet_argument_1).type == LST)
		{
			l_element_courant = (struct_liste_chainee *)
					(*s_objet_argument_1).objet;
			nombre_lignes = 0;

			while(l_element_courant != NULL)
			{
				if ((*(*l_element_courant).donnee).type != INT)
				{
					liberation(s_etat_processus, s_objet_argument_1);

					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 (presence_variable == d_faux)
					{
						liberation(s_etat_processus, s_objet_argument_2);
					}

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

				if (((*((integer8 *) (*(*l_element_courant).donnee).objet))
						<= 0) || ((*((integer8 *) (*(*l_element_courant).donnee)
						.objet)) > (integer8) (*((struct_matrice *)
						(*s_objet_argument_2).objet)).nombre_lignes))
				{
					liberation(s_etat_processus, s_objet_argument_1);

					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 (presence_variable == d_faux)
					{
						liberation(s_etat_processus, s_objet_argument_2);
					}

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

				nombre_lignes++;
				l_element_courant = (*l_element_courant).suivant;
			}

			if (nombre_lignes == 0)
			{
				liberation(s_etat_processus, s_objet_argument_1);

				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 (presence_variable == d_faux)
				{
					liberation(s_etat_processus, s_objet_argument_2);
				}

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

			if ((s_objet_resultat = allocation(s_etat_processus,
					(*s_objet_argument_2).type)) == 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;
			}

			(*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
					nombre_lignes;
			(*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
					(*((struct_matrice *) (*s_objet_argument_2).objet))
					.nombre_colonnes;

			if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
					malloc(((size_t) nombre_lignes) * sizeof(void *))) == 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;
			}

			switch((*((struct_matrice *) (*s_objet_resultat).objet)).type)
			{
				case 'I' :
				{
					(*s_objet_resultat).type = MIN;

					l_element_courant = (struct_liste_chainee *)
							(*s_objet_argument_1).objet;
					i = 0;

					while(l_element_courant != NULL)
					{
						ligne = (*((integer8 *) (*(*l_element_courant).donnee)
								.objet)) - 1;

						if (((*((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] =
									((integer8 **) (*((struct_matrice *)
									(*s_objet_argument_2).objet))
									.tableau)[ligne][j];
						}

						l_element_courant = (*l_element_courant).suivant;
						i++;
					}

					break;
				}

				case 'R' :
				{
					(*s_objet_resultat).type = MRL;

					l_element_courant = (struct_liste_chainee *)
							(*s_objet_argument_1).objet;
					i = 0;

					while(l_element_courant != NULL)
					{
						ligne = (*((integer8 *) (*(*l_element_courant).donnee)
								.objet)) - 1;

						if (((*((struct_matrice *) (*s_objet_resultat).objet))
								.tableau[i] = malloc(((size_t)
								(*((struct_matrice *)
								(*s_objet_resultat).objet)).nombre_colonnes) *
								sizeof(real8))) == 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++)
						{
							((real8 **) (*((struct_matrice *)
									(*s_objet_resultat).objet)).tableau)[i][j] =
									((real8 **) (*((struct_matrice *)
									(*s_objet_argument_2).objet))
									.tableau)[ligne][j];
						}

						l_element_courant = (*l_element_courant).suivant;
						i++;
					}

					break;
				}

				case 'C' :
				{
					(*s_objet_resultat).type = MCX;

					l_element_courant = (struct_liste_chainee *)
							(*s_objet_argument_1).objet;
					i = 0;

					while(l_element_courant != NULL)
					{
						ligne = (*((integer8 *) (*(*l_element_courant).donnee)
								.objet)) - 1;

						if (((*((struct_matrice *) (*s_objet_resultat).objet))
								.tableau[i] = malloc(((size_t)
								(*((struct_matrice *)
								(*s_objet_resultat).objet)).nombre_colonnes) *
								sizeof(complex16))) == 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++)
						{
							((complex16 **) (*((struct_matrice *)
									(*s_objet_resultat).objet)).tableau)[i][j]
							   		.partie_reelle =
									((complex16 **) (*((struct_matrice *)
									(*s_objet_argument_2).objet))
									.tableau)[ligne][j].partie_reelle;
							((complex16 **) (*((struct_matrice *)
									(*s_objet_resultat).objet)).tableau)[i][j]
							   		.partie_imaginaire =
									((complex16 **) (*((struct_matrice *)
									(*s_objet_argument_2).objet))
									.tableau)[ligne][j].partie_imaginaire;
						}

						l_element_courant = (*l_element_courant).suivant;
						i++;
					}

					break;
				}
			}
		}
		else
		{
			liberation(s_etat_processus, s_objet_argument_1);

			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 (presence_variable == d_faux)
			{
				liberation(s_etat_processus, s_objet_argument_2);
			}

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

		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 (presence_variable == d_faux)
		{
			liberation(s_etat_processus, s_objet_argument_2);
		}

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

	liberation(s_etat_processus, s_objet_argument_1);

	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 (presence_variable == d_faux)
	{
		liberation(s_etat_processus, s_objet_argument_2);
	}

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

	return;
}


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

void
instruction_gamma(struct_processus *s_etat_processus)
{
	double								argument_imaginaire;
	double								argument_reel;

	gsl_sf_result						argument;
	gsl_sf_result						ln_module;
	gsl_sf_result						resultat;

	int									statut;

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

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(fonction gamma)\n\n");
		}
		else
		{
			printf("(gamma function)\n\n");
		}

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

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

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

	statut = GSL_SUCCESS;

/*
--------------------------------------------------------------------------------
  Entier ou réel
--------------------------------------------------------------------------------
*/

	if (((*s_objet_argument).type == INT) ||
			((*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 ((*s_objet_argument).type == INT)
		{
			argument_reel = (real8) (*((integer8 *) (*s_objet_argument).objet));
		}
		else
		{
			argument_reel = (*((real8 *) (*s_objet_argument).objet));
		}

		statut = gsl_sf_gamma_e(argument_reel, &resultat);

		(*((real8 *) (*s_objet_resultat).objet)) = resultat.val;
	}

/*
--------------------------------------------------------------------------------
  Complexe
--------------------------------------------------------------------------------
*/

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

		argument_reel = (*((complex16 *) (*s_objet_argument).objet))
				.partie_reelle;
		argument_imaginaire = (*((complex16 *) (*s_objet_argument).objet))
				.partie_imaginaire;

		statut = gsl_sf_lngamma_complex_e(argument_reel, argument_imaginaire,
				&ln_module, &argument);

		(*((complex16 *) (*s_objet_resultat).objet)).partie_reelle =
				exp(ln_module.val) * cos(argument.val);
		(*((complex16 *) (*s_objet_resultat).objet)).partie_imaginaire =
				exp(ln_module.val) * sin(argument.val);
	}

/*
--------------------------------------------------------------------------------
  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_gamma;

		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, "GAMMA");

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

/*
--------------------------------------------------------------------------------
  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_gamma;

		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, "GAMMA");

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

		s_objet_resultat = s_copie_argument;
	}

/*
--------------------------------------------------------------------------------
  Argument absurde
--------------------------------------------------------------------------------
*/

	else
	{
		liberation(s_etat_processus, s_objet_argument);

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

	if (statut != GSL_SUCCESS)
	{
		traitement_asynchrone_exceptions_gsl(s_etat_processus);
		liberation(s_etat_processus, s_objet_resultat);
	}
	else
	{
		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;
}

// vim: ts=4