/*
================================================================================
  RPL/2 (R) version 4.0.18
  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"
#include "convert-conv.h"


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

void
instruction_cov(struct_processus *s_etat_processus)
{
	integer8							nombre_colonnes;

	logical1							erreur;
	logical1							presence_variable;

	long								i;

	struct_objet						*s_objet_statistique;
	struct_objet						*s_objet_resultat;

	(*s_etat_processus).erreur_execution = d_ex;

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

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

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

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

	/*
	 * Recherche d'une variable globale référencée par SIGMA
	 */

	if (recherche_variable(s_etat_processus, ds_sdat) == d_faux)
	{
		/*
		 * Aucune variable SIGMA
		 */

		(*s_etat_processus).erreur_systeme = d_es;
		(*s_etat_processus).erreur_execution = d_ex_absence_observations;
		return;
	}
	else
	{
		/*
		 * Il existe une variable locale SIGMA. Reste à vérifier l'existence
		 * d'une variable SIGMA globale...
		 */

		i = (*s_etat_processus).position_variable_courante;
		presence_variable = d_faux;

		while(i >= 0)
		{
			if ((strcmp((*s_etat_processus).s_liste_variables[i].nom,
					ds_sdat) == 0) && ((*s_etat_processus)
					.s_liste_variables[i].niveau == 1))
			{
				presence_variable = d_vrai;
				break;
			}

			i--;
		}

		if (presence_variable == d_faux)
		{
			(*s_etat_processus).erreur_execution = d_ex_absence_observations;
			return;
		}
		else
		{
			(*s_etat_processus).position_variable_courante = i;

			if ((*s_etat_processus).s_liste_variables
					[(*s_etat_processus).position_variable_courante].objet
					== NULL)
			{
				(*s_etat_processus).erreur_execution = d_ex_variable_partagee;
				return;
			}

			if (((*((*s_etat_processus).s_liste_variables
					[(*s_etat_processus).position_variable_courante].objet))
					.type != MIN) && ((*((*s_etat_processus)
					.s_liste_variables[(*s_etat_processus)
					.position_variable_courante].objet)).type != MRL))
			{
				(*s_etat_processus).erreur_execution =
						d_ex_matrice_statistique_invalide;
				return;
			}

			nombre_colonnes = (*((struct_matrice *) (*((*s_etat_processus)
					.s_liste_variables[(*s_etat_processus)
					.position_variable_courante].objet)).objet))
					.nombre_colonnes;
		}
	}

	s_objet_statistique = ((*s_etat_processus).s_liste_variables
			[(*s_etat_processus).position_variable_courante]).objet;

	if (((*s_objet_statistique).type == MIN) ||
			((*s_objet_statistique).type == MRL))
	{
		if (((*s_etat_processus).colonne_statistique_1 < 1) ||
				((*s_etat_processus).colonne_statistique_2 < 1) ||
				((*s_etat_processus).colonne_statistique_1 > nombre_colonnes) ||
				((*s_etat_processus).colonne_statistique_2 > nombre_colonnes))
		{
			(*s_etat_processus).erreur_execution =
					d_ex_observations_inexistantes;
			return;
		}

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

		(*((real8 *) (*s_objet_resultat).objet)) = covariance_statistique(
				(struct_matrice *) (*s_objet_statistique).objet,
				(*s_etat_processus).colonne_statistique_1,
				(*s_etat_processus).colonne_statistique_2, 'E', &erreur);

		if (erreur == d_erreur)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}
	}
	else
	{
		(*s_etat_processus).erreur_execution =
				d_ex_matrice_statistique_invalide;
		return;
	}

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

	return;
}


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

