/*
================================================================================
  RPL/2 (R) version 4.0.17
  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 'spawn'
================================================================================
  Entrées :
--------------------------------------------------------------------------------
  Sorties :
--------------------------------------------------------------------------------
  Effets de bord : néant
================================================================================
*/

void
instruction_spawn(struct_processus *s_etat_processus)
{
	logical1					drapeau;
	logical1					variable_partagee;

	pthread_attr_t				attributs;

	pthread_mutexattr_t			attributs_mutex;

	pthread_t					thread_id;
	pthread_t					thread_surveillance;

	sigset_t					oldset;
	sigset_t					set;

	struct_descripteur_thread	*s_argument_thread;

	struct_liste_chainee		*l_element_courant;

	struct_objet				*s_copie;
	struct_objet				*s_objet;
	struct_objet				*s_objet_resultat;
	struct_objet				*s_objet_systeme;

	struct_processus			*s_nouvel_etat_processus;

	struct timespec				attente;

	(*s_etat_processus).erreur_execution = d_ex;

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

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(lancement d'un thread)\n\n");
		}
		else
		{
			printf("(create thread)\n\n");
		}

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

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

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

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

	/*
	 * Une routine fille doit pouvoir renvoyer des objets au processus
	 * père au travers de la fonction SEND. Il ne peut donc s'agir que
	 * d'une fonction ou d'une expression RPN.
	 */

	if (((*s_objet).type != NOM) && ((*s_objet).type != RPN))
	{
		liberation(s_etat_processus, s_objet);

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

	/*
	 * Si l'argument est de type NOM, il faut que la variable correspondante
	 * soit une variable de type RPN.
	 */

	variable_partagee = d_faux;
	s_copie = NULL;

	if ((*s_objet).type == NOM)
	{
		if (recherche_variable(s_etat_processus, (*((struct_nom *)
				(*s_objet).objet)).nom) == d_vrai)
		{
			if ((*s_etat_processus).s_liste_variables
					[(*s_etat_processus).position_variable_courante].objet
					== NULL)
			{
				if (pthread_mutex_lock(&((*(*s_etat_processus)
						.s_liste_variables_partagees).mutex)) != 0)
				{
					(*s_etat_processus).erreur_systeme = d_es_processus;
					return;
				}

				if (recherche_variable_partagee(s_etat_processus,
						(*s_etat_processus).s_liste_variables
						[(*s_etat_processus).position_variable_courante].nom,
						(*s_etat_processus).s_liste_variables
						[(*s_etat_processus).position_variable_courante]
						.variable_partagee, (*s_etat_processus)
						.s_liste_variables[(*s_etat_processus)
						.position_variable_courante].origine) == d_faux)
				{
					if (pthread_mutex_unlock(&((*(*s_etat_processus)
							.s_liste_variables_partagees).mutex)) != 0)
					{
						(*s_etat_processus).erreur_systeme = d_es_processus;
						return;
					}

					liberation(s_etat_processus, s_objet);

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

				if (((*(*(*s_etat_processus).s_liste_variables_partagees)
						.table[(*(*s_etat_processus)
						.s_liste_variables_partagees).position_variable].objet)
						.type != RPN) && ((*(*(*s_etat_processus)
						.s_liste_variables_partagees).table
						[(*(*s_etat_processus).s_liste_variables_partagees)
						.position_variable].objet).type != ADR))
				{
					if (pthread_mutex_unlock(&((*(*s_etat_processus)
							.s_liste_variables_partagees).mutex)) != 0)
					{
						(*s_etat_processus).erreur_systeme = d_es_processus;
						return;
					}

					liberation(s_etat_processus, s_objet);

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

				if ((s_copie = copie_objet(s_etat_processus,
						(*(*s_etat_processus)
						.s_liste_variables_partagees).table
						[(*(*s_etat_processus).s_liste_variables_partagees)
						.position_variable].objet, 'P')) == NULL)
				{
					if (pthread_mutex_unlock(&((*(*s_etat_processus)
							.s_liste_variables_partagees).mutex)) != 0)
					{
						(*s_etat_processus).erreur_systeme = d_es_processus;
						return;
					}

					(*s_etat_processus).erreur_systeme =
							d_es_allocation_memoire;

					return;
				}

				variable_partagee = d_vrai;

				if (pthread_mutex_unlock(&((*(*s_etat_processus)
						.s_liste_variables_partagees).mutex)) != 0)
				{
					(*s_etat_processus).erreur_systeme = d_es_processus;
					return;
				}
			}
			else
			{
				if (((*(*s_etat_processus).s_liste_variables
						[(*s_etat_processus).position_variable_courante].objet)
						.type != RPN) && ((*(*s_etat_processus)
						.s_liste_variables[(*s_etat_processus)
						.position_variable_courante].objet).type != ADR))
				{
					liberation(s_etat_processus, s_objet);

					(*s_etat_processus).erreur_execution =
							d_ex_argument_invalide;
					return;
				}
			}
		}
		else // Variable inexistante
		{
			liberation(s_etat_processus, s_objet);

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

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

	if (sigaddset(&set, SIGSTART) != 0)
	{
		(*s_etat_processus).erreur_systeme = d_es_processus;
		return;
	}

	/*
	 * Le signal SIGFSTOP doit être traité !
	 */

	if (sigaddset(&set, SIGFSTOP) != 0)
	{
		(*s_etat_processus).erreur_systeme = d_es_processus;
		return;
	}

	if (sigaddset(&set, SIGFABORT) != 0)
	{
		(*s_etat_processus).erreur_systeme = d_es_processus;
		return;
	}

	if (sigaddset(&set, SIGURG) != 0)
	{
		(*s_etat_processus).erreur_systeme = d_es_processus;
		return;
	}

	if (pthread_sigmask(SIG_BLOCK, &set, &oldset) != 0)
	{
		(*s_etat_processus).erreur_systeme = d_es_processus;
		return;
	}

	if ((s_argument_thread = malloc(sizeof(struct_descripteur_thread))) == NULL)
	{
		(*s_etat_processus).erreur_systeme = d_es_processus;
		return;
	}

	if (pipe((*s_argument_thread).pipe_erreurs) != 0)
	{
		(*s_etat_processus).erreur_systeme = d_es_processus;
		return;
	}

	if (pipe((*s_argument_thread).pipe_interruptions) != 0)
	{
		(*s_etat_processus).erreur_systeme = d_es_processus;
		return;
	}

	if (pipe((*s_argument_thread).pipe_nombre_interruptions_attente) != 0)
	{
		(*s_etat_processus).erreur_systeme = d_es_processus;
		return;
	}

	if (pipe((*s_argument_thread).pipe_objets) != 0)
	{
		(*s_etat_processus).erreur_systeme = d_es_processus;
		return;
	}

	if (pipe((*s_argument_thread).pipe_acquittement) != 0)
	{
		(*s_etat_processus).erreur_systeme = d_es_processus;
		return;
	}

	if (pipe((*s_argument_thread).pipe_nombre_objets_attente) != 0)
	{
		(*s_etat_processus).erreur_systeme = d_es_processus;
		return;
	}

	if (pipe((*s_argument_thread).pipe_injections) != 0)
	{
		(*s_etat_processus).erreur_systeme = d_es_processus;
		return;
	}

	if (pipe((*s_argument_thread).pipe_nombre_injections) != 0)
	{
		(*s_etat_processus).erreur_systeme = d_es_processus;
		return;
	}

	if ((s_nouvel_etat_processus = copie_etat_processus(s_etat_processus))
			== NULL)
	{
		return;
	}

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

	(*s_argument_thread).processus_detache = d_faux;
	(*s_argument_thread).thread_actif = d_faux;
	(*s_argument_thread).thread_pere = pthread_self();
	(*s_argument_thread).pid = getpid();

	(*s_nouvel_etat_processus).pipe_donnees =
			(*s_argument_thread).pipe_objets[1];
	(*s_nouvel_etat_processus).pipe_nombre_objets_attente =
			(*s_argument_thread).pipe_nombre_objets_attente[1];
	(*s_nouvel_etat_processus).pipe_interruptions =
			(*s_argument_thread).pipe_interruptions[1];
	(*s_nouvel_etat_processus).pipe_nombre_interruptions_attente =
			(*s_argument_thread).pipe_nombre_interruptions_attente[1];
	(*s_nouvel_etat_processus).pipe_injections =
			(*s_argument_thread).pipe_injections[0];
	(*s_nouvel_etat_processus).pipe_nombre_injections =
			(*s_argument_thread).pipe_nombre_injections[0];
	(*s_nouvel_etat_processus).pipe_acquittement =
			(*s_argument_thread).pipe_acquittement[0];
	(*s_nouvel_etat_processus).presence_pipes = d_vrai;

	(*s_nouvel_etat_processus).niveau_initial =
			(*s_etat_processus).niveau_courant;
	(*s_nouvel_etat_processus).debug_programme = d_faux;
	(*s_nouvel_etat_processus).nombre_objets_injectes = 0;
	(*s_nouvel_etat_processus).nombre_objets_envoyes_non_lus = 0;
	(*s_nouvel_etat_processus).temps_maximal_cpu = 0;
	(*s_nouvel_etat_processus).presence_fusible = d_faux;
	(*s_nouvel_etat_processus).thread_fusible = 0;

	(*s_nouvel_etat_processus).pile_profilage = NULL;
	(*s_nouvel_etat_processus).pile_profilage_fonctions = NULL;

	/*
	 * Lancement du thread fils et du thread de surveillance
	 */

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

	if (pthread_attr_setdetachstate(&attributs, PTHREAD_CREATE_JOINABLE) != 0)
	{
		(*s_etat_processus).erreur_systeme = d_es_processus;
		return;
	}

	if (pthread_attr_setschedpolicy(&attributs, SCHED_OTHER) != 0)
	{
		(*s_etat_processus).erreur_systeme = d_es_processus;
		return;
	}

	if (pthread_attr_setinheritsched(&attributs, PTHREAD_EXPLICIT_SCHED) != 0)
	{
		(*s_etat_processus).erreur_systeme = d_es_processus;
		return;
	}

	if (pthread_attr_setscope(&attributs, PTHREAD_SCOPE_SYSTEM) != 0)
	{
		(*s_etat_processus).erreur_systeme = d_es_processus;
		return;
	}

	/*
	 * Création de l'objet à retourner
	 */

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

	(*((struct_processus_fils *) (*s_objet_resultat).objet)).thread
			= s_argument_thread;

	(*(*((struct_processus_fils *) (*s_objet_resultat).objet)).thread)
			.nombre_objets_dans_pipe = 0;
	(*(*((struct_processus_fils *) (*s_objet_resultat).objet)).thread)
			.nombre_interruptions_dans_pipe = 0;
	(*(*((struct_processus_fils *) (*s_objet_resultat).objet)).thread)
			.nombre_references = 1;

	// Lancement du thread fils

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

	(*s_argument_thread).s_nouvel_etat_processus = s_nouvel_etat_processus;
	(*s_argument_thread).s_etat_processus = s_etat_processus;

	if (variable_partagee == d_vrai)
	{
		(*s_argument_thread).argument = s_copie;
		(*s_argument_thread).destruction_objet = d_vrai;
	}
	else
	{
		(*s_argument_thread).argument = s_objet;
		(*s_argument_thread).destruction_objet = d_faux;
	}

	(*s_argument_thread).set = set;
	(*s_argument_thread).oldset = oldset;
	(*s_argument_thread).thread_actif = d_faux;

	if (pthread_create(&thread_id, &attributs, lancement_thread,
			s_argument_thread) != 0)
	{
		(*s_etat_processus).erreur_systeme = d_es_processus;
		return;
	}

	attente.tv_sec = 0;
	attente.tv_nsec = GRANULARITE_us * 1000;

	while((*s_argument_thread).thread_actif == d_faux)
	{
		nanosleep(&attente, NULL);
		INCR_GRANULARITE(attente.tv_nsec);
	}

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

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

	if (pthread_attr_setdetachstate(&attributs,
			PTHREAD_CREATE_DETACHED) != 0)
	{
		(*s_etat_processus).erreur_systeme = d_es_processus;
		return;
	}

	if (pthread_attr_setschedpolicy(&attributs, SCHED_OTHER) != 0)
	{
		(*s_etat_processus).erreur_systeme = d_es_processus;
		return;
	}

	if (pthread_attr_setinheritsched(&attributs,
			PTHREAD_EXPLICIT_SCHED) != 0)
	{
		(*s_etat_processus).erreur_systeme = d_es_processus;
		return;
	}

	if (pthread_attr_setscope(&attributs, PTHREAD_SCOPE_SYSTEM) != 0)
	{
		(*s_etat_processus).erreur_systeme = d_es_processus;
		return;
	}

	// Attente de l'affectation de la grandeur processus.tid par le thread fils.

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

	/*
	 * On copie l'objet plutôt que le pointeur car cet objet peut être
	 * accédé depuis deux threads distincts et aboutir à un blocage lors d'une
	 * copie.
	 */

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

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

	// Si le tid existe déjà  dans la pile des processus, il s'agit forcement
	// d'un processus moribond. On attend donc qu'il soit effectivement
	// libéré.

	do
	{
		l_element_courant = (struct_liste_chainee *)
				(*s_etat_processus).l_base_pile_processus;
		drapeau = d_faux;

		attente.tv_sec = 0;
		attente.tv_nsec = GRANULARITE_us * 1000;

		while(l_element_courant != NULL)
		{
			if (((*(*((struct_processus_fils *)
					(*(*l_element_courant).donnee).objet)).thread)
					.processus_detache == d_faux) &&
					((*s_argument_thread).processus_detache == d_faux))
			{
				if (pthread_equal((*(*((struct_processus_fils *)
						(*(*l_element_courant).donnee).objet)).thread)
						.tid, (*s_argument_thread).tid) != 0)
				{
					if (pthread_mutex_unlock(&((*s_etat_processus).mutex)) != 0)
					{
						(*s_etat_processus).erreur_systeme = d_es_processus;
						return;
					}

					scrutation_injection(s_etat_processus);

					if ((*s_etat_processus).nombre_interruptions_non_affectees
							!= 0)
					{
						affectation_interruptions_logicielles(s_etat_processus);
					}

					if ((*s_etat_processus).nombre_interruptions_en_queue != 0)
					{
						traitement_interruptions_logicielles(s_etat_processus);
					}

					nanosleep(&attente, NULL);
					INCR_GRANULARITE(attente.tv_nsec);

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

					drapeau = d_vrai;
					break;
				}
			}

			l_element_courant = (*l_element_courant).suivant;
		}
	} while(drapeau == d_vrai);

	if (empilement(s_etat_processus,
			(struct_liste_chainee **) &((*s_etat_processus)
			.l_base_pile_processus), s_objet_systeme) == d_erreur)
	{
		pthread_mutex_unlock(&((*s_etat_processus).mutex));
		pthread_mutex_unlock(&((*s_nouvel_etat_processus).mutex));
		return;
	}

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

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

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

	if ((*s_argument_thread).thread_actif == d_faux)
	{
		// Le thread n'existe plus.

		pthread_join((*s_argument_thread).tid, NULL);
		pthread_mutex_unlock(&((*s_nouvel_etat_processus).mutex));
		pthread_mutex_unlock(&(*s_argument_thread).mutex);
		(*s_etat_processus).erreur_systeme = d_es_processus;
		return;
	}

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

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

	// Lancement du thread de surveillance

	if (pthread_create(&thread_surveillance, &attributs,
			surveillance_processus, s_argument_thread) != 0)
	{
		(*s_etat_processus).erreur_systeme = d_es_processus;
		return;
	}

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

	// Le fils peut être présent sans être en attente du signal de départ.

	if (pthread_kill((*s_argument_thread).tid, SIGSTART) != 0)
	{
		(*s_etat_processus).erreur_systeme = d_es_processus;
		return;
	}

	if (pthread_sigmask(SIG_SETMASK, &oldset, NULL) != 0)
	{
		(*s_etat_processus).erreur_systeme = d_es_processus;
		return;
	}

	sigpending(&set);

	return;
}


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

void
instruction_sqlconnect(struct_processus *s_etat_processus)
{
	struct_objet			*s_objet_argument;
	struct_objet			*s_objet_resultat;
	struct_objet			*s_objet_systeme;

	(*s_etat_processus).erreur_execution = d_ex;

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

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(connexion à une base de données SQL)\n\n");
		}
		else
		{
			printf("(connect to SQL database)\n\n");
		}

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

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

		printf("    { \"mysql\" \"server\" \"database\" "
				"\"user\" \"password\" } SQLCONNECT\n");
		printf("    { \"postgresql:iso-8859-1\" \"server\" "
				"\"database\" \"user\" \"password\" port }\n");
	   	printf("          SQLCONNECT\n");

		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 == LST)
	{
		if ((s_objet_resultat = parametres_sql(s_etat_processus,
				s_objet_argument)) == NULL)
		{
			liberation(s_etat_processus, s_objet_argument);
			return;
		}

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

		if (empilement(s_etat_processus,
				(struct_liste_chainee **) &((*s_etat_processus)
				.s_connecteurs_sql), s_objet_systeme) == d_erreur)
		{
			return;
		}

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

		liberation(s_etat_processus, s_objet_argument);
		return;
	}

	liberation(s_etat_processus, s_objet_argument);
	return;
}


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

void
instruction_sqldisconnect(struct_processus *s_etat_processus)
{
	logical1				drapeau;

	struct_liste_chainee	*l_element_courant;
	struct_liste_chainee	*l_element_precedent;

	struct_objet			*s_objet;

	(*s_etat_processus).erreur_execution = d_ex;

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

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(déconnexion d'une base de donnée SQL)\n\n");
		}
		else
		{
			printf("(disconnection from SQL database)\n\n");
		}

		printf("    1: %s\n", d_SQL);
		return;
	}
	else if ((*s_etat_processus).test_instruction == 'Y')
	{
		(*s_etat_processus).nombre_arguments = -1;
		return;
	}
	
	if (test_cfsf(s_etat_processus, 31) == d_vrai)
	{
		if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
		{
			return;
		}
	}

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

	if ((*s_objet).type == SQL)
	{
		if (((*((struct_connecteur_sql *) (*s_objet).objet)).pid !=
				getpid()) || (pthread_equal((*((struct_connecteur_sql *)
				(*s_objet).objet)).tid, pthread_self()) == 0))
		{
			(*s_etat_processus).erreur_execution = d_ex_fichier_hors_contexte;

			liberation(s_etat_processus, s_objet);
			return;
		}

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

		while(l_element_courant != NULL)
		{
			if (((*((struct_connecteur_sql *) (*(*l_element_courant).donnee)
					.objet)).pid == getpid()) && (pthread_equal(
					(*((struct_connecteur_sql *) (*(*l_element_courant).donnee)
					.objet)).tid, pthread_self()) != 0) &&
					(strcmp((*((struct_connecteur_sql *) (*(*l_element_courant)
					.donnee).objet)).type, (*((struct_connecteur_sql *)
					(*s_objet).objet)).type) == 0))
			{
				if (strcmp((*((struct_connecteur_sql *) (*s_objet).objet)).type,
						"MYSQL") == 0)
				{
#					ifdef MYSQL_SUPPORT
					if ((*((struct_connecteur_sql *) (*(*l_element_courant)
							.donnee).objet)).descripteur.mysql ==
							(*((struct_connecteur_sql *) (*s_objet).objet))
							.descripteur.mysql)
					{
						drapeau = d_vrai;
					}
					else
					{
						drapeau = d_faux;
					}
#					else

					if ((*s_etat_processus).langue == 'F')
					{
						printf("+++Attention : Support de MySQL "
								"non compilé !\n");
					}
					else
					{
						printf("+++Warning : MySQL support not available !\n");
					}

					fflush(stdout);

					drapeau = d_faux;
#					endif
				}
				else if (strcmp((*((struct_connecteur_sql *) (*s_objet).objet))
						.type, "POSTGRESQL") == 0)
				{
#					ifdef POSTGRESQL_SUPPORT
					if ((*((struct_connecteur_sql *) (*(*l_element_courant)
							.donnee).objet)).descripteur.postgresql ==
							(*((struct_connecteur_sql *) (*s_objet).objet))
							.descripteur.postgresql)
					{
						drapeau = d_vrai;
					}
					else
					{
						drapeau = d_faux;
					}

#					else

					if ((*s_etat_processus).langue == 'F')
					{
						printf("+++Attention : Support de PostgreSQL "
								"non compilé !\n");
					}
					else
					{
						printf("+++Warning : PostgreSQL support "
								"not available !\n");
					}

					fflush(stdout);

					drapeau = d_faux;
#					endif
				}
				else
				{
					BUG(1, printf("SQL type '%s' not allowed!",
							(*((struct_connecteur_sql *) (*s_objet).objet))
							.type));
					return;
				}

				if (drapeau == d_vrai)
				{
					if (l_element_precedent == NULL)
					{
						(*s_etat_processus).s_connecteurs_sql =
								(*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;
		}

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

		liberation(s_etat_processus, s_objet);
		return;
	}

	liberation(s_etat_processus, s_objet);
	return;
}


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

void
instruction_smphrincr(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  SMPHRINCR ");

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

		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 == SPH)
	{
		if (sem_post((*((struct_semaphore *) (*s_objet_argument).objet))
				.semaphore) != 0)
		{
			(*s_etat_processus).erreur_execution = d_ex_semaphore;

			liberation(s_etat_processus, s_objet_argument);
			return;
		}

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

		liberation(s_etat_processus, s_objet_argument);
		return;
	}

	return;
}


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

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

	unsigned char				*tampon;

	(*s_etat_processus).erreur_execution = d_ex;

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

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(decrémentation du sémaphore)\n\n");
		}
		else
		{
			printf("(semaphore decrementation)\n\n");
		}

		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 == SPH)
	{
		if ((*s_etat_processus).profilage == d_vrai)
		{
			if ((tampon = formateur(s_etat_processus, 0, s_objet_argument))
					== NULL)
			{
				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
				return;
			}

			profilage(s_etat_processus, tampon);
			free(tampon);

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

#		ifndef SEMAPHORES_NOMMES
		if (sem_post(&((*s_etat_processus).semaphore_fork)) != 0)
		{
			(*s_etat_processus).erreur_systeme = d_es_processus;
			return;
		}
#		else
		if (sem_post((*s_etat_processus).semaphore_fork) != 0)
		{
			(*s_etat_processus).erreur_systeme = d_es_processus;
			return;
		}
#		endif

		while(sem_wait((*((struct_semaphore *) (*s_objet_argument).objet))
				.semaphore) == -1)
		{
			if (errno != EINTR)
			{
				(*s_etat_processus).erreur_execution = d_ex_semaphore;

				if ((*s_etat_processus).profilage == d_vrai)
				{
					profilage(s_etat_processus, NULL);
				}

				liberation(s_etat_processus, s_objet_argument);
				return;
			}
		}

#		ifndef SEMAPHORES_NOMMES
		while(sem_wait(&((*s_etat_processus).semaphore_fork)) == -1)
#		else
		while(sem_wait((*s_etat_processus).semaphore_fork) == -1)
#		endif
		{
			if (errno != EINTR)
			{
				if ((*s_etat_processus).profilage == d_vrai)
				{
					profilage(s_etat_processus, NULL);
				}

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

		if ((*s_etat_processus).profilage == d_vrai)
		{
			profilage(s_etat_processus, NULL);
		}

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

		liberation(s_etat_processus, s_objet_argument);
		return;
	}

	return;
}


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

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

	unsigned char				*tampon;

	(*s_etat_processus).erreur_execution = d_ex;

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

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(essai de decrémentation du sémaphore)\n\n");
		}
		else
		{
			printf("(try to decremente semaphore)\n\n");
		}

		printf("    1: %s\n", d_SPH);
		printf("->  1: %s\n", d_INT);
		return;
	}
	else if ((*s_etat_processus).test_instruction == 'Y')
	{
		(*s_etat_processus).nombre_arguments = -1;
		return;
	}
	
	if (test_cfsf(s_etat_processus, 31) == d_vrai)
	{
		if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
		{
			return;
		}
	}

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

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

		if ((*s_etat_processus).profilage == d_vrai)
		{
			if ((tampon = formateur(s_etat_processus, 0, s_objet_argument))
					== NULL)
			{
				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
				return;
			}

			profilage(s_etat_processus, tampon);
			free(tampon);

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

#		ifndef SEMAPHORES_NOMMES
		if (sem_post(&((*s_etat_processus).semaphore_fork)) != 0)
		{
			(*s_etat_processus).erreur_systeme = d_es_processus;
			return;
		}
#		else
		if (sem_post((*s_etat_processus).semaphore_fork) != 0)
		{
			(*s_etat_processus).erreur_systeme = d_es_processus;
			return;
		}
#		endif

		(*((integer8 *) (*s_objet_resultat).objet)) = 0;

		while(sem_trywait((*((struct_semaphore *) (*s_objet_argument).objet))
				.semaphore) == -1)
		{
			switch(errno)
			{
				case EINTR :
				{
					break;
				}

				case EINVAL :
				{
					(*s_etat_processus).erreur_execution = d_ex_semaphore;

					if ((*s_etat_processus).profilage == d_vrai)
					{
						profilage(s_etat_processus, NULL);
					}

					liberation(s_etat_processus, s_objet_argument);
					return;
				}

				case EAGAIN :
				{
					(*((integer8 *) (*s_objet_resultat).objet)) = -1;
					break;
				}
			}

			if ((*((integer8 *) (*s_objet_resultat).objet)) != 0)
			{
				break;
			}
		}

#		ifndef SEMAPHORES_NOMMES
		while(sem_wait(&((*s_etat_processus).semaphore_fork)) == -1)
#		else
		while(sem_wait((*s_etat_processus).semaphore_fork) == -1)
#		endif
		{
			if (errno != EINTR)
			{
				if ((*s_etat_processus).profilage == d_vrai)
				{
					profilage(s_etat_processus, NULL);
				}

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

		if ((*s_etat_processus).profilage == d_vrai)
		{
			profilage(s_etat_processus, NULL);
		}

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

		liberation(s_etat_processus, s_objet_argument);
		return;
	}

	return;
}


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

void
instruction_smphrgetv(struct_processus *s_etat_processus)
{
	int							valeur;

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

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(valeur du sémaphore)\n\n");
		}
		else
		{
			printf("(semaphore value)\n\n");
		}

		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 == SPH)
	{
		if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;

			liberation(s_etat_processus, s_objet_argument);
			return;
		}

		if (sem_getvalue((*((struct_semaphore *) (*s_objet_argument).objet))
				.semaphore, &valeur) != 0)
		{
			(*s_etat_processus).erreur_execution = d_ex_semaphore;

			liberation(s_etat_processus, s_objet_argument);
			return;
		}

		(*((integer8 *) (*s_objet_resultat).objet)) = valeur;

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

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

		liberation(s_etat_processus, s_objet_argument);
		return;
	}

	return;
}


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

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

	(*s_etat_processus).erreur_execution = d_ex;

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

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(valeurs singulières)\n\n");
		}
		else
		{
			printf("(singular values)\n\n");
		}

		printf("    1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
		printf("->  1: %s\n", d_VRL);
		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) ||
			((*s_objet_argument).type == MCX))
	{
		if ((s_objet_resultat = allocation(s_etat_processus, VRL)) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		valeurs_singulieres(s_etat_processus, (*s_objet_argument).objet,
				NULL, (*s_objet_resultat).objet, NULL);

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

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

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

		liberation(s_etat_processus, s_objet_argument);
		return;
	}

	liberation(s_etat_processus, s_objet_argument);

	return;
}


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

