/*
================================================================================
  RPL/2 (R) version 4.1.7
  Copyright (C) 1989-2012 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 'clmf'
================================================================================
  Entrées : structure processus
--------------------------------------------------------------------------------
  Sorties :
--------------------------------------------------------------------------------
  Effets de bord : néant
================================================================================
*/

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

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

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(affiche la pile opérationnelle)\n\n");
			printf("  Aucun argument\n");
		}
		else
		{
			printf("(print stack)\n\n");
			printf("  No argument\n");
		}

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

	affichage_pile(s_etat_processus, (*s_etat_processus).l_base_pile, 1);

	return;
}


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

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

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

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(continue un programme arrêté par HALT)\n\n");
			printf("  Aucun argument\n");
		}
		else
		{
			printf("(continue a program stopped by HALT)\n\n");
			printf("  No argument\n");
		}

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

	(*s_etat_processus).debug_programme = d_faux;
	(*s_etat_processus).execution_pas_suivant = d_vrai;

	return;
}


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

void
instruction_cnrm(struct_processus *s_etat_processus)
{
	integer8					cumul_entier;
	integer8					entier_courant;
	integer8					tampon;

	logical1					depassement;
	logical1					erreur_memoire;

	real8						cumul_reel;

	struct_objet				*s_objet_argument;
	struct_objet				*s_objet_resultat;

	unsigned long				i;
	unsigned long				j;

	void						*accumulateur;

	(*s_etat_processus).erreur_execution = d_ex;

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

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(norme de colonne)\n\n");
		}
		else
		{
			printf("(column norm)\n\n");
		}

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

		printf("    1: %s, %s, %s, %s\n", d_VRL, d_VCX, d_MRL, d_MCX);
		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, 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;
	}