void
instruction_corr(struct_processus *s_etat_processus)
{
	logical1							erreur;
	logical1							presence_variable;

	long								i;

	struct_objet						*s_objet_statistique;
	struct_objet						*s_objet_resultat;

	unsigned long						nombre_colonnes;

	(*s_etat_processus).erreur_execution = d_ex;

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

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(corrélation)\n\n");
		}
		else
		{
			printf("(correlation)\n\n");
		}

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

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

	/*
	 * Recherche d'une variable globale référencée par SIGMA
	 */

	if (recherche_variable(s_etat_processus, ds_sdat) == d_faux)
	{
		/*
		 * Aucune variable SIGMA
		 */

		(*s_etat_processus).erreur_systeme = d_es;
		(*s_etat_processus).erreur_execution = d_ex_absence_observations;
		return;
	}
	else
	{
		/*
		 * Il existe une variable locale SIGMA. Reste à vérifier l'existence
		 * d'une variable SIGMA globale...
		 */

		i = (*s_etat_processus).position_variable_courante;
		presence_variable = d_faux;

		while(i >= 0)
		{
			if ((strcmp((*s_etat_processus).s_liste_variables[i].nom,
					ds_sdat) == 0) && ((*s_etat_processus)
					.s_liste_variables[i].niveau == 1))
			{
				presence_variable = d_vrai;
				break;
			}

			i--;
		}

		if (presence_variable == d_faux)
		{
			(*s_etat_processus).erreur_execution = d_ex_absence_observations;
			return;
		}
		else
		{
			(*s_etat_processus).position_variable_courante = i;

			if ((*s_etat_processus).s_liste_variables
					[(*s_etat_processus).position_variable_courante].objet
					== NULL)
			{
				(*s_etat_processus).erreur_execution = d_ex_variable_partagee;
				return;
			}

			if (((*((*s_etat_processus).s_liste_variables
					[(*s_etat_processus).position_variable_courante].objet))
					.type != MIN) && ((*((*s_etat_processus)
					.s_liste_variables[(*s_etat_processus)
					.position_variable_courante].objet)).type != MRL))
			{
				(*s_etat_processus).erreur_execution =
						d_ex_matrice_statistique_invalide;
				return;
			}

			nombre_colonnes = (*((struct_matrice *) (*((*s_etat_processus)
					.s_liste_variables[(*s_etat_processus)
					.position_variable_courante].objet)).objet))
					.nombre_colonnes;
		}
	}

	s_objet_statistique = ((*s_etat_processus).s_liste_variables
			[(*s_etat_processus).position_variable_courante]).objet;

	if (((*s_objet_statistique).type == MIN) ||
			((*s_objet_statistique).type == MRL))
	{
		if (((*s_etat_processus).colonne_statistique_1 < 1) ||
				((*s_etat_processus).colonne_statistique_2 < 1) ||
				((*s_etat_processus).colonne_statistique_1 > (long)
				nombre_colonnes) || ((*s_etat_processus).colonne_statistique_2
				> (long) nombre_colonnes))
		{
			(*s_etat_processus).erreur_execution =
					d_ex_observations_inexistantes;
			return;
		}

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

		(*((real8 *) (*s_objet_resultat).objet)) = correlation_statistique(
				(struct_matrice *) (*s_objet_statistique).objet,
				(*s_etat_processus).colonne_statistique_1,
				(*s_etat_processus).colonne_statistique_2, &erreur);

		if (erreur == d_erreur)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}
	}
	else
	{
		(*s_etat_processus).erreur_execution =
				d_ex_matrice_statistique_invalide;
		return;
	}

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

	return;
}


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

void
instruction_copyright(struct_processus *s_etat_processus)
{
#	include						"copyright-conv.h"

	(*s_etat_processus).erreur_execution = d_ex;

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

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(copyright)\n\n");
			printf("  Aucun argument\n");
		}
		else
		{
			printf("(copyright)\n\n");
			printf("  No argument\n");
		}

		return;
	}
	else if ((*s_etat_processus).test_instruction == 'Y')
	{
		(*s_etat_processus).nombre_arguments = -1;
		return;
	}
	
	printf("\n  RPL/2 (R) version %s\n", d_version_rpl);
	printf("%s\n", ((*s_etat_processus).langue == 'F' )
			? copyright : copyright_anglais);

	if ((*s_etat_processus).hauteur_pile_operationnelle == 0)
	{
		printf("\n");
	}

	return;
}


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