void
instruction_svd(struct_processus *s_etat_processus)
{
	struct_objet				*s_objet_argument;
	struct_objet				*s_objet_resultat_1;
	struct_objet				*s_objet_resultat_2;
	struct_objet				*s_objet_resultat_3;

	struct_vecteur				s_vecteur;

	unsigned long				i;
	unsigned long				j;

	(*s_etat_processus).erreur_execution = d_ex;

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

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(décomposition en valeurs singulières)\n\n");
		}
		else
		{
			printf("(singular value decomposition)\n\n");
		}

		printf("    1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
		printf("->  3: %s, %s\n", d_MRL, d_MCX);
		printf("    2: %s, %s\n", d_MRL, d_MCX);
		printf("    1: %s\n", d_VRL);
		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))
	{
		if ((s_objet_resultat_1 = allocation(s_etat_processus, MRL)) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

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

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

		valeurs_singulieres(s_etat_processus, (*s_objet_argument).objet,
				(*s_objet_resultat_3).objet, &s_vecteur,
				(*s_objet_resultat_1).objet);

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

		if (((*s_etat_processus).erreur_execution != d_ex) ||
				((*s_etat_processus).exception != d_ep))
		{
			liberation(s_etat_processus, s_objet_resultat_1);
			liberation(s_etat_processus, s_objet_resultat_2);
			liberation(s_etat_processus, s_objet_resultat_3);
			liberation(s_etat_processus, s_objet_argument);
			return;
		}

		(*((struct_matrice *) (*s_objet_resultat_2).objet)).nombre_colonnes =
				(*((struct_matrice *) (*s_objet_argument).objet))
				.nombre_colonnes;
		(*((struct_matrice *) (*s_objet_resultat_2).objet)).nombre_lignes =
				(*((struct_matrice *) (*s_objet_argument).objet))
				.nombre_lignes;

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

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

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

		for(i = 0; i < s_vecteur.taille; i++)
		{
			((real8 **) (*((struct_matrice *) (*s_objet_resultat_2).objet))
			 		.tableau)[i][i] = ((real8 *) (s_vecteur.tableau))[i];
		}

		free(s_vecteur.tableau);

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

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

		if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
				s_objet_resultat_1) == d_erreur)
		{
			return;
		}
	}
	else if ((*s_objet_argument).type == MCX)
	{
		if ((s_objet_resultat_1 = allocation(s_etat_processus, MCX)) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

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

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

		valeurs_singulieres(s_etat_processus, (*s_objet_argument).objet,
				(*s_objet_resultat_3).objet, &s_vecteur,
				(*s_objet_resultat_1).objet);

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

		if (((*s_etat_processus).erreur_execution != d_ex) ||
				((*s_etat_processus).exception != d_ep))
		{
			liberation(s_etat_processus, s_objet_resultat_1);
			liberation(s_etat_processus, s_objet_resultat_2);
			liberation(s_etat_processus, s_objet_resultat_3);
			liberation(s_etat_processus, s_objet_argument);
			return;
		}

		(*((struct_matrice *) (*s_objet_resultat_2).objet)).nombre_colonnes =
				(*((struct_matrice *) (*s_objet_argument).objet))
				.nombre_colonnes;
		(*((struct_matrice *) (*s_objet_resultat_2).objet)).nombre_lignes =
				(*((struct_matrice *) (*s_objet_argument).objet))
				.nombre_lignes;

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

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

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

		for(i = 0; i < s_vecteur.taille; i++)
		{
			((real8 **) (*((struct_matrice *) (*s_objet_resultat_2).objet))
			 		.tableau)[i][i] = ((real8 *) (s_vecteur.tableau))[i];
		}

		free(s_vecteur.tableau);

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

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

		if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
				s_objet_resultat_1) == d_erreur)
		{
			return;
		}
	}
	else
	{
		(*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;

		liberation(s_etat_processus, s_objet_argument);
		return;
	}

	liberation(s_etat_processus, s_objet_argument);
	return;
}


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

