/*
================================================================================
  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 'sin'
================================================================================
  Entrées : pointeur sur une structure struct_processus
--------------------------------------------------------------------------------
  Sorties :
--------------------------------------------------------------------------------
  Effets de bord : néant
================================================================================
*/

void
instruction_sin(struct_processus *s_etat_processus)
{
	real8							angle;

	struct_liste_chainee			*l_element_courant;
	struct_liste_chainee			*l_element_precedent;

	struct_objet					*s_copie_argument;
	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  SIN ");

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

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

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

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

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

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

/*
--------------------------------------------------------------------------------
  Sinus d'un entier ou d'un réel
--------------------------------------------------------------------------------
*/

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

		if ((*s_objet_argument).type == INT)
		{
			angle = (real8) (*((integer8 *) (*s_objet_argument).objet));
		}
		else
		{
			angle = (*((real8 *) (*s_objet_argument).objet));
		}

		if (test_cfsf(s_etat_processus, 60) == d_faux)
		{
			conversion_degres_vers_radians(&angle);
		}

		(*((real8 *) (*s_objet_resultat).objet)) = sin(angle);
	}

/*
--------------------------------------------------------------------------------
  Sinus d'un complexe
--------------------------------------------------------------------------------
*/

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

		f77sin_((struct_complexe16 *) (*s_objet_argument).objet,
				(struct_complexe16 *) (*s_objet_resultat).objet);
	}

/*
--------------------------------------------------------------------------------
  Sinus d'un nom
--------------------------------------------------------------------------------
*/

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

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

		l_element_courant = (*s_objet_resultat).objet;

		if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
				== NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		(*((struct_fonction *) (*(*l_element_courant).donnee).objet))
				.nombre_arguments = 0;
		(*((struct_fonction *) (*(*l_element_courant).donnee).objet))
				.fonction = instruction_vers_niveau_superieur;

		if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
				.nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
				.nom_fonction, "<<");

		if (((*l_element_courant).suivant =
				allocation_maillon(s_etat_processus)) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		l_element_courant = (*l_element_courant).suivant;
		(*l_element_courant).donnee = s_objet_argument;

		if (((*l_element_courant).suivant =
				allocation_maillon(s_etat_processus)) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		l_element_courant = (*l_element_courant).suivant;

		if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
				== NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		(*((struct_fonction *) (*(*l_element_courant).donnee).objet))
				.nombre_arguments = 1;
		(*((struct_fonction *) (*(*l_element_courant).donnee).objet))
				.fonction = instruction_sin;

		if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
				.nom_fonction = malloc(4 * sizeof(unsigned char))) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
				.nom_fonction, "SIN");

		if (((*l_element_courant).suivant =
				allocation_maillon(s_etat_processus)) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		l_element_courant = (*l_element_courant).suivant;

		if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
				== NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		(*((struct_fonction *) (*(*l_element_courant).donnee).objet))
				.nombre_arguments = 0;
		(*((struct_fonction *) (*(*l_element_courant).donnee).objet))
				.fonction = instruction_vers_niveau_inferieur;

		if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
				.nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
				.nom_fonction, ">>");

		(*l_element_courant).suivant = NULL;
		s_objet_argument = NULL;
	}

/*
--------------------------------------------------------------------------------
  Sinus d'une expression
--------------------------------------------------------------------------------
*/

	else if (((*s_objet_argument).type == ALG) ||
			((*s_objet_argument).type == RPN))
	{
		if ((s_copie_argument = copie_objet(s_etat_processus, s_objet_argument,
				'N')) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		l_element_courant = (struct_liste_chainee *)
				(*s_copie_argument).objet;
		l_element_precedent = l_element_courant;

		while((*l_element_courant).suivant != NULL)
		{
			l_element_precedent = l_element_courant;
			l_element_courant = (*l_element_courant).suivant;
		}

		if (((*l_element_precedent).suivant =
				allocation_maillon(s_etat_processus)) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		if (((*(*l_element_precedent).suivant).donnee =
				allocation(s_etat_processus, FCT)) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		(*((struct_fonction *) (*(*(*l_element_precedent).suivant)
				.donnee).objet)).nombre_arguments = 1;
		(*((struct_fonction *) (*(*(*l_element_precedent).suivant)
				.donnee).objet)).fonction = instruction_sin;

		if (((*((struct_fonction *) (*(*(*l_element_precedent)
				.suivant).donnee).objet)).nom_fonction =
				malloc(4 * sizeof(unsigned char))) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
				.suivant).donnee).objet)).nom_fonction, "SIN");

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

		s_objet_resultat = s_copie_argument;
	}