void
instruction_convert(struct_processus *s_etat_processus)
{
	file						*pipe;

	int							fin_fichier;

	logical1					last_valide;

	long						longueur_chaine;

	logical1					presence_resultat;

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

	unsigned char				*commande;
	unsigned char				*executable_candidat;
	unsigned char				ligne[1024 + 1];
	unsigned char				*tampon_instruction;

	(*s_etat_processus).erreur_execution = d_ex;

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

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(conversion d'unités)\n\n");
		}
		else
		{
			printf("(units conversion)\n\n");
		}

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

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

	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_1).type == CHN) &&
			((*s_objet_argument_2).type == CHN) &&
			(((*s_objet_argument_3).type == INT) ||
			((*s_objet_argument_3).type == REL)))
	{
		if ((*s_etat_processus).rpl_home == NULL)
		{
			longueur_chaine = strlen(ds_rplconvert_commande) - 9
					+ strlen((unsigned char *) (*s_objet_argument_1).objet)
					+ strlen((unsigned char *) (*s_objet_argument_2).objet)
					+ (2 * strlen(d_exec_path));

			if ((commande = malloc((longueur_chaine + 1) *
					sizeof(unsigned char))) == NULL)
			{
				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
				return;
			}

			sprintf(commande, ds_rplconvert_commande, d_exec_path, d_exec_path,
					(unsigned char *) (*s_objet_argument_2).objet,
					(unsigned char *) (*s_objet_argument_1).objet);

			if (alsprintf(&executable_candidat, "%s/bin/rplconvert",
					d_exec_path) < 0)
			{
				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
				return;
			}

			if (controle(s_etat_processus, executable_candidat, "md5",
					rplconvert_md5) != d_vrai)
			{
				(*s_etat_processus).erreur_systeme = d_es_somme_controle;
				return;
			}

			if (controle(s_etat_processus, executable_candidat, "sha1",
					rplconvert_sha1) != d_vrai)
			{
				(*s_etat_processus).erreur_systeme = d_es_somme_controle;
				return;
			}

			free(executable_candidat);
		}
		else
		{
			longueur_chaine = strlen(ds_rplconvert_commande) - 9
					+ strlen((unsigned char *) (*s_objet_argument_1).objet)
					+ strlen((unsigned char *) (*s_objet_argument_2).objet)
					+ (2 * strlen((*s_etat_processus).rpl_home));

			if ((commande = malloc((longueur_chaine + 1) *
					sizeof(unsigned char))) == NULL)
			{
				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
				return;
			}

			sprintf(commande, ds_rplconvert_commande,
					(*s_etat_processus).rpl_home, (*s_etat_processus).rpl_home,
					(unsigned char *) (*s_objet_argument_2).objet,
					(unsigned char *) (*s_objet_argument_1).objet);

			if (alsprintf(&executable_candidat, "%s/bin/rplconvert",
					(*s_etat_processus).rpl_home) < 0)
			{
				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
				return;
			}

			if (controle(s_etat_processus, executable_candidat, "md5",
					rplconvert_md5) != d_vrai)
			{
				(*s_etat_processus).erreur_systeme = d_es_somme_controle;
				return;
			}

			if (controle(s_etat_processus, executable_candidat, "sha1",
					rplconvert_sha1) != d_vrai)
			{
				(*s_etat_processus).erreur_systeme = d_es_somme_controle;
				return;
			}

			free(executable_candidat);
		}

		if ((pipe = popen(commande, "r")) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		free(commande);

		presence_resultat = d_faux;

		do
		{
			fin_fichier = fscanf(pipe, "%1024s", ligne);

			if (strcmp(ligne, "*") == 0)
			{
				fin_fichier = fscanf(pipe, "%1024s", ligne);

				if (fin_fichier != EOF)
				{
					presence_resultat = d_vrai;

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

					recherche_type(s_etat_processus);
					
					(*s_etat_processus).instruction_courante =
							tampon_instruction;

					if ((*s_etat_processus).erreur_execution != d_ex)
					{
						if (pclose(pipe) == -1)
						{
							(*s_etat_processus).erreur_systeme = d_es_processus;
							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;
					}
				}
			}
		} while(fin_fichier != EOF);

		/*
		 * Récupération de la ligne renvoyée commencant par "*". Si une telle
		 * ligne n'existe par, rplconvert retourne une erreur de type
		 * « conformability error » ou « Unknown unit ».
		 */

		if (pclose(pipe) == -1)
		{
			(*s_etat_processus).erreur_systeme = d_es_processus;
			return;
		}

		if (presence_resultat == d_faux)
		{
			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_conversion_unite;
			return;
		}
		
		/*
		 * Retrait des espaces dans la chaîne unité renvoyée
		 */

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

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

		instruction_multiplication(s_etat_processus);

		if (last_valide == d_vrai)
		{
			sf(s_etat_processus, 31);
		}
	}
	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);

	return;
}


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