void
instruction_swapcntxt(struct_processus *s_etat_processus)
{
	integer8					i;
	integer8					registre_taille;

	struct_liste_chainee		*l_element_courant;
	struct_liste_chainee		*l_element_courant_taille;
	struct_liste_chainee		*registre;

	struct_objet				*s_objet_argument;

	(*s_etat_processus).erreur_execution = d_ex;

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

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(échange de contextes)\n\n");
		}
		else
		{
			printf("(swap contexts)\n\n");
		}

		printf("    1: %s\n", d_INT);
		return;
	}
	else if ((*s_etat_processus).test_instruction == 'Y')
	{
		(*s_etat_processus).nombre_arguments = -1;
		return;
	}
	
	if (test_cfsf(s_etat_processus, 31) == d_vrai)
	{
		if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
		{
			return;
		}
	}

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

	if ((*s_objet_argument).type == INT)
	{
		l_element_courant = (*s_etat_processus).l_base_pile_contextes;
		l_element_courant_taille = (*s_etat_processus)
				.l_base_pile_taille_contextes;

		i = (*((integer8 *) (*s_objet_argument).objet));

		while((l_element_courant != NULL) && (l_element_courant_taille != NULL))
		{
			i--;

			if (i == 0)
			{
				break;
			}

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

		if ((l_element_courant == NULL) || (l_element_courant_taille == NULL))
		{
			liberation(s_etat_processus, s_objet_argument);

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

		if ((*(*l_element_courant).donnee).type != LST)
		{
			(*s_etat_processus).erreur_systeme = d_es_contexte;
			return;
		}

		if ((*(*l_element_courant_taille).donnee).type != INT)
		{
			(*s_etat_processus).erreur_systeme = d_es_contexte;
			return;
		}

		registre = (*s_etat_processus).l_base_pile;
		registre_taille = (*s_etat_processus).hauteur_pile_operationnelle;

		(*s_etat_processus).l_base_pile = (*(*l_element_courant).donnee).objet;
		(*s_etat_processus).hauteur_pile_operationnelle =
				(*((integer8 *) (*(*l_element_courant_taille).donnee).objet));

		(*(*l_element_courant).donnee).objet = registre;
		(*((integer8 *) (*(*l_element_courant_taille).donnee).objet)) =
				registre_taille;
	}
	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);
}

// vim: ts=4