/*
--------------------------------------------------------------------------------
  Réalisation impossible de la fonction sinus
--------------------------------------------------------------------------------
*/

	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 'sinh'
================================================================================
  Entrées : pointeur sur une structure struct_processus
--------------------------------------------------------------------------------
  Sorties :
--------------------------------------------------------------------------------
  Effets de bord : néant
================================================================================
*/

void
instruction_sinh(struct_processus *s_etat_processus)
{
	real8							argument;

	struct_liste_chainee			*l_element_courant;
	struct_liste_chainee			*l_element_precedent;

	struct_objet					*s_copie_argument;
	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  SINH ");

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(sinus hyperbolique)\n\n");
		}
		else
		{
			printf("(hyperbolic sine)\n\n");
		}

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

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

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

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

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

/*
--------------------------------------------------------------------------------
  Sinus hyperbolique d'un entier ou d'un réel
--------------------------------------------------------------------------------
*/

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

		if ((*s_objet_argument).type == INT)
		{
			argument = (real8) (*((integer8 *) (*s_objet_argument).objet));
		}
		else
		{
			argument = (*((real8 *) (*s_objet_argument).objet));
		}

		(*((real8 *) (*s_objet_resultat).objet)) = sinh(argument);
	}

/*
--------------------------------------------------------------------------------
  Sinus hyperbolique d'un complexe
--------------------------------------------------------------------------------
*/

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

		f77sinh_((struct_complexe16 *) (*s_objet_argument).objet,
				(struct_complexe16 *) (*s_objet_resultat).objet);
	}

/*
--------------------------------------------------------------------------------
  Sinus hyperbolique d'un nom
--------------------------------------------------------------------------------
*/

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

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

		l_element_courant = (*s_objet_resultat).objet;

		if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
				== NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		(*((struct_fonction *) (*(*l_element_courant).donnee).objet))
				.nombre_arguments = 0;
		(*((struct_fonction *) (*(*l_element_courant).donnee).objet))
				.fonction = instruction_vers_niveau_inferieur;

		if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
				.nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
				.nom_fonction, "<<");

		if (((*l_element_courant).suivant =
				allocation_maillon(s_etat_processus)) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		l_element_courant = (*l_element_courant).suivant;
		(*l_element_courant).donnee = s_objet_argument;

		if (((*l_element_courant).suivant =
				allocation_maillon(s_etat_processus)) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		l_element_courant = (*l_element_courant).suivant;

		if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
				== NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		(*((struct_fonction *) (*(*l_element_courant).donnee).objet))
				.nombre_arguments = 1;
		(*((struct_fonction *) (*(*l_element_courant).donnee).objet))
				.fonction = instruction_sinh;

		if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
				.nom_fonction = malloc(5 * sizeof(unsigned char))) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
				.nom_fonction, "SINH");

		if (((*l_element_courant).suivant =
				allocation_maillon(s_etat_processus)) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		l_element_courant = (*l_element_courant).suivant;

		if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
				== NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		(*((struct_fonction *) (*(*l_element_courant).donnee).objet))
				.nombre_arguments = 0;
		(*((struct_fonction *) (*(*l_element_courant).donnee).objet))
				.fonction = instruction_vers_niveau_inferieur;

		if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
				.nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
				.nom_fonction, ">>");

		(*l_element_courant).suivant = NULL;
		s_objet_argument = NULL;
	}