void
instruction_close(struct_processus *s_etat_processus)
{
	const char					*queue;

	int							socket;

	logical1					socket_connectee;

	sqlite3_stmt				*ppStmt;

	struct_descripteur_fichier	*descripteur;

	struct_liste_chainee		*l_element_courant;
	struct_liste_chainee		*l_element_precedent;

	struct_objet				*s_objet_argument;

	(*s_etat_processus).erreur_execution = d_ex;

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

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(fermeture d'un fichier, d'une socket ou d'un sémaphore)"
					"\n\n");
		}
		else
		{
			printf("(close file, socket or semaphore)\n\n");
		}

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

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

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

		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 == FCH)
	{
		/*
		 * Retrait du descripteur de la pile de fichiers
		 */

		l_element_courant = (*s_etat_processus).s_fichiers;
		l_element_precedent = NULL;

		descripteur = NULL;

		while(l_element_courant != NULL)
		{
			if (((*((struct_descripteur_fichier *) (*l_element_courant).donnee))
					.identifiant == (*((struct_fichier *) (*s_objet_argument)
					.objet)).descripteur) && ((*((struct_descripteur_fichier *)
					(*l_element_courant).donnee)).pid == getpid()) &&
					(pthread_equal((*((struct_descripteur_fichier *)
					(*l_element_courant).donnee)).tid, pthread_self()) != 0))
			{
				if (((*((struct_fichier *) (*s_objet_argument).objet)).pid ==
						(*((struct_descripteur_fichier *) (*l_element_courant)
						.donnee)).pid) && (pthread_equal((*((struct_fichier *)
						(*s_objet_argument).objet)).tid,
						(*((struct_descripteur_fichier *) (*l_element_courant)
						.donnee)).tid) != 0))
				{
					descripteur = (struct_descripteur_fichier *)
							(*l_element_courant).donnee;

					if (l_element_precedent == NULL)
					{
						(*s_etat_processus).s_fichiers =
								(*l_element_courant).suivant;
					}
					else if ((*l_element_courant).suivant == NULL)
					{
						(*l_element_precedent).suivant = NULL;
					}
					else
					{
						(*l_element_precedent).suivant =
								(*l_element_courant).suivant;
					}

					free((*((struct_descripteur_fichier *)
							(*l_element_courant).donnee)).nom);
					free(l_element_courant);

					break;
				}
			}

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

		if (descripteur == NULL)
		{
			liberation(s_etat_processus, s_objet_argument);

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

		/*
		 * Fermeture du fichier
		 */

		if (fclose((*descripteur).descripteur_c) != 0)
		{
			free(descripteur);
			liberation(s_etat_processus, s_objet_argument);

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

		if ((*descripteur).type != 'C')
		{
			if (sqlite3_prepare_v2((*descripteur).descripteur_sqlite,
					"vacuum", 7, &ppStmt, &queue) != SQLITE_OK)
			{
				free(descripteur);
				liberation(s_etat_processus, s_objet_argument);

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

			if (sqlite3_step(ppStmt) != SQLITE_DONE)
			{
				free(descripteur);
				liberation(s_etat_processus, s_objet_argument);

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

			if (sqlite3_finalize(ppStmt) != SQLITE_OK)
			{
				free(descripteur);
				liberation(s_etat_processus, s_objet_argument);

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

			if (sqlite3_close((*descripteur).descripteur_sqlite) != SQLITE_OK)
			{
				free(descripteur);
				liberation(s_etat_processus, s_objet_argument);

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

			free(descripteur);
		}

		if ((*((struct_fichier *) (*s_objet_argument).objet)).ouverture == 'S')
		{
			if (destruction_fichier((*((struct_fichier *)
					(*s_objet_argument).objet)).nom) == d_erreur)
			{
				liberation(s_etat_processus, s_objet_argument);

				(*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
				return;
			}
		}
	}
	else if ((*s_objet_argument).type == SCK)
	{
		/*
		 * Retrait de la socket de la pile
		 */

		l_element_courant = (*s_etat_processus).s_sockets;
		l_element_precedent = NULL;

		socket = -1;
		socket_connectee = d_faux;

		while(l_element_courant != NULL)
		{
			if ((*((struct_socket *) (*(*l_element_courant).donnee).objet))
					.socket == (*((struct_socket *) (*s_objet_argument)
					.objet)).socket)
			{
				socket = (*((struct_socket *)
						(*(*l_element_courant).donnee).objet)).socket;
				socket_connectee = (*((struct_socket *)
						(*(*l_element_courant).donnee).objet)).socket_connectee;

				if (l_element_precedent == NULL)
				{
					(*s_etat_processus).s_sockets =
							(*l_element_courant).suivant;
				}
				else if ((*l_element_courant).suivant == NULL)
				{
					(*l_element_precedent).suivant = NULL;
				}
				else
				{
					(*l_element_precedent).suivant =
							(*l_element_courant).suivant;
				}

				liberation(s_etat_processus, (*l_element_courant).donnee);
				free(l_element_courant);

				break;
			}

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

		if (socket == -1)
		{
			liberation(s_etat_processus, s_objet_argument);

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

		/*
		 * Fermeture de la socket
		 */

		if (socket_connectee == d_vrai)
		{
			shutdown(socket, SHUT_RDWR);
		}

		if (close(socket) != 0)
		{
			liberation(s_etat_processus, s_objet_argument);

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

		if ((*((struct_socket *) (*s_objet_argument).objet)).effacement == 'Y')
		{
			unlink((*((struct_socket *) (*s_objet_argument).objet)).adresse);
		}
	}
	else if ((*s_objet_argument).type == SPH)
	{
		if (sem_close((*((struct_semaphore *) (*s_objet_argument).objet))
				.semaphore) != 0)
		{
			(*s_etat_processus).erreur_execution = d_ex_semaphore;
			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 'create'
================================================================================
  Entrées :
--------------------------------------------------------------------------------
  Sorties :
--------------------------------------------------------------------------------
  Effets de bord : néant
================================================================================
*/

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

	logical1					erreur;
	logical1					existence;
	logical1					ouverture;

	struct_objet				*s_objet_argument;

	unsigned char				*nom;

	unsigned long				unite;

	(*s_etat_processus).erreur_execution = d_ex;

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

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(création d'un fichier)\n\n");
		}
		else
		{
			printf("(create file)\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 ((nom = transliteration(s_etat_processus, (unsigned char *)
				(*s_objet_argument).objet, d_locale, "UTF-8")) == NULL)
		{
			liberation(s_etat_processus, s_objet_argument);
			return;
		}

		erreur = caracteristiques_fichier(s_etat_processus, nom,
				&existence, &ouverture, &unite);

		if ((erreur != d_absence_erreur) || (existence == d_vrai))
		{
			liberation(s_etat_processus, s_objet_argument);
			free(nom);

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

		if ((fichier = fopen(nom, "w")) == NULL)
		{
			liberation(s_etat_processus, s_objet_argument);
			free(nom);

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

		free(nom);

		if (fclose(fichier) != 0)
		{
			liberation(s_etat_processus, s_objet_argument);

			(*s_etat_processus).erreur_execution =
					d_ex_erreur_acces_fichier;
			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 'cswp'
================================================================================
  Entrées :
--------------------------------------------------------------------------------
  Sorties :
--------------------------------------------------------------------------------
  Effets de bord : néant
================================================================================
*/

void
instruction_cswp(struct_processus *s_etat_processus)
{
	struct_objet				*s_copie_argument_3;
	struct_objet				*s_objet_argument_1;
	struct_objet				*s_objet_argument_2;
	struct_objet				*s_objet_argument_3;

	signed long					colonne_1;
	signed long					colonne_2;

	unsigned long				i;

	(*s_etat_processus).erreur_execution = d_ex;

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

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(échange de deux colonnes d'une matrice)\n\n");
		}
		else
		{
			printf("(swap two columns of a matrix)\n\n");
		}

		printf("    3: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
		printf("    2: %s\n", d_INT);
		printf("    1: %s\n", d_INT);
		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, 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_1).type == INT) &&
			((*s_objet_argument_2).type == INT))
	{
		colonne_1 = (*((integer8 *) (*s_objet_argument_1).objet)) - 1;
		colonne_2 = (*((integer8 *) (*s_objet_argument_2).objet)) - 1;

		if ((*s_objet_argument_3).type == MIN)
		{
			if ((colonne_1 < 0) || (colonne_1 > ((signed long)
					(*((struct_matrice *) (*s_objet_argument_3).objet))
					.nombre_colonnes) - 1) || (colonne_2 < 0) || (colonne_2 >
					((signed long) (*((struct_matrice *)
					(*s_objet_argument_3).objet)).nombre_colonnes) - 1))
			{
				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_dimensions_invalides;
				return;
			}

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

			for(i = 0; i < (*((struct_matrice *) (*s_objet_argument_3).objet))
					.nombre_lignes; i++)
			{
				((integer8 **) (*((struct_matrice *)
						(*s_copie_argument_3).objet)).tableau)
						[i][colonne_1] = ((integer8 **) (*((struct_matrice *)
						(*s_objet_argument_3).objet)).tableau)[i][colonne_2];
				((integer8 **) (*((struct_matrice *)
						(*s_copie_argument_3).objet)).tableau)
						[i][colonne_2] = ((integer8 **) (*((struct_matrice *)
						(*s_objet_argument_3).objet)).tableau)[i][colonne_1];
			}
		}
		else if ((*s_objet_argument_3).type == MRL)
		{
			if ((colonne_1 < 0) || (colonne_1 > ((signed long)
					(*((struct_matrice *) (*s_objet_argument_3).objet))
					.nombre_colonnes) - 1) || (colonne_2 < 0) || (colonne_2 >
					((signed long) (*((struct_matrice *)
					(*s_objet_argument_3).objet)).nombre_colonnes) - 1))
			{
				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_dimensions_invalides;
				return;
			}

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

			for(i = 0; i < (*((struct_matrice *) (*s_objet_argument_3).objet))
					.nombre_lignes; i++)
			{
				((real8 **) (*((struct_matrice *)
						(*s_copie_argument_3).objet)).tableau)
						[i][colonne_1] = ((real8 **) (*((struct_matrice *)
						(*s_objet_argument_3).objet)).tableau)[i][colonne_2];
				((real8 **) (*((struct_matrice *)
						(*s_copie_argument_3).objet)).tableau)
						[i][colonne_2] = ((real8 **) (*((struct_matrice *)
						(*s_objet_argument_3).objet)).tableau)[i][colonne_1];
			}
		}
		else if ((*s_objet_argument_3).type == MCX)
		{
			if ((colonne_1 < 0) || (colonne_1 > ((signed long)
					(*((struct_matrice *) (*s_objet_argument_3).objet))
					.nombre_colonnes) - 1) || (colonne_2 < 0) || (colonne_2 >
					((signed long) (*((struct_matrice *)
					(*s_objet_argument_3).objet)).nombre_colonnes) - 1))
			{
				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_dimensions_invalides;
				return;
			}

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

			for(i = 0; i < (*((struct_matrice *) (*s_objet_argument_3).objet))
					.nombre_lignes; i++)
			{
				((complex16 **) (*((struct_matrice *)
						(*s_copie_argument_3).objet)).tableau)
						[i][colonne_1].partie_reelle =
						((complex16 **) (*((struct_matrice *)
						(*s_objet_argument_3).objet)).tableau)[i][colonne_2]
						.partie_reelle;
				((complex16 **) (*((struct_matrice *)
						(*s_copie_argument_3).objet)).tableau)
						[i][colonne_1].partie_imaginaire =
						((complex16 **) (*((struct_matrice *)
						(*s_objet_argument_3).objet)).tableau)[i][colonne_2]
						.partie_imaginaire;
				((complex16 **) (*((struct_matrice *)
						(*s_copie_argument_3).objet)).tableau)
						[i][colonne_2].partie_reelle =
						((complex16 **) (*((struct_matrice *)
						(*s_objet_argument_3).objet)).tableau)[i][colonne_1]
						.partie_reelle;
				((complex16 **) (*((struct_matrice *)
						(*s_copie_argument_3).objet)).tableau)
						[i][colonne_2].partie_imaginaire =
						((complex16 **) (*((struct_matrice *)
						(*s_objet_argument_3).objet)).tableau)[i][colonne_1]
						.partie_imaginaire;
			}
		}
		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;
		}
	}
	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);

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

	return;
}

// vim: ts=4