/*
--------------------------------------------------------------------------------
  Traitement des vecteurs
--------------------------------------------------------------------------------
*/

	if ((*s_objet_argument).type == VIN)
	{
		cumul_entier = 0;
		depassement = d_faux;

		for(i = 0; i < (*((struct_vecteur *) (*s_objet_argument).objet)).taille;
				i++)
		{
			entier_courant = abs(((integer8 *) (*((struct_vecteur *)
					(*s_objet_argument).objet)).tableau)[i]);

			if (depassement_addition(&cumul_entier, &entier_courant,
					&tampon) == d_erreur)
			{
				depassement = d_vrai;
				break;
			}

			cumul_entier = tampon;
		}

		if (depassement == d_faux)
		{
			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)) = cumul_entier;
		}
		else
		{
			cumul_reel = 0;

			for(i = 0; i < (*((struct_vecteur *) (*s_objet_argument).objet))
					.taille; i++)
			{
				cumul_reel += (real8) abs(((integer8 *) (*((struct_vecteur *)
						(*s_objet_argument).objet)).tableau)[i]);
			}

			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)) = cumul_reel;
		}
	}
	else if ((*s_objet_argument).type == VRL)
	{
		if ((s_objet_resultat = allocation(s_etat_processus, REL))
				== NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		if ((accumulateur = malloc((*((struct_vecteur *)
				(*s_objet_argument).objet)).taille * sizeof(real8))) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		for(i = 0; i < (*((struct_vecteur *) (*s_objet_argument).objet)).taille;
				i++)
		{
			((real8 *) accumulateur)[i] =
					fabs(((real8 *) (*((struct_vecteur *)
					(*s_objet_argument).objet)).tableau)[i]);
		}

		(*((real8 *) (*s_objet_resultat).objet)) = sommation_vecteur_reel(
				accumulateur, &((*((struct_vecteur *) (*s_objet_argument)
				.objet)).taille), &erreur_memoire);

		if (erreur_memoire == d_vrai)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

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

		if ((accumulateur = malloc((*((struct_vecteur *)
				(*s_objet_argument).objet)).taille * sizeof(real8))) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		for(i = 0; i < (*((struct_vecteur *) (*s_objet_argument).objet)).taille;
				i++)
		{
			f77absc_(&(((struct_complexe16 *) (*((struct_vecteur *)
					(*s_objet_argument).objet)).tableau)[i]),
					&(((real8 *) accumulateur)[i]));
		}

		(*((real8 *) (*s_objet_resultat).objet)) = sommation_vecteur_reel(
				accumulateur, &((*((struct_vecteur *) (*s_objet_argument)
				.objet)).taille), &erreur_memoire);

		if (erreur_memoire == d_vrai)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		free(accumulateur);
	}

/*
--------------------------------------------------------------------------------
  Traitement des matrices
--------------------------------------------------------------------------------
*/

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

		depassement = d_faux;
		cumul_entier = 0;
		
		for(i = 0; i < (*((struct_matrice *) (*s_objet_argument).objet))
				.nombre_lignes; i++)
		{
			entier_courant = abs(((integer8 **)
					(*((struct_matrice *) (*s_objet_argument).objet))
					.tableau)[i][0]);

			if (depassement_addition(&cumul_entier, &entier_courant,
					&tampon) == d_erreur)
			{
				depassement = d_vrai;
				break;
			}

			cumul_entier = tampon;
		}

		if (depassement == d_faux)
		{
			(*((integer8 *) (*s_objet_resultat).objet)) = cumul_entier;

			for(j = 1; j < (*((struct_matrice *) (*s_objet_argument).objet))
					.nombre_colonnes; j++)
			{
				cumul_entier = 0;

				for(i = 0; i < (*((struct_matrice *) (*s_objet_argument).objet))
						.nombre_lignes; i++)
				{
					entier_courant = abs(((integer8 **) (*((struct_matrice *)
							(*s_objet_argument).objet)).tableau)[i][j]);

					if (depassement_addition(&cumul_entier, &entier_courant,
							&tampon) == d_erreur)
					{
						depassement = d_vrai;
						break;
					}

					cumul_entier = tampon;
				}

				if (depassement == d_vrai)
				{
					break;
				}

				if (cumul_entier > (*((integer8 *) (*s_objet_resultat).objet)))
				{
					(*((integer8 *) (*s_objet_resultat).objet)) = cumul_entier;
				}
			}
		}

		if (depassement == d_vrai)
		{
			/*
			 * Dépassement : il faut refaire le calcul en real*8...
			 */

			free((*s_objet_resultat).objet);
			(*s_objet_resultat).type = REL;

			if (((*s_objet_resultat).objet = malloc(sizeof(real8))) == NULL)
			{
				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
				return;
			}

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

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

				cumul_reel = sommation_vecteur_reel(accumulateur,
						&((*((struct_matrice *) (*s_objet_argument).objet))
						.nombre_lignes), &erreur_memoire);

				if (erreur_memoire == d_vrai)
				{
					(*s_etat_processus).erreur_systeme =
							d_es_allocation_memoire;
					return;
				}

				if (cumul_reel > (*((real8 *) (*s_objet_resultat).objet)))
				{
					(*((real8 *) (*s_objet_resultat).objet)) = cumul_reel;
				}
			}

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

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

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

			cumul_reel = sommation_vecteur_reel(accumulateur,
					&((*((struct_matrice *) (*s_objet_argument).objet))
					.nombre_lignes), &erreur_memoire);

			if (erreur_memoire == d_vrai)
			{
				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
				return;
			}

			if (cumul_reel > (*((real8 *) (*s_objet_resultat).objet)))
			{
				(*((real8 *) (*s_objet_resultat).objet)) = cumul_reel;
			}
		}

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

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

		(*((real8 *) (*s_objet_resultat).objet)) = 0;
		
		for(j = 0; j < (*((struct_matrice *) (*s_objet_argument).objet))
				.nombre_colonnes; j++)
		{
			for(i = 0; i < (*((struct_matrice *) (*s_objet_argument).objet))
					.nombre_lignes; i++)
			{
				f77absc_(&(((struct_complexe16 **) (*((struct_matrice *)
						(*s_objet_argument).objet)).tableau)[i][j]),
						&(((real8 *) accumulateur)[i]));
			}

			cumul_reel = sommation_vecteur_reel(accumulateur,
					&((*((struct_matrice *) (*s_objet_argument).objet))
					.nombre_lignes), &erreur_memoire);

			if (erreur_memoire == d_vrai)
			{
				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
				return;
			}

			if (cumul_reel > (*((real8 *) (*s_objet_resultat).objet)))
			{
				(*((real8 *) (*s_objet_resultat).objet)) = cumul_reel;
			}
		}

		free(accumulateur);
	}

/*
--------------------------------------------------------------------------------
  Traitement impossible du fait du type de l'argument
--------------------------------------------------------------------------------
*/

	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 'chr'
================================================================================
  Entrées : structure processus
--------------------------------------------------------------------------------
  Sorties :
--------------------------------------------------------------------------------
  Effets de bord : néant
================================================================================
*/

void
instruction_chr(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  CHR ");

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(conversion d'un entier en caractère)\n\n");
		}
		else
		{
			printf("(integer to character conversion)\n\n");
		}

		printf("    1: %s\n", d_INT);
		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;
	}

/*
--------------------------------------------------------------------------------
  Entier
--------------------------------------------------------------------------------
*/

	if ((*s_objet_argument).type == INT)
	{
		if ((*((integer8 *) (*s_objet_argument).objet)) !=
				(unsigned char) (*((integer8 *) (*s_objet_argument).objet)))
		{
			liberation(s_etat_processus, s_objet_argument);

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

		if (isprint((unsigned char) (*((integer8 *) (*s_objet_argument).objet)))
				!= 0)
		{
			if ((s_objet_resultat = allocation(s_etat_processus, CHN)) == NULL)
			{
				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
				return;
			}

			if ((*((integer8 *) (*s_objet_argument).objet)) == '\\')
			{
				if (((*s_objet_resultat).objet = malloc(3 *
						sizeof(unsigned char))) == NULL)
				{
					(*s_etat_processus).erreur_systeme =
							d_es_allocation_memoire;
					return;
				}

				((unsigned char *) (*s_objet_resultat).objet)[0] = '\\';
				((unsigned char *) (*s_objet_resultat).objet)[1] = '\\';
				((unsigned char *) (*s_objet_resultat).objet)[2] =
						d_code_fin_chaine;
			}
			else if ((*((integer8 *) (*s_objet_argument).objet)) == '"')
			{
				if (((*s_objet_resultat).objet = malloc(3 *
						sizeof(unsigned char))) == NULL)
				{
					(*s_etat_processus).erreur_systeme =
							d_es_allocation_memoire;
					return;
				}

				((unsigned char *) (*s_objet_resultat).objet)[0] = '\\';
				((unsigned char *) (*s_objet_resultat).objet)[1] = '"';
				((unsigned char *) (*s_objet_resultat).objet)[2] =
						d_code_fin_chaine;
			}
			else
			{
				if (((*s_objet_resultat).objet = malloc(2 *
						sizeof(unsigned char))) == NULL)
				{
					(*s_etat_processus).erreur_systeme =
							d_es_allocation_memoire;
					return;
				}

				((unsigned char *) (*s_objet_resultat).objet)[0] =
						(*((integer8 *) (*s_objet_argument).objet));
				((unsigned char *) (*s_objet_resultat).objet)[1] =
						d_code_fin_chaine;
			}
		}
		else
		{
			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(5 * sizeof(unsigned char)))
					== NULL)
			{
				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
				return;
			}

			sprintf((unsigned char *) (*s_objet_resultat).objet, "\\x%02X",
					(unsigned char) (*((integer8 *)
					(*s_objet_argument).objet)));
		}
	}