/*
--------------------------------------------------------------------------------
  Sinus hyperbolique d'une expression
--------------------------------------------------------------------------------
*/

	else if (((*s_objet_argument).type == ALG) ||
			((*s_objet_argument).type == RPN))
	{
		if ((s_copie_argument = copie_objet(s_etat_processus, s_objet_argument,
				'N')) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		l_element_courant = (struct_liste_chainee *)
				(*s_copie_argument).objet;
		l_element_precedent = l_element_courant;

		while((*l_element_courant).suivant != NULL)
		{
			l_element_precedent = l_element_courant;
			l_element_courant = (*l_element_courant).suivant;
		}

		if (((*l_element_precedent).suivant =
				allocation_maillon(s_etat_processus)) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		if (((*(*l_element_precedent).suivant).donnee =
				allocation(s_etat_processus, FCT)) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		(*((struct_fonction *) (*(*(*l_element_precedent).suivant)
				.donnee).objet)).nombre_arguments = 1;
		(*((struct_fonction *) (*(*(*l_element_precedent).suivant)
				.donnee).objet)).fonction = instruction_sinh;

		if (((*((struct_fonction *) (*(*(*l_element_precedent)
				.suivant).donnee).objet)).nom_fonction =
				malloc(5 * sizeof(unsigned char))) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
				.suivant).donnee).objet)).nom_fonction, "SINH");

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

		s_objet_resultat = s_copie_argument;
	}

/*
--------------------------------------------------------------------------------
  Réalisation impossible de la fonction sinus hyperbolique
--------------------------------------------------------------------------------
*/

	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 'size'
================================================================================
  Entrées : pointeur sur une structure struct_processus
--------------------------------------------------------------------------------
  Sorties :
--------------------------------------------------------------------------------
  Effets de bord : néant
================================================================================
*/

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

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

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(taille d'un objet)\n\n");
		}
		else
		{
			printf("(object size)\n\n");
		}

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

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

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

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

/*
--------------------------------------------------------------------------------
  Chaîne de caractères
--------------------------------------------------------------------------------
*/

	if ((*s_objet_argument).type == CHN)
	{
		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)) =
				longueur_chaine(s_etat_processus,
				(unsigned char *) (*s_objet_argument).objet);
	}

/*
--------------------------------------------------------------------------------
  Liste
--------------------------------------------------------------------------------
*/

	else if ((*s_objet_argument).type == LST)
	{
		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)) = 0;
		l_element_courant = (*s_objet_argument).objet;

		while(l_element_courant != NULL)
		{
			(*((integer8 *) (*s_objet_resultat).objet))++;
			l_element_courant = (*l_element_courant).suivant;
		}
	}

/*
--------------------------------------------------------------------------------
  Expression algébrique
--------------------------------------------------------------------------------
*/
	
	else if ((*s_objet_argument).type == ALG)
	{
		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)) = 0;
		l_element_courant = (*s_objet_argument).objet;

		while(l_element_courant != NULL)
		{
			(*((integer8 *) (*s_objet_resultat).objet))++;
			l_element_courant = (*l_element_courant).suivant;
		}

		(*((integer8 *) (*s_objet_resultat).objet)) -= 2;
	}

/*
--------------------------------------------------------------------------------
  Table
--------------------------------------------------------------------------------
*/
	
	else if ((*s_objet_argument).type == TBL)
	{
		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_tableau *)
				(*s_objet_argument).objet)).nombre_elements;
	}

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

	else if (((*s_objet_argument).type == VIN) ||
			((*s_objet_argument).type == VRL) ||
			((*s_objet_argument).type == VCX))
	{
		if ((s_objet_resultat = allocation(s_etat_processus, LST)) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

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

		l_element_courant = (*s_objet_resultat).objet;
		(*l_element_courant).suivant = NULL;

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

		(*((integer8 *) (*(*l_element_courant).donnee).objet)) =
				(*((struct_vecteur *) (*s_objet_argument).objet)).taille;
	}

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

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

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

		l_element_courant = (*s_objet_resultat).objet;

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

		(*((integer8 *) (*(*l_element_courant).donnee).objet)) =
				(*((struct_matrice *) (*s_objet_argument).objet)).nombre_lignes;

		if (((*l_element_courant).suivant =
				allocation_maillon(s_etat_processus)) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		l_element_courant = (*l_element_courant).suivant;
		(*l_element_courant).suivant = NULL;

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

		(*((integer8 *) (*(*l_element_courant).donnee).objet)) =
				(*((struct_matrice *) (*s_objet_argument).objet))
				.nombre_colonnes;
	}

/*
--------------------------------------------------------------------------------
  Type d'argument invalide
--------------------------------------------------------------------------------
*/

	else
	{
		liberation(s_etat_processus, s_objet_argument);

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

	liberation(s_etat_processus, s_objet_argument);

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

	return;
}


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

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

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

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(avance d'un pas)\n\n");
			printf("  Aucun argument\n");
		}
		else
		{
			printf("(single step)\n\n");
			printf("  No argument\n");
		}

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

	if ((*s_etat_processus).traitement_instruction_halt == d_vrai)
	{
		(*s_etat_processus).execution_pas_suivant = d_vrai;
	}

	return;
}


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

