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

void
instruction_lcd_fleche(struct_processus *s_etat_processus)
{
	file						*descripteur;
	file						*descripteur_graphique;

	int							caractere;

	struct_fichier_graphique	*l_fichier_courant;

	struct_liste_chainee		*l_element_courant;

	struct_objet				*s_objet_argument;

	unsigned long				nombre_elements;

	(*s_etat_processus).erreur_execution = d_ex;

	if ((*s_etat_processus).affichage_arguments == 'Y')
	{
		printf("\n  LCD-> ");
		
		if ((*s_etat_processus).langue == 'F')
		{
			printf("(sauvegarde d'un fichier graphique)\n\n");
		}
		else
		{
			printf("(graphical file storage)\n\n");
		}

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

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

		printf("    \"filename\" LCD->\n");
		printf("    { \"filename\" \"postscript eps enhanced monochrome "
				"dashed\" } LCD->\n");

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

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

	if ((*s_objet_argument).type == CHN)
	{
		if ((descripteur = fopen((unsigned char *) (*s_objet_argument).objet,
				"w")) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
			return;
		}

		l_fichier_courant = (*s_etat_processus).fichiers_graphiques;

		while(l_fichier_courant != NULL)
		{
			if (fprintf(descripteur, "@ %c %d %lld %s\n",
					((*l_fichier_courant).presence_axes == d_faux) ? 'F' : 'T',
					(*l_fichier_courant).dimensions,
					(*l_fichier_courant).systeme_axes,
					(*l_fichier_courant).type) < 0)
			{
				(*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
				return;
			}

			if ((descripteur_graphique = fopen((*l_fichier_courant).nom, "r"))
					== NULL)
			{
				(*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
				return;
			}

			while((caractere = getc(descripteur_graphique)) != EOF)
			{
				if (putc(caractere, descripteur) < 0)
				{
					(*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
					return;
				}
			}

			if (fclose(descripteur_graphique) != 0)
			{
				(*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
				return;
			}

			l_fichier_courant = (*l_fichier_courant).suivant;
		}

		if (fclose(descripteur) != 0)
		{
			(*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
			return;
		}

	}
	else if ((*s_objet_argument).type == LST)
	{
		l_element_courant = (struct_liste_chainee *) (*s_objet_argument).objet;

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

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

			nombre_elements++;

			switch(nombre_elements)
			{
				case 1 : /* Nom du fichier */
				{
					if (((*s_etat_processus).nom_fichier_gnuplot =
							malloc((strlen((unsigned char *)
							(*(*l_element_courant).donnee).objet) + 1) *
							sizeof(unsigned char))) == NULL)
					{
						(*s_etat_processus).erreur_systeme =
								d_es_allocation_memoire;
						return;
					}

					strcpy((*s_etat_processus).nom_fichier_gnuplot,
							(unsigned char *) (*(*l_element_courant).donnee)
							.objet);

					break;
				}

				case 2 : /* Type de fichier */
				{
					if (((*s_etat_processus).type_fichier_gnuplot =
							malloc((strlen((unsigned char *)
							(*(*l_element_courant).donnee).objet) + 1) *
							sizeof(unsigned char))) == NULL)
					{
						(*s_etat_processus).erreur_systeme =
								d_es_allocation_memoire;
						return;
					}

					strcpy((*s_etat_processus).type_fichier_gnuplot,
							(unsigned char *) (*(*l_element_courant).donnee)
							.objet);

					break;
				}

				default :
				{
					liberation(s_etat_processus, s_objet_argument);

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

			l_element_courant = (*l_element_courant).suivant;
		}

		appel_gnuplot(s_etat_processus, 'F');
	}
	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;
}


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

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

	struct_objet				*s_objet_argument;

	unsigned long				nombre_labels;

	(*s_etat_processus).erreur_execution = d_ex;

	if ((*s_etat_processus).affichage_arguments == 'Y')
	{
		printf("\n  LABEL ");
		
		if ((*s_etat_processus).langue == 'F')
		{
			printf("(spécification des labels sur les axes)\n\n");
		}
		else
		{
			printf("(axes labels specification)\n\n");
		}

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

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

		printf("    { \"label X\" \"label Y\" \"label Z\" } LABEL\n");
		printf("    { \"label X\" } LABEL\n");

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

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

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

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

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

			nombre_labels++;

			switch(nombre_labels)
			{
				case 1 :
				{
					free((*s_etat_processus).label_x);

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

					strcpy((*s_etat_processus).label_x, (unsigned char *)
							(*(*l_element_courant).donnee).objet);

					break;
				}

				case 2 :
				{
					free((*s_etat_processus).label_y);

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

					strcpy((*s_etat_processus).label_y, (unsigned char *)
							(*(*l_element_courant).donnee).objet);

					break;
				}

				case 3 :
				{
					free((*s_etat_processus).label_z);

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

					strcpy((*s_etat_processus).label_z, (unsigned char *)
							(*(*l_element_courant).donnee).objet);

					break;
				}

				default :
				{
					liberation(s_etat_processus, s_objet_argument);

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

			l_element_courant = (*l_element_courant).suivant;
		}
	}
	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 (test_cfsf(s_etat_processus, 52) == d_faux)
	{
		if ((*s_etat_processus).fichiers_graphiques != NULL)
		{
			appel_gnuplot(s_etat_processus, 'N');
		}
	}

	return;
}


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

void
instruction_logger(struct_processus *s_etat_processus)
{
	struct_objet				*s_objet_argument;

	(*s_etat_processus).erreur_execution = d_ex;

	if ((*s_etat_processus).affichage_arguments == 'Y')
	{
		printf("\n  LOGGER ");
		
		if ((*s_etat_processus).langue == 'F')
		{
			printf("(écriture d'un message de journalisation)\n\n");
		}
		else
		{
			printf("(send message to system logger)\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, 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 == CHN)
	{
		syslog(LOG_NOTICE, "%s", (unsigned char *) (*s_objet_argument).objet);
	}
	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;
}


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

void
instruction_line(struct_processus *s_etat_processus)
{
	file						*fichier;

	struct_fichier_graphique	*l_fichier_candidat;
	struct_fichier_graphique	*l_fichier_courant;
	struct_fichier_graphique	*l_fichier_precedent;

	struct_objet				*s_objet_argument_1;
	struct_objet				*s_objet_argument_2;

	unsigned char				*nom_fichier;

	(*s_etat_processus).erreur_execution = d_ex;

	if ((*s_etat_processus).affichage_arguments == 'Y')
	{
		printf("\n  LINE ");
		
		if ((*s_etat_processus).langue == 'F')
		{
			printf("(dessin d'un segment)\n\n");
		}
		else
		{
			printf("(draw line)\n\n");
		}

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

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

	// Vérification du nombre de dimensions de l'espace

	if (((*s_objet_argument_1).type == CPL) &&
			((*s_objet_argument_2).type == CPL))
	{
		/*
		 * Vérification de la présence d'un fichier de dessin
		 * parmi la liste des fichiers graphiques
		 */

		l_fichier_courant = (*s_etat_processus).fichiers_graphiques;
		l_fichier_candidat = NULL;

		while(l_fichier_courant != NULL)
		{
			if (strcmp((*l_fichier_courant).type, "DESSIN") == 0)
			{
				l_fichier_candidat = l_fichier_courant;
			}

			l_fichier_courant = (*l_fichier_courant).suivant;
		}

		l_fichier_courant = l_fichier_candidat;

		if ((l_fichier_courant == NULL) ||
				((*s_etat_processus).requete_nouveau_plan == d_vrai))
		{
			// Création d'un fichier

			(*s_etat_processus).requete_nouveau_plan = d_faux;

			if ((nom_fichier = creation_nom_fichier(s_etat_processus,
					(*s_etat_processus).chemin_fichiers_temporaires)) == NULL)
			{
				(*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
				return;
			}

			if ((fichier = fopen(nom_fichier, "w+")) == NULL)
			{
				(*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
				return;
			}

			l_fichier_courant = (*s_etat_processus).fichiers_graphiques;

			if (l_fichier_courant == NULL)
			{
				if (((*s_etat_processus).fichiers_graphiques =
						malloc(sizeof(struct_fichier_graphique))) == NULL)
				{
					(*s_etat_processus).erreur_systeme =
							d_es_allocation_memoire;
					return;
				}

				(*(*s_etat_processus).fichiers_graphiques).suivant = NULL;
				(*(*s_etat_processus).fichiers_graphiques).nom = nom_fichier;
				(*(*s_etat_processus).fichiers_graphiques).legende = NULL;
				(*(*s_etat_processus).fichiers_graphiques).dimensions = 2;
				(*(*s_etat_processus).fichiers_graphiques).presence_axes =
						d_faux;
				(*(*s_etat_processus).fichiers_graphiques).systeme_axes =
						(*s_etat_processus).systeme_axes;
				strcpy((*(*s_etat_processus).fichiers_graphiques).type,
						"DESSIN");
			}
			else
			{
				while(l_fichier_courant != NULL)
				{
					if ((*l_fichier_courant).dimensions != 2)
					{
						(*s_etat_processus).erreur_execution =
								d_ex_dimensions_differentes;
						return;
					}

					l_fichier_precedent = l_fichier_courant;
					l_fichier_courant = (*l_fichier_courant).suivant;
				}

				l_fichier_courant = l_fichier_precedent;

				if (((*l_fichier_courant).suivant =
						malloc(sizeof(struct_fichier_graphique))) == NULL)
				{
					(*s_etat_processus).erreur_systeme =
							d_es_allocation_memoire;
					return;
				}

				l_fichier_courant = (*l_fichier_courant).suivant;

				(*l_fichier_courant).suivant = NULL;
				(*l_fichier_courant).nom = nom_fichier;
				(*l_fichier_courant).legende = NULL;
				(*l_fichier_courant).dimensions = 2;
				(*l_fichier_courant).presence_axes = d_faux;
				(*l_fichier_courant).systeme_axes =
						(*s_etat_processus).systeme_axes;
				strcpy((*l_fichier_courant).type, "DESSIN");
			}
		}
		else
		{
			// Le fichier préexiste.

			if ((fichier = fopen((*l_fichier_courant).nom, "a")) == NULL)
			{
				(*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
				return;
			}
		}

		/*
		 * Inscription du segment
		 */

		if (fprintf(fichier, "%f %f\n", (*((complex16 *)
				(*s_objet_argument_2).objet)).partie_reelle, (*((complex16 *)
				(*s_objet_argument_2).objet)).partie_imaginaire) < 0)
		{
			(*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
			return;
		}

		if (fprintf(fichier, "%f %f\n\n", (*((complex16 *)
				(*s_objet_argument_1).objet)).partie_reelle, (*((complex16 *)
				(*s_objet_argument_1).objet)).partie_imaginaire) < 0)
		{
			(*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
			return;
		}

		if (fclose(fichier) != 0)
		{
			(*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
			return;
		}

		(*s_etat_processus).mise_a_jour_trace_requise = d_vrai;
	}
	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;
	}

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

	return;
}


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

void
instruction_lq(struct_processus *s_etat_processus)
{
	complex16					registre;
	complex16					*tau_complexe;
	complex16					*vecteur_complexe;

	real8						*tau_reel;
	real8						*vecteur_reel;

	struct_liste_chainee		*registre_pile_last;

	struct_objet				*s_copie_argument;
	struct_objet				*s_matrice_identite;
	struct_objet				*s_objet;
	struct_objet				*s_objet_argument;
	struct_objet				*s_objet_resultat;

	unsigned long				i;
	unsigned long				j;
	unsigned long				k;
	unsigned long				nombre_reflecteurs_elementaires;

	void						*tau;

	(*s_etat_processus).erreur_execution = d_ex;

	if ((*s_etat_processus).affichage_arguments == 'Y')
	{
		printf("\n  LQ ");
		
		if ((*s_etat_processus).langue == 'F')
		{
			printf("(décomposition LQ)\n\n");
		}
		else
		{
			printf("(LQ décomposition)\n\n");
		}

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

		printf("    1: %s\n", d_MCX);
		printf("->  2: %s\n", d_MCX);
		printf("    1: %s\n", 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, 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 == MIN) ||
			((*s_objet_argument).type == MRL))
	{
		/*
		 * Matrice entière ou réelle
		 */

		if ((s_copie_argument = copie_objet(s_etat_processus,
				s_objet_argument, 'Q')) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		factorisation_lq(s_etat_processus, (*s_copie_argument).objet, &tau);
		(*s_copie_argument).type = MRL;

		tau_reel = (real8 *) tau;

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

		if (((*s_etat_processus).exception != d_ep) ||
				((*s_etat_processus).erreur_execution != d_ex))
		{
			free(tau);
			liberation(s_etat_processus, s_objet_argument);
			liberation(s_etat_processus, s_copie_argument);
			return;
		}

		if ((s_objet_resultat = copie_objet(s_etat_processus,
				s_copie_argument, 'O')) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		// Matrice L

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

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

		// Matrice Q

		nombre_reflecteurs_elementaires = ((*((struct_matrice *)
				(*s_copie_argument).objet)).nombre_colonnes <
				(*((struct_matrice *) (*s_copie_argument).objet))
				.nombre_lignes) ? (*((struct_matrice *)
				(*s_copie_argument).objet)).nombre_colonnes
				: (*((struct_matrice *) (*s_copie_argument).objet))
				.nombre_lignes;

		registre_pile_last = NULL;

		if (test_cfsf(s_etat_processus, 31) == d_vrai)
		{
			registre_pile_last = (*s_etat_processus).l_base_pile_last;
			(*s_etat_processus).l_base_pile_last = NULL;
		}

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

		(*((integer8 *) (*s_objet).objet)) = (*((struct_matrice *)
				(*s_copie_argument).objet)).nombre_colonnes;

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

		instruction_idn(s_etat_processus);

		if (((*s_etat_processus).erreur_systeme != d_es) ||
				((*s_etat_processus).erreur_execution != d_ex) ||
				((*s_etat_processus).exception != d_ep))
		{
			liberation(s_etat_processus, s_copie_argument);
			free(tau);

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

			(*s_etat_processus).l_base_pile_last = registre_pile_last;
			return;
		}

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

		for(i = 0; i < nombre_reflecteurs_elementaires; i++)
		{
			// Calcul de H(i) = I - tau * v * v'

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

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

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

			(*((real8 *) (*s_objet).objet)) = tau_reel[i];

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

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

			(*((struct_matrice *) (*s_objet).objet)).nombre_lignes =
					(*((struct_matrice *) (*s_copie_argument).objet))
					.nombre_colonnes;
			(*((struct_matrice *) (*s_objet).objet)).nombre_colonnes =
					(*((struct_matrice *) (*s_copie_argument).objet))
					.nombre_colonnes;

			if ((vecteur_reel = malloc((*((struct_matrice *) (*s_objet).objet))
					.nombre_lignes * sizeof(real8))) == NULL)
			{
				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
				return;
			}

			for(j = 0; j < (*((struct_matrice *) (*s_objet).objet))
					.nombre_lignes; j++)
			{
				if (j < i)
				{
					vecteur_reel[j] = 0;
				}
				else if (j == i)
				{
					vecteur_reel[j] = 1;
				}
				else
				{
					vecteur_reel[j] = ((real8 **) (*((struct_matrice *)
							(*s_copie_argument).objet)).tableau)[i][j];
				}
			}

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

			for(j = 0; j < (*((struct_matrice *) (*s_objet).objet))
					.nombre_lignes; j++)
			{
				if ((((real8 **) (*((struct_matrice *) (*s_objet).objet))
						.tableau)[j] = malloc((*((struct_matrice *) (*s_objet)
						.objet)).nombre_lignes * sizeof(real8))) == NULL)
				{
					(*s_etat_processus).erreur_systeme =
							d_es_allocation_memoire;
					return;
				}

				for(k = 0; k < (*((struct_matrice *) (*s_objet).objet))
						.nombre_colonnes; k++)
				{
					((real8 **) (*((struct_matrice *) (*s_objet).objet))
							.tableau)[j][k] = vecteur_reel[j] * vecteur_reel[k];
				}
			}

			free(vecteur_reel);

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

			instruction_multiplication(s_etat_processus);

			if (((*s_etat_processus).erreur_systeme != d_es) ||
					((*s_etat_processus).erreur_execution != d_ex) ||
					((*s_etat_processus).exception != d_ep))
			{
				liberation(s_etat_processus, s_copie_argument);
				liberation(s_etat_processus, s_matrice_identite);
				free(tau);

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

				(*s_etat_processus).l_base_pile_last = registre_pile_last;
				return;
			}

			instruction_moins(s_etat_processus);

			if (((*s_etat_processus).erreur_systeme != d_es) ||
					((*s_etat_processus).erreur_execution != d_ex) ||
					((*s_etat_processus).exception != d_ep))
			{
				liberation(s_etat_processus, s_copie_argument);
				liberation(s_etat_processus, s_matrice_identite);
				free(tau);

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

				(*s_etat_processus).l_base_pile_last = registre_pile_last;
				return;
			}

			if (i > 0)
			{
				instruction_swap(s_etat_processus);

				if (((*s_etat_processus).erreur_systeme != d_es) ||
						((*s_etat_processus).erreur_execution != d_ex) ||
						((*s_etat_processus).exception != d_ep))
				{
					liberation(s_etat_processus, s_copie_argument);
					liberation(s_etat_processus, s_matrice_identite);
					free(tau);

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

					(*s_etat_processus).l_base_pile_last = registre_pile_last;
					return;
				}

				instruction_multiplication(s_etat_processus);

				if (((*s_etat_processus).erreur_systeme != d_es) ||
						((*s_etat_processus).erreur_execution != d_ex) ||
						((*s_etat_processus).exception != d_ep))
				{
					liberation(s_etat_processus, s_copie_argument);
					liberation(s_etat_processus, s_matrice_identite);
					free(tau);

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

					(*s_etat_processus).l_base_pile_last = registre_pile_last;
					return;
				}
			}
		}

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

			(*s_etat_processus).l_base_pile_last = registre_pile_last;
		}

		liberation(s_etat_processus, s_matrice_identite);
		liberation(s_etat_processus, s_copie_argument);
		free(tau);
	}
	else if ((*s_objet_argument).type == MCX)
	{
		/*
		 * Matrice complexe
		 */

		if ((s_copie_argument = copie_objet(s_etat_processus,
				s_objet_argument, 'Q')) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		factorisation_lq(s_etat_processus, (*s_copie_argument).objet, &tau);

		tau_complexe = (complex16 *) tau;

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

		if (((*s_etat_processus).exception != d_ep) ||
				((*s_etat_processus).erreur_execution != d_ex))
		{
			free(tau);
			liberation(s_etat_processus, s_objet_argument);
			liberation(s_etat_processus, s_copie_argument);
			return;
		}

		if ((s_objet_resultat = copie_objet(s_etat_processus,
				s_copie_argument, 'O')) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		// Matrice L

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

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

		// Matrice Q

		nombre_reflecteurs_elementaires = ((*((struct_matrice *)
				(*s_copie_argument).objet)).nombre_colonnes <
				(*((struct_matrice *) (*s_copie_argument).objet))
				.nombre_lignes) ? (*((struct_matrice *)
				(*s_copie_argument).objet)).nombre_colonnes
				: (*((struct_matrice *) (*s_copie_argument).objet))
				.nombre_lignes;

		registre_pile_last = NULL;

		if (test_cfsf(s_etat_processus, 31) == d_vrai)
		{
			registre_pile_last = (*s_etat_processus).l_base_pile_last;
			(*s_etat_processus).l_base_pile_last = NULL;
		}

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

		(*((integer8 *) (*s_objet).objet)) = (*((struct_matrice *)
				(*s_copie_argument).objet)).nombre_colonnes;

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

		instruction_idn(s_etat_processus);

		if (((*s_etat_processus).erreur_systeme != d_es) ||
				((*s_etat_processus).erreur_execution != d_ex) ||
				((*s_etat_processus).exception != d_ep))
		{
			liberation(s_etat_processus, s_copie_argument);
			free(tau);

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

			(*s_etat_processus).l_base_pile_last = registre_pile_last;
			return;
		}

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

		for(i = 0; i < nombre_reflecteurs_elementaires; i++)
		{
			// Calcul de H'(i) = (I - tau * v * v')'

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

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

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

			(*((complex16 *) (*s_objet).objet)) = tau_complexe[i];

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

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

			(*((struct_matrice *) (*s_objet).objet)).nombre_lignes =
					(*((struct_matrice *) (*s_copie_argument).objet))
					.nombre_colonnes;
			(*((struct_matrice *) (*s_objet).objet)).nombre_colonnes =
					(*((struct_matrice *) (*s_copie_argument).objet))
					.nombre_colonnes;

			if ((vecteur_complexe = malloc((*((struct_matrice *)
					(*s_objet).objet)).nombre_lignes * sizeof(complex16)))
					== NULL)
			{
				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
				return;
			}

			for(j = 0; j < (*((struct_matrice *) (*s_objet).objet))
					.nombre_lignes; j++)
			{
				if (j < i)
				{
					vecteur_complexe[j].partie_reelle = 0;
					vecteur_complexe[j].partie_imaginaire = 0;
				}
				else if (j == i)
				{
					vecteur_complexe[j].partie_reelle = 1;
					vecteur_complexe[j].partie_imaginaire = 0;
				}
				else
				{
					vecteur_complexe[j].partie_reelle =
							((complex16 **) (*((struct_matrice *)
							(*s_copie_argument).objet)).tableau)[i][j]
							.partie_reelle;
					vecteur_complexe[j].partie_imaginaire =
							-((complex16 **) (*((struct_matrice *)
							(*s_copie_argument).objet)).tableau)[i][j]
							.partie_imaginaire;
				}
			}

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

			for(j = 0; j < (*((struct_matrice *) (*s_objet).objet))
					.nombre_lignes; j++)
			{
				if ((((complex16 **) (*((struct_matrice *) (*s_objet).objet))
						.tableau)[j] = malloc((*((struct_matrice *) (*s_objet)
						.objet)).nombre_lignes * sizeof(complex16))) == NULL)
				{
					(*s_etat_processus).erreur_systeme =
							d_es_allocation_memoire;
					return;
				}

				for(k = 0; k < (*((struct_matrice *) (*s_objet).objet))
						.nombre_colonnes; k++)
				{
					registre = vecteur_complexe[k];
					registre.partie_imaginaire = -registre.partie_imaginaire;

					f77multiplicationcc_(&(vecteur_complexe[j]), &registre,
							&(((complex16 **) (*((struct_matrice *)
							(*s_objet).objet)).tableau)[j][k]));
				}
			}

			free(vecteur_complexe);

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

			instruction_multiplication(s_etat_processus);

			if (((*s_etat_processus).erreur_systeme != d_es) ||
					((*s_etat_processus).erreur_execution != d_ex) ||
					((*s_etat_processus).exception != d_ep))
			{
				liberation(s_etat_processus, s_copie_argument);
				liberation(s_etat_processus, s_matrice_identite);
				free(tau);

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

				(*s_etat_processus).l_base_pile_last = registre_pile_last;
				return;
			}

			instruction_moins(s_etat_processus);

			if (((*s_etat_processus).erreur_systeme != d_es) ||
					((*s_etat_processus).erreur_execution != d_ex) ||
					((*s_etat_processus).exception != d_ep))
			{
				liberation(s_etat_processus, s_copie_argument);
				liberation(s_etat_processus, s_matrice_identite);
				free(tau);

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

				(*s_etat_processus).l_base_pile_last = registre_pile_last;
				return;
			}

			instruction_trn(s_etat_processus);

			if (((*s_etat_processus).erreur_systeme != d_es) ||
					((*s_etat_processus).erreur_execution != d_ex) ||
					((*s_etat_processus).exception != d_ep))
			{
				liberation(s_etat_processus, s_copie_argument);
				liberation(s_etat_processus, s_matrice_identite);
				free(tau);

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

				(*s_etat_processus).l_base_pile_last = registre_pile_last;
				return;
			}

			if (i > 0)
			{
				instruction_swap(s_etat_processus);

				if (((*s_etat_processus).erreur_systeme != d_es) ||
						((*s_etat_processus).erreur_execution != d_ex) ||
						((*s_etat_processus).exception != d_ep))
				{
					liberation(s_etat_processus, s_copie_argument);
					liberation(s_etat_processus, s_matrice_identite);
					free(tau);

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

					(*s_etat_processus).l_base_pile_last = registre_pile_last;
					return;
				}

				instruction_multiplication(s_etat_processus);

				if (((*s_etat_processus).erreur_systeme != d_es) ||
						((*s_etat_processus).erreur_execution != d_ex) ||
						((*s_etat_processus).exception != d_ep))
				{
					liberation(s_etat_processus, s_copie_argument);
					liberation(s_etat_processus, s_matrice_identite);
					free(tau);

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

					(*s_etat_processus).l_base_pile_last = registre_pile_last;
					return;
				}
			}
		}

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

			(*s_etat_processus).l_base_pile_last = registre_pile_last;
		}

		liberation(s_etat_processus, s_matrice_identite);
		liberation(s_etat_processus, s_copie_argument);
		free(tau);
	}

	/*
	 * Type d'argument invalide
	 */

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


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

void
instruction_localization(struct_processus *s_etat_processus)
{
	struct_objet			*s_objet_argument;

	(*s_etat_processus).erreur_execution = d_ex;

	if ((*s_etat_processus).affichage_arguments == 'Y')
	{
		printf("\n  LOCALIZATION ");
		
		if ((*s_etat_processus).langue == 'F')
		{
			printf("(spécifie les variables de localisation)\n\n");
		}
		else
		{
			printf("(set locales)\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, 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 == CHN)
	{
		if (setlocale(LC_ALL, (unsigned char *) (*s_objet_argument).objet)
				== NULL)
		{
			liberation(s_etat_processus, s_objet_argument);

			(*s_etat_processus).erreur_execution = d_ex_locales;
			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;
}


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

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

	unsigned char			*ptr;
	unsigned char			registre;

	(*s_etat_processus).erreur_execution = d_ex;

	if ((*s_etat_processus).affichage_arguments == 'Y')
	{
		printf("\n  LCASE ");
		
		if ((*s_etat_processus).langue == 'F')
		{
			printf("(converison d'une chaîne de caractères en minuscules)\n\n");
		}
		else
		{
			printf("(convert string to lower case)\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, 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 == CHN)
	{
		if ((s_objet_resultat = 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);
		ptr = (unsigned char *) (*s_objet_resultat).objet;

		while((*ptr) != d_code_fin_chaine)
		{
			registre = tolower((*ptr));

			if (toupper(registre) == (*ptr))
			{
				(*ptr) = registre;
			}

			ptr++;
		}

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

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

	return;
}

// vim: ts=4