/*
--------------------------------------------------------------------------------
  Type invalide
--------------------------------------------------------------------------------
*/

	else
	{
		liberation(s_etat_processus, s_objet_argument);

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

	liberation(s_etat_processus, s_objet_argument);

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

	return;
}


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

void
instruction_cr(struct_processus *s_etat_processus)
{
	struct_objet				s_objet;

	unsigned char				commande[] = "\\\\par";

	(*s_etat_processus).erreur_execution = d_ex;

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

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(retour à la ligne dans la sortie imprimée)\n\n");
			printf("  Aucun argument\n");
		}
		else
		{
			printf("(carriage return in the printer output)\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;
		}
	}

	s_objet.objet = commande;
	s_objet.type = CHN;

	formateur_tex(s_etat_processus, &s_objet, 'N');
	return;
}


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

void
instruction_centr(struct_processus *s_etat_processus)
{
	real8						x_max;
	real8						x_min;
	real8						y_max;
	real8						y_min;

	struct_objet				*s_objet_argument;

	(*s_etat_processus).erreur_execution = d_ex;


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

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(centre des graphiques)\n\n");
		}
		else
		{
			printf("(center of the graphics)\n\n");
		}

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

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

	if (test_cfsf(s_etat_processus, 31) == d_vrai)
	{
		if (empilement_pile_last(s_etat_processus, 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 == CPL)
	{
		if ((*s_etat_processus).systeme_axes == 0)
		{
			x_min = (*s_etat_processus).x_min;
			x_max = (*s_etat_processus).x_max;

			y_min = (*s_etat_processus).y_min;
			y_max = (*s_etat_processus).y_max;

			(*s_etat_processus).x_min = (*((complex16 *)
					(*s_objet_argument).objet))
					.partie_reelle - ((x_max - x_min) / ((double) 2));
			(*s_etat_processus).x_max = (*((complex16 *)
					(*s_objet_argument).objet))
					.partie_reelle + ((x_max - x_min) / ((double) 2));

			(*s_etat_processus).y_min = (*((complex16 *)
					(*s_objet_argument).objet))
					.partie_imaginaire - ((y_max - y_min) / ((double) 2));
			(*s_etat_processus).y_max = (*((complex16 *)
					(*s_objet_argument).objet))
					.partie_imaginaire + ((y_max - y_min) / ((double) 2));
		}
		else
		{
			x_min = (*s_etat_processus).x2_min;
			x_max = (*s_etat_processus).x2_max;

			y_min = (*s_etat_processus).y2_min;
			y_max = (*s_etat_processus).y2_max;

			(*s_etat_processus).x2_min = (*((complex16 *)
					(*s_objet_argument).objet))
					.partie_reelle - ((x_max - x_min) / ((double) 2));
			(*s_etat_processus).x2_max = (*((complex16 *)
					(*s_objet_argument).objet))
					.partie_reelle + ((x_max - x_min) / ((double) 2));

			(*s_etat_processus).y2_min = (*((complex16 *)
					(*s_objet_argument).objet))
					.partie_imaginaire - ((y_max - y_min) / ((double) 2));
			(*s_etat_processus).y2_max = (*((complex16 *)
					(*s_objet_argument).objet))
					.partie_imaginaire + ((y_max - y_min) / ((double) 2));
		}
	}
	else
	{
		liberation(s_etat_processus, s_objet_argument);

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

	liberation(s_etat_processus, s_objet_argument);

	if (test_cfsf(s_etat_processus, 52) == d_faux)
	{
		if ((*s_etat_processus).fichiers_graphiques != NULL)
		{
			appel_gnuplot(s_etat_processus, 'N');
		}
	}

	return;
}


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

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

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

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(effacement de la matrice statistique)\n\n");
			printf("  Aucun argument\n");
		}
		else
		{
			printf("(purge of the statistical matrix)\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 (retrait_variable(s_etat_processus, ds_sdat, 'G') == d_erreur)
	{
		(*s_etat_processus).erreur_systeme = d_es;
		return;
	}

	return;
}


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

void
instruction_comb(struct_processus *s_etat_processus)
{
	integer8						k;
	integer8						n;
	integer8						cint_max;

	real8							c;

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

	unsigned long					i;

	(*s_etat_processus).erreur_execution = d_ex;

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

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

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

		return;
	}
	else if ((*s_etat_processus).test_instruction == 'Y')
	{
		(*s_etat_processus).nombre_arguments = 2;
		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 == INT) &&
			((*s_objet_argument_2).type == INT))
	{
		n = (*((integer8 *) (*s_objet_argument_2).objet));
		k = (*((integer8 *) (*s_objet_argument_1).objet));

		if ((n < 0) || (k < 0) || (k > n))
		{
			liberation(s_etat_processus, s_objet_argument_1);
			liberation(s_etat_processus, s_objet_argument_2);

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

		f90combinaison(&n, &k, &c);

		for(i = 1, cint_max = 1; i < (8 * sizeof(integer8)) - 1; cint_max =
				(cint_max << 1) + 1, i++);

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

			if (fabs(c - floor(c)) < fabs(ceil(c) - c))
			{
				(*((integer8 *) (*s_objet_resultat).objet)) =
						(integer8) floor(c);
			} 
			else
			{
				(*((integer8 *) (*s_objet_resultat).objet)) =
						1 + (integer8) floor(c);
			} 
		}
	}
	else
	{
		liberation(s_etat_processus, s_objet_argument_1);
		liberation(s_etat_processus, s_objet_argument_2);

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

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

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

	return;
}


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

void
instruction_cols(struct_processus *s_etat_processus)
{
	struct_objet			*s_objet_argument_1;
	struct_objet			*s_objet_argument_2;

	(*s_etat_processus).erreur_execution = d_ex;

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

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(définition des colonnes X et Y de la matrice "
					"statistique)\n\n");
		}
		else
		{
			printf("(definition of X and Y columns in statistical matrix)\n\n");
		}

		printf("    2: %s\n", d_INT);
		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, 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 == INT) &&
			((*s_objet_argument_2).type == INT))
	{
		if (((*((integer8 *) (*s_objet_argument_1).objet)) <= 0) ||
				((*((integer8 *) (*s_objet_argument_2).objet)) <= 0))
		{
			liberation(s_etat_processus, s_objet_argument_1);
			liberation(s_etat_processus, s_objet_argument_2);

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

		(*s_etat_processus).colonne_statistique_1 =
				(*((integer8 *) (*s_objet_argument_2).objet));
		(*s_etat_processus).colonne_statistique_2 =
				(*((integer8 *) (*s_objet_argument_1).objet));
	}
	else
	{
		liberation(s_etat_processus, s_objet_argument_1);
		liberation(s_etat_processus, s_objet_argument_2);

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

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

	return;
}

// vim: ts=4