void
instruction_str_fleche(struct_processus *s_etat_processus)
{
	logical1						drapeau45;
	logical1						presence_chaine;

	struct_objet					*s_objet;
	struct_objet					*s_sous_objet;

	unsigned char					*commande;
	unsigned char					*chaine_convertie;
	unsigned char					*ptr_e;
	unsigned char					*ptr_l;
	unsigned char					*registre_definitions_chainees;
	unsigned char					*registre_instruction_courante;
	unsigned char					registre_interruption;
	unsigned char					*tampon;

	integer8						nombre_caracteres_supplementaires;
	integer8						position_courante;

	(*s_etat_processus).erreur_execution = d_ex;

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

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(conversion d'une chaîne)\n\n");
		}
		else
		{
			printf("(conversion from a string of chars)\n\n");
		}

		printf("    1: %s\n", d_INT);
		printf("->  n: %s, %s, %s, %s, %s, %s,\n"
				"       %s, %s, %s, %s, %s,\n"
				"       %s, %s, %s, %s, %s,\n"
				"       %s\n",
				d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
				d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
		printf("    ...\n");
		printf("->  1: %s, %s, %s, %s, %s, %s,\n"
				"       %s, %s, %s, %s, %s,\n"
				"       %s, %s, %s, %s, %s,\n"
				"       %s\n",
				d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
				d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);

		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 == CHN)
	{
		// Comptage des caractères à protéger.

		drapeau45 = test_cfsf(s_etat_processus, 45);
		cf(s_etat_processus, 45);

		tampon = formateur(s_etat_processus, 0, s_objet);

		if (drapeau45 == d_vrai)
		{
			sf(s_etat_processus, 45);
		}
		else
		{
			cf(s_etat_processus, 45);
		}

		ptr_l = tampon;
		presence_chaine = d_faux;
		nombre_caracteres_supplementaires = 0;

		while((*ptr_l) != d_code_fin_chaine)
		{
			if ((*ptr_l) == '"')
			{
				presence_chaine = (presence_chaine == d_faux) ? d_vrai : d_faux;
			}

			if (presence_chaine == d_vrai)
			{
				switch(*ptr_l)
				{
					case '\\':
					case '\t':
					case '\b':
					case '\n':
					{
						nombre_caracteres_supplementaires++;
						break;
					}
				}
			}
			else
			{
				switch(*ptr_l)
				{
					case '\n':
					case '\b':
					case '\t':
					{
						nombre_caracteres_supplementaires--;
						break;
					}
				}
			}

			ptr_l++;
		}

		// Échappement des caractères et remplacement dans les chaînes
		// de caractères incluses. Le seul caractère protégé est le '\'
		// qui est doublé.

		if ((chaine_convertie = malloc((strlen(tampon) + ((size_t)
				nombre_caracteres_supplementaires) + 1) *
				sizeof(unsigned char))) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		ptr_l = tampon;
		ptr_e = chaine_convertie;
		presence_chaine = d_faux;

		while((*ptr_l) != d_code_fin_chaine)
		{
			if ((*ptr_l) == '"')
			{
				presence_chaine = (presence_chaine == d_faux) ? d_vrai : d_faux;
			}

			(*ptr_e) = (*ptr_l);

			if (presence_chaine == d_vrai)
			{
				switch(*ptr_l)
				{
					case '\\':
					{
						(*(++ptr_e)) = '\\';
						break;
					}

					case '\t':
					{
						(*ptr_e) = '\\';
						(*(++ptr_e)) = 't';
						break;
					}

					case '\b':
					{
						(*ptr_e) = '\\';
						(*(++ptr_e)) = 'b';
						break;
					}

					case '\n':
					{
						(*ptr_e) = '\\';
						(*(++ptr_e)) = 'n';
						break;
					}
				}
			}
			else
			{
				switch(*ptr_l)
				{
					case '\n':
					case '\b':
					case '\t':
					{
						ptr_e--;
						break;
					}
				}
			}

			ptr_l++;
			ptr_e++;
		}

		(*ptr_e) = d_code_fin_chaine;

		position_courante = (*s_etat_processus).position_courante;
		registre_definitions_chainees = (*s_etat_processus)
				.definitions_chainees;
		registre_instruction_courante = (*s_etat_processus)
				.instruction_courante;
		(*s_etat_processus).position_courante = 0;
		(*s_etat_processus).definitions_chainees = chaine_convertie;
		free(tampon);

		if ((*s_etat_processus).definitions_chainees == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		if (analyse_syntaxique(s_etat_processus) == d_absence_erreur)
		{
			if ((commande = malloc((strlen((unsigned char *)
					(*s_objet).objet) + 7) * sizeof(unsigned char))) == NULL)
			{
				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
				return;
			}

			sprintf(commande, "<< %s >>", (*s_etat_processus)
					.definitions_chainees);
			(*s_etat_processus).instruction_courante = commande;

			(*s_etat_processus).type_en_cours = NON;
			recherche_type(s_etat_processus);

			if (((*s_etat_processus).erreur_execution != d_ex) ||
					((*s_etat_processus).erreur_systeme != d_es))
			{
				liberation(s_etat_processus, s_objet);

				free((*s_etat_processus).definitions_chainees);
				free((*s_etat_processus).instruction_courante);

				(*s_etat_processus).definitions_chainees =
						registre_definitions_chainees;
				(*s_etat_processus).instruction_courante =
						registre_instruction_courante;
				(*s_etat_processus).position_courante =
						position_courante;

				return;
			}

			if (depilement(s_etat_processus, &((*s_etat_processus)
					.l_base_pile), &s_sous_objet) == d_erreur)
			{
				liberation(s_etat_processus, s_objet);
				free((*s_etat_processus).definitions_chainees);
				free((*s_etat_processus).instruction_courante);

				(*s_etat_processus).definitions_chainees =
						registre_definitions_chainees;
				(*s_etat_processus).instruction_courante =
						registre_instruction_courante;
				(*s_etat_processus).position_courante =
						position_courante;

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

			registre_interruption = (*s_etat_processus)
					.traitement_interruptible;
			(*s_etat_processus).traitement_interruptible = 'N';

			if (evaluation(s_etat_processus, s_sous_objet, 'I') == d_erreur)
			{
				liberation(s_etat_processus, s_sous_objet);
				liberation(s_etat_processus, s_objet);

				free((*s_etat_processus).definitions_chainees);
				free((*s_etat_processus).instruction_courante);

				(*s_etat_processus).definitions_chainees =
						registre_definitions_chainees;
				(*s_etat_processus).instruction_courante =
						registre_instruction_courante;
				(*s_etat_processus).position_courante =
						position_courante;

				(*s_etat_processus).traitement_interruptible =
						registre_interruption;

				if ((*s_etat_processus).erreur_systeme == d_es)
				{
					(*s_etat_processus).erreur_execution =
							d_ex_expression_invalide;
				}
				else
				{
					(*s_etat_processus).erreur_systeme =
							d_es_allocation_memoire;
				}

				return;
			}
		}
		else
		{
			liberation(s_etat_processus, s_objet);

			free((*s_etat_processus).definitions_chainees);
			free((*s_etat_processus).instruction_courante);

			(*s_etat_processus).definitions_chainees =
					registre_definitions_chainees;
			(*s_etat_processus).instruction_courante =
					registre_instruction_courante;
			(*s_etat_processus).position_courante =
					position_courante;

			(*s_etat_processus).erreur_execution = d_ex_argument_invalide;

			return;
		}


		(*s_etat_processus).traitement_interruptible =
				registre_interruption;

		liberation(s_etat_processus, s_sous_objet);

		free((*s_etat_processus).definitions_chainees);
		free((*s_etat_processus).instruction_courante);

		(*s_etat_processus).definitions_chainees =
				registre_definitions_chainees;
		(*s_etat_processus).instruction_courante =
				registre_instruction_courante;
		(*s_etat_processus).position_courante =
				position_courante;
	}
	else
	{
		liberation(s_etat_processus, s_objet);

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

	liberation(s_etat_processus, s_objet);

	return;
}

// vim: ts=4