/*
================================================================================
  RPL/2 (R) version 4.1.32
  Copyright (C) 1989-2020 Dr. BERTRAND Joël

  This file is part of RPL/2.

  RPL/2 is free software; you can redistribute it and/or modify it
  under the terms of the CeCILL V2 License as published by the french
  CEA, CNRS and INRIA.
 
  RPL/2 is distributed in the hope that it will be useful, but WITHOUT
  ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  FITNESS FOR A PARTICULAR PURPOSE.  See the CeCILL V2 License
  for more details.
 
  You should have received a copy of the CeCILL License
  along with RPL/2. If not, write to info@cecill.info.
================================================================================
*/


#include "rpl-conv.h"


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

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

	logical1					erreur;
	logical1					existence;
	logical1					ouverture;

	logical1					fin_fichier;

	long						position_courante;

	struct_descripteur_fichier	*dfichier;

	struct flock				lock;

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

	unsigned char				caractere;
	unsigned char				*nom;
	unsigned char				*requete;
	unsigned char				verrou;

	unsigned long				unite;

	(*s_etat_processus).erreur_execution = d_ex;

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

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(caractéristiques d'un fichier)\n\n");
		}
		else
		{
			printf("(file properties)\n\n");
		}

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

		if ((*s_etat_processus).langue == 'F')
		{
			printf("  Requêtes par descripteur :\n\n");
		}
		else
		{
			printf("  Queries by descriptor:\n\n");
		}

		printf("    END OF FILE    : %s (true/false)\n", d_INT);
		printf("    ACCESS         : %s (SEQUENTIAL/DIRECT/KEYED)\n", d_CHN);
		printf("    NAME           : %s\n", d_CHN);
		printf("    FORMATTED      : %s (true/false)\n", d_INT);
		printf("    KEY FIELD      : %s\n", d_INT);
		printf("    FORMAT         : %s\n", d_LST);
		printf("    PROTECTION     : %s (WRITEONLY/READONLY/READWRITE)\n\n",
				d_CHN);

		if ((*s_etat_processus).langue == 'F')
		{
			printf("  Requêtes par nom :\n\n");
		}
		else
		{
			printf("  Queries by name:\n\n");
		}

		printf("    EXISTENCE      : %s (true/false)\n", d_INT);
		printf("    LOCK           : %s (NONE/READ/WRITE)\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, 2) == d_erreur)
		{
			return;
		}
	}

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

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

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

	if ((*s_objet_argument_1).type != CHN)
	{
		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;
	}

	if ((requete = conversion_majuscule(s_etat_processus, (unsigned char *)
			(*s_objet_argument_1).objet)) == NULL)
	{
		(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
		return;
	}

	if ((*s_objet_argument_2).type == FCH)
	{
		/*
		 * La question porte sur un fichier ouvert.
		 */

		if (strcmp(requete, "END OF FILE") == 0)
		{
			if ((*((struct_fichier *) (*s_objet_argument_2).objet)).acces
					!= 'S')
			{
				liberation(s_etat_processus, s_objet_argument_1);
				liberation(s_etat_processus, s_objet_argument_2);

				free(requete);

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

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

			if ((dfichier = descripteur_fichier(s_etat_processus,
					(struct_fichier *) (*s_objet_argument_2).objet)) ==
					NULL)
			{
				return;
			}

			if ((*dfichier).type != 'C')
			{
				liberation(s_etat_processus, s_objet_argument_1);
				liberation(s_etat_processus, s_objet_argument_2);

				free(requete);

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

			if ((*((struct_fichier *) (*s_objet_argument_2).objet)).binaire
					!= 'F')
			{
				/*
				 * La fin du fichier renvoyée ne correspond pas à la fin
				 * physique du fichier mais à un défaut d'enregistrement.
				 */

				if ((position_courante = ftell((*dfichier).descripteur_c))
						== -1)
				{
					(*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
					return;
				}

				fin_fichier = d_vrai;

				while(feof((*dfichier).descripteur_c) == 0)
				{
					if (fread(&caractere, sizeof(unsigned char), (size_t) 1,
							(*dfichier).descripteur_c) > 0)
					{
						if (caractere == '{')
						{
							fin_fichier = d_faux;
							break;
						}
					}
				}

				if (fseek((*dfichier).descripteur_c, position_courante,
						SEEK_SET) != 0)
				{
					(*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
					return;
				}
			}
			else
			{
				// Fichier de type FLOW
				if (feof((*dfichier).descripteur_c) == 0)
				{
					fin_fichier = d_faux;
				}
				else
				{
					fin_fichier = d_vrai;
				}
			}

			if (fin_fichier == d_faux)
			{
				/*
				 * Fichier à suivre
				 */

				(*((integer8 *) (*s_objet_resultat).objet)) = 0;
			}
			else
			{
				/*
				 * Fin de fichier
				 */

				(*((integer8 *) (*s_objet_resultat).objet)) = -1;
			}
		}
		else if (strcmp(requete, "ACCESS") == 0)
		{
			if ((s_objet_resultat = allocation(s_etat_processus, CHN))
					== NULL)
			{
				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
				return;
			}

			if ((*((struct_fichier *) (*s_objet_argument_2).objet)).acces
					== 'S')
			{
				if (((*s_objet_resultat).objet = malloc(11 *
						sizeof(unsigned char))) == NULL)
				{
					(*s_etat_processus).erreur_systeme =
							d_es_allocation_memoire;
					return;
				}

				strcpy((unsigned char *) (*s_objet_resultat).objet,
						"SEQUENTIAL");
			}
			else if ((*((struct_fichier *) (*s_objet_argument_2).objet)).acces
					== 'D')
			{
				if (((*s_objet_resultat).objet = malloc(7 *
						sizeof(unsigned char))) == NULL)
				{
					(*s_etat_processus).erreur_systeme =
							d_es_allocation_memoire;
					return;
				}

				strcpy((unsigned char *) (*s_objet_resultat).objet,
						"DIRECT");
			}
			else
			{
				if (((*s_objet_resultat).objet = malloc(6 *
						sizeof(unsigned char))) == NULL)
				{
					(*s_etat_processus).erreur_systeme =
							d_es_allocation_memoire;
					return;
				}

				strcpy((unsigned char *) (*s_objet_resultat).objet,
						"KEYED");
			}
		}
		else if (strcmp(requete, "NAME") == 0)
		{
			if ((s_objet_resultat = allocation(s_etat_processus, CHN))
					== NULL)
			{
				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
				return;
			}

			if (((*s_objet_resultat).objet = malloc(
					(strlen((*((struct_fichier *) (*s_objet_argument_2).objet))
					.nom) + 1) *
					sizeof(unsigned char))) == NULL)
			{
				(*s_etat_processus).erreur_systeme =
						d_es_allocation_memoire;
				return;
			}

			strcpy((unsigned char *) (*s_objet_resultat).objet,
					(*((struct_fichier *) (*s_objet_argument_2).objet)).nom);
		}
		else if (strcmp(requete, "FORMATTED") == 0)
		{
			if ((s_objet_resultat = allocation(s_etat_processus, INT))
					== NULL)
			{
				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
				return;
			}

			(*((integer8 *) (*s_objet_resultat).objet)) =
					((*((struct_fichier *) (*s_objet_argument_2).objet)).binaire
					== 'N') ? -1 : 0;
		}
		else if (strcmp(requete, "KEY FIELD") == 0)
		{
			if ((*((struct_fichier *) (*s_objet_argument_2).objet))
					.acces == 'S')
			{
				free(requete);

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

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

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

			(*((integer8 *) (*s_objet_resultat).objet)) =
					(*((struct_fichier *) (*s_objet_argument_2).objet))
					.position_clef;
		}
		else if (strcmp(requete, "PROTECTION") == 0)
		{
			if ((s_objet_resultat = allocation(s_etat_processus, CHN))
					== NULL)
			{
				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
				return;
			}

			if ((*((struct_fichier *) (*s_objet_argument_2).objet)).protection
					== 'W')
			{
				if (((*s_objet_resultat).objet = malloc(10 *
						sizeof(unsigned char))) == NULL)
				{
					(*s_etat_processus).erreur_systeme =
							d_es_allocation_memoire;
					return;
				}

				strcpy((unsigned char *) (*s_objet_argument_2).objet,
						"WRITEONLY");
			}
			else if ((*((struct_fichier *) (*s_objet_argument_2).objet)).acces
					== 'R')
			{
				if (((*s_objet_resultat).objet = malloc(9 *
						sizeof(unsigned char))) == NULL)
				{
					(*s_etat_processus).erreur_systeme =
							d_es_allocation_memoire;
					return;
				}

				strcpy((unsigned char *) (*s_objet_argument_2).objet,
						"READONLY");
			}
			else
			{
				if (((*s_objet_resultat).objet = malloc(10 *
						sizeof(unsigned char))) == NULL)
				{
					(*s_etat_processus).erreur_systeme =
							d_es_allocation_memoire;
					return;
				}

				strcpy((unsigned char *) (*s_objet_resultat).objet,
						"READWRITE");
			}
		}
		else if (strcmp(requete, "FORMAT") == 0)
		{
			if ((s_objet_resultat = copie_objet(s_etat_processus,
					(*((struct_fichier *) (*s_objet_argument_2).objet)).format,
					'O')) == NULL)
			{
				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
				return;
			}
		}
		else
		{
			free(requete);

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

			(*s_etat_processus).erreur_execution = d_ex_erreur_requete_fichier;
			return;
		}
	}
	else if ((*s_objet_argument_2).type == CHN)
	{
		/*
		 * La question porte sur un fichier fermé.
		 */

		if ((nom = transliteration(s_etat_processus,
				(unsigned char *) (*s_objet_argument_2).objet,
				d_locale, "UTF-8")) == NULL)
		{
			liberation(s_etat_processus, s_objet_argument_1);
			liberation(s_etat_processus, s_objet_argument_2);
			return;
		}

		if (strcmp(requete, "EXISTENCE") == 0)
		{
			erreur = caracteristiques_fichier(s_etat_processus, nom,
					&existence, &ouverture, &unite);

			if (erreur != d_absence_erreur)
			{
				free(nom);
				free(requete);

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

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

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

			if (existence == d_faux)
			{
				/*
				 * Fichier inexistant
				 */

				(*((integer8 *) (*s_objet_resultat).objet)) = 0;
			}
			else
			{
				/*
				 * Fichier existant
				 */

				(*((integer8 *) (*s_objet_resultat).objet)) = -1;
			}
		}
		else if (strcmp(requete, "LOCK") == 0)
		{
			erreur = caracteristiques_fichier(s_etat_processus, nom,
					&existence, &ouverture, &unite);

			if (erreur != d_absence_erreur)
			{
				free(requete);
				free(nom);

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

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

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

			if (existence == d_faux)
			{
				/*
				 * Fichier inexistant
				 */

				free(requete);
				free(nom);

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

				(*s_etat_processus).erreur_execution =
						d_ex_erreur_acces_fichier;
				return;
			}
			else
			{
				/*
				 * Fichier existant
				 */

				if ((fichier = fopen(nom, "r+")) == NULL)
				{
					free(requete);
					free(nom);

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

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

				lock.l_whence = SEEK_SET;
				lock.l_start = 0;
				lock.l_len = 0;
				lock.l_pid = getpid();
				lock.l_type = F_RDLCK;

				if (fcntl(fileno(fichier), F_GETLK, &lock) == -1)
				{
					free(nom);

					if (fclose(fichier) != 0)
					{
						free(requete);

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

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

					free(requete);

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

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

				if (lock.l_type == F_UNLCK)
				{
					verrou = 'N';
				}
				else
				{
					verrou = 'R';
				}

				if (verrou == 'N')
				{
					lock.l_type = F_WRLCK;

					if (fcntl(fileno(fichier), F_GETLK, &lock) == -1)
					{
						free(nom);

						if (fclose(fichier) != 0)
						{
							free(requete);

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

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

						free(requete);

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

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

					if (lock.l_type == F_UNLCK)
					{
						verrou = 'N';
					}
					else
					{
						verrou = 'W';
					}
				}

				switch(verrou)
				{
					case 'N' :
					{
						if (((*s_objet_resultat).objet =
								malloc(5 * sizeof(unsigned char))) == NULL)
						{
							(*s_etat_processus).erreur_systeme =
									d_es_allocation_memoire;
							return;
						}

						strcpy((unsigned char *) (*s_objet_resultat).objet,
								"NONE");

						break;
					}

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

						strcpy((unsigned char *) (*s_objet_resultat).objet,
								"READ");

						break;
					}

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

						strcpy((unsigned char *) (*s_objet_resultat).objet,
								"WRITE");

						break;
					}
				}

				if (fclose(fichier) != 0)
				{
					free(requete);
					free(nom);

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

					(*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
					return;
				}
			}
		}
		else
		{
			free(nom);
			free(requete);

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

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

		free(nom);
	}
	else
	{
		free(requete);

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

	free(requete);

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

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

	return;
}


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

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

	logical1					presence_longueur_dft;

	integer8					longueur_dft_signee;

	struct_complexe16			*matrice_f77;

	struct_objet				*s_objet_argument;
	struct_objet				*s_objet_longueur_dft;
	struct_objet				*s_objet_resultat;

	integer8					i;
	integer8					j;
	integer8					k;
	integer8					longueur_dft;

	(*s_etat_processus).erreur_execution = d_ex;

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

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

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

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

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

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

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

	/*
	 * Il est possible d'imposer une longueur de DFT au premier niveau
	 * de la pile.
	 */

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

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

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

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

		longueur_dft_signee = (*((integer8 *) (*s_objet_longueur_dft).objet));

		liberation(s_etat_processus, s_objet_longueur_dft);

		if (longueur_dft_signee <= 0)
		{
			(*s_etat_processus).erreur_execution = d_ex_longueur_dft;
			return;
		}

		longueur_dft = longueur_dft_signee;
	}
	else
	{
		presence_longueur_dft = d_faux;
		longueur_dft = 0;

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

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

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

	if (((*s_objet_argument).type == VIN) ||
			((*s_objet_argument).type == VRL) ||
			((*s_objet_argument).type == VCX))
	{
		if (presence_longueur_dft == d_faux)
		{
			longueur_dft = (*((struct_vecteur *)
					(*s_objet_argument).objet)).taille;
		}

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

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

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

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

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

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

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

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

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

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

	else if (((*s_objet_argument).type == MIN) ||
			((*s_objet_argument).type == MRL) ||
			((*s_objet_argument).type == MCX))
	{
		if (presence_longueur_dft == d_faux)
		{
			longueur_dft = (*((struct_matrice *)
					(*s_objet_argument).objet)).nombre_colonnes;
		}

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

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

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

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

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

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

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

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

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

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

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

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

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

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

		free(matrice_f77);
	}

/*
--------------------------------------------------------------------------------
  Calcul de DFT impossible
--------------------------------------------------------------------------------
*/

	else
	{
		liberation(s_etat_processus, s_objet_argument);

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

	liberation(s_etat_processus, s_objet_argument);

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

	return;
}


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

void
instruction_iswi(struct_processus *s_etat_processus)
{
	(*s_etat_processus).erreur_execution = d_ex;

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

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(autorise le traitement interruptif des interruptions)"
					"\n\n");
			printf("  Aucun argument\n");
		}
		else
		{
			printf("(authorize interrupts called from interrupts)\n\n");
			printf("  No argument\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, 0) == d_erreur)
		{
			return;
		}
	}

	if ((*s_etat_processus).traitement_interruption == 'Y')
	{
		(*s_etat_processus).traitement_interruption = 'N';
	}
	else
	{
		(*s_etat_processus).erreur_execution = d_ex_iswi_hors_interruption;
	}

	return;
}


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

void
instruction_itrace(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  ITRACE ");

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

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

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

		printf("    0000    : none\n");
		printf("    0001    : user stack\n");
		printf("    0002    : system stack\n");
		printf("    0004    : function calls\n");
		printf("    0008    : process management\n");
		printf("    0010    : analyze\n");
		printf("    0020    : fuse management\n");
		printf("    0040    : variables management\n");
		printf("    0080    : intrinsic functions\n");
		printf("    0100    : execution levels\n");
		printf("    0200    : algebraic to RPN conversion\n");
		printf("    0400    : interruptions supervision\n");
		printf("    0800    : signals\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 == BIN)
	{
		if ((*((logical8 *) (*s_objet_argument).objet)) == 0)
		{
			(*s_etat_processus).debug = d_faux;
			(*s_etat_processus).type_debug = 0;
		}
		else
		{
			(*s_etat_processus).debug = d_vrai;
			(*s_etat_processus).type_debug = (*((logical8 *)
					(*s_objet_argument).objet));
		}
	}
	else
	{
		(*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
		liberation(s_etat_processus, s_objet_argument);
	}

	return;
}


// vim: ts=4