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

void
instruction_steq(struct_processus *s_etat_processus)
{
	struct_objet						*s_objet;

	struct_variable						s_variable;

	(*s_etat_processus).erreur_execution = d_ex;

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

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(affecte un objet à la variable EQ)\n\n");
		}
		else
		{
			printf("(store an object in EQ variable)\n\n");
		}

		printf("    1: %s, %s, %s, %s, %s, %s,\n"
				"       %s, %s, %s, %s, %s,\n"
				"       %s, %s, %s, %s, %s,\n"
				"       %s, %s, %s, %s,\n"
				"       %s, %s\n",
				d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
				d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
				d_SQL, d_SLB, d_PRC, d_MTX);

		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 (recherche_variable_globale(s_etat_processus, "EQ") == d_vrai)
	{
		if ((*(*s_etat_processus).pointeur_variable_courante)
				.variable_verrouillee == d_vrai)
		{
			liberation(s_etat_processus, s_objet);

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

		liberation(s_etat_processus,
				(*(*s_etat_processus).pointeur_variable_courante).objet);
		(*(*s_etat_processus).pointeur_variable_courante).objet = s_objet;
	}
	else
	{
		/*
		 * La variable n'existe pas et on crée une variable globale.
		 */

		(*s_etat_processus).erreur_systeme = d_es;
		(*s_etat_processus).erreur_execution = d_ex;

		if ((s_variable.nom = malloc(3 * sizeof(unsigned char))) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		strcpy(s_variable.nom, "EQ");
		s_variable.niveau = 1;

		/*
		 * Le niveau 0 correspond aux définitions. Les variables
		 * commencent à 1 car elles sont toujours incluses dans
		 * une définition.
		 */

		s_variable.objet = s_objet;

		if (creation_variable(s_etat_processus, &s_variable, 'V', 'P')
				== d_erreur)
		{
			return;
		}
	}

	return;
}


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

void
instruction_star_w(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  *W ");

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(multiplie la largeur de la fenêtre graphique)\n\n");
		}
		else
		{
			printf("(multiply width of graphical window)\n\n");
		}

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

	if ((*s_objet_argument).type == INT)
	{
		if ((*((integer8 *) (*s_objet_argument).objet)) <= 0)
		{
			liberation(s_etat_processus, s_objet_argument);

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

		if ((*s_etat_processus).systeme_axes == 0)
		{
			(*s_etat_processus).x_min *= (real8) (*((integer8 *)
					(*s_objet_argument).objet));
			(*s_etat_processus).x_max *= (real8) (*((integer8 *)
					(*s_objet_argument).objet));
		}
		else
		{
			(*s_etat_processus).x2_min *= (real8) (*((integer8 *)
					(*s_objet_argument).objet));
			(*s_etat_processus).x2_max *= (real8) (*((integer8 *)
					(*s_objet_argument).objet));
		}
	}
	else if ((*s_objet_argument).type == REL)
	{
		if ((*((real8 *) (*s_objet_argument).objet)) <= 0)
		{
			liberation(s_etat_processus, s_objet_argument);

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

		if ((*s_etat_processus).systeme_axes == 0)
		{
			(*s_etat_processus).x_min *= (*((real8 *)
					(*s_objet_argument).objet));
			(*s_etat_processus).x_max *= (*((real8 *)
					(*s_objet_argument).objet));
		}
		else
		{
			(*s_etat_processus).x2_min *= (*((real8 *)
					(*s_objet_argument).objet));
			(*s_etat_processus).x2_max *= (*((real8 *)
					(*s_objet_argument).objet));
		}
	}
	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 '*h'
================================================================================
  Entrées : pointeur sur une structure struct_processus
--------------------------------------------------------------------------------
  Sorties :
--------------------------------------------------------------------------------
  Effets de bord : néant
================================================================================
*/

void
instruction_star_h(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  *H ");

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(multiplie la hauteur de la fenêtre graphique)\n\n");
		}
		else
		{
			printf("(multiply heigh of graphical window)\n\n");
		}

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

	if ((*s_objet_argument).type == INT)
	{
		if ((*((integer8 *) (*s_objet_argument).objet)) <= 0)
		{
			liberation(s_etat_processus, s_objet_argument);

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

		if ((*s_etat_processus).systeme_axes == 0)
		{
			(*s_etat_processus).y_min *= (real8) (*((integer8 *)
					(*s_objet_argument).objet));
			(*s_etat_processus).y_max *= (real8) (*((integer8 *)
					(*s_objet_argument).objet));
		}
		else
		{
			(*s_etat_processus).y2_min *= (real8) (*((integer8 *)
					(*s_objet_argument).objet));
			(*s_etat_processus).y2_max *= (real8) (*((integer8 *)
					(*s_objet_argument).objet));
		}
	}
	else if ((*s_objet_argument).type == REL)
	{
		if ((*((real8 *) (*s_objet_argument).objet)) <= 0)
		{
			liberation(s_etat_processus, s_objet_argument);

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

		if ((*s_etat_processus).systeme_axes == 0)
		{
			(*s_etat_processus).y_min *= (*((real8 *)
					(*s_objet_argument).objet));
			(*s_etat_processus).y_max *= (*((real8 *)
					(*s_objet_argument).objet));
		}
		else
		{
			(*s_etat_processus).y2_min *= (*((real8 *)
					(*s_objet_argument).objet));
			(*s_etat_processus).y2_max *= (*((real8 *)
					(*s_objet_argument).objet));
		}
	}
	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 '*d'
================================================================================
  Entrées : pointeur sur une structure struct_processus
--------------------------------------------------------------------------------
  Sorties :
--------------------------------------------------------------------------------
  Effets de bord : néant
================================================================================
*/

void
instruction_star_d(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  *D ");

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(multiplie la profondeur de la fenêtre graphique)\n\n");
		}
		else
		{
			printf("(multiply depth of graphical window)\n\n");
		}

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

	if ((*s_objet_argument).type == INT)
	{
		if ((*((integer8 *) (*s_objet_argument).objet)) <= 0)
		{
			liberation(s_etat_processus, s_objet_argument);

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

		if ((*s_etat_processus).systeme_axes == 0)
		{
			(*s_etat_processus).z_min *= (real8) (*((integer8 *)
					(*s_objet_argument).objet));
			(*s_etat_processus).z_max *= (real8) (*((integer8 *)
					(*s_objet_argument).objet));
		}
		else
		{
			(*s_etat_processus).z2_min *= (real8) (*((integer8 *)
					(*s_objet_argument).objet));
			(*s_etat_processus).z2_max *= (real8) (*((integer8 *)
					(*s_objet_argument).objet));
		}
	}
	else if ((*s_objet_argument).type == REL)
	{
		if ((*((real8 *) (*s_objet_argument).objet)) <= 0)
		{
			liberation(s_etat_processus, s_objet_argument);

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

		if ((*s_etat_processus).systeme_axes == 0)
		{
			(*s_etat_processus).z_min *= (*((real8 *)
					(*s_objet_argument).objet));
			(*s_etat_processus).z_max *= (*((real8 *)
					(*s_objet_argument).objet));
		}
		else
		{
			(*s_etat_processus).z2_min *= (*((real8 *)
					(*s_objet_argument).objet));
			(*s_etat_processus).z2_max *= (*((real8 *)
					(*s_objet_argument).objet));
		}
	}
	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 'store'
================================================================================
  Entrées : structure processus
--------------------------------------------------------------------------------
  Sorties :
--------------------------------------------------------------------------------
  Effets de bord : néant
================================================================================
*/

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

	logical1							i45;
	logical1							i48;
	logical1							i49;
	logical1							i50;

	struct_objet						*s_objet_argument_1;
	struct_objet						*s_objet_argument_2;

	unsigned char						*ligne;
	unsigned char						*ligne_convertie;
	unsigned char						registre;

	(*s_etat_processus).erreur_execution = d_ex;

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

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(enregistre une variable sur disque)\n\n");
		}
		else
		{
			printf("(store a variable on disk)\n\n");
		}

		printf("    2: %s, %s, %s, %s, %s, %s,\n"
				"       %s, %s, %s, %s, %s,\n"
				"       %s, %s, %s, %s, %s\n",
				d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
				d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN);
		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, 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_2).type != INT) &&
			((*s_objet_argument_2).type != REL) &&
			((*s_objet_argument_2).type != CPL) &&
			((*s_objet_argument_2).type != VIN) &&
			((*s_objet_argument_2).type != VRL) &&
			((*s_objet_argument_2).type != VCX) &&
			((*s_objet_argument_2).type != MIN) &&
			((*s_objet_argument_2).type != MRL) &&
			((*s_objet_argument_2).type != MCX) &&
			((*s_objet_argument_2).type != TBL) &&
			((*s_objet_argument_2).type != BIN) &&
			((*s_objet_argument_2).type != NOM) &&
			((*s_objet_argument_2).type != CHN) &&
			((*s_objet_argument_2).type != LST) &&
			((*s_objet_argument_2).type != ALG) &&
			((*s_objet_argument_2).type != RPN))
	{
		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 ((*s_objet_argument_1).type == CHN)
	{
		if ((fichier = fopen((unsigned char *) (*s_objet_argument_1).objet,
				"w")) == NULL)
		{
			liberation(s_etat_processus, s_objet_argument_1);
			liberation(s_etat_processus, s_objet_argument_2);

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

		i45 = test_cfsf(s_etat_processus, 45);
		i48 = test_cfsf(s_etat_processus, 48);
		i49 = test_cfsf(s_etat_processus, 49);
		i50 = test_cfsf(s_etat_processus, 50);

		cf(s_etat_processus, 45);
		cf(s_etat_processus, 48);
		cf(s_etat_processus, 49);
		cf(s_etat_processus, 50);

		if (fprintf(fichier, "// RPL/2 disk variable\n") < 0)
		{
			(*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
			return;
		}

		registre = (*s_etat_processus).autorisation_conversion_chaine;
		(*s_etat_processus).autorisation_conversion_chaine = 'N';

		ligne = formateur(s_etat_processus, 0, s_objet_argument_2);

		if ((ligne_convertie = transliteration(s_etat_processus,
				ligne, d_locale, "UTF-8")) == NULL)
		{
			free(ligne);

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

		free(ligne);
		ligne = ligne_convertie;

		(*s_etat_processus).autorisation_conversion_chaine = registre;

		if ((*s_objet_argument_2).type == CHN)
		{
			if (fprintf(fichier, "\"%s\"\n", ligne) < 0)
			{
				(*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
				return;
			}

			(*s_etat_processus).autorisation_conversion_chaine = registre;
		}
		else
		{
			if (fprintf(fichier, "%s\n", ligne) < 0)
			{
				(*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
				return;
			}

			(*s_etat_processus).autorisation_conversion_chaine = registre;
		}

		free(ligne);

		if (fclose(fichier) != 0)
		{
			(*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
			return;
		}

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

		if (i48 == d_vrai)
		{
			sf(s_etat_processus, 48);
		}
		else
		{
			cf(s_etat_processus, 48);
		}

		if (i49 == d_vrai)
		{
			sf(s_etat_processus, 49);
		}
		else
		{
			cf(s_etat_processus, 49);
		}

		if (i50 == d_vrai)
		{
			sf(s_etat_processus, 50);
		}
		else
		{
			cf(s_etat_processus, 50);
		}
	}
	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;
}


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

void
instruction_stws(struct_processus *s_etat_processus)
{
	logical1					i43;
	logical1					i44;

	struct_objet				*s_objet_argument;
	struct_objet				*s_objet_binaire;

	unsigned char				*valeur_binaire;

	unsigned long				i;
	unsigned long				j;

	(*s_etat_processus).erreur_execution = d_ex;

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

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(affectation de la longueur des entiers binaires)\n\n");
		}
		else
		{
			printf("(set the length of the binary integers)\n\n");
		}

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

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

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

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

	if ((*s_objet_argument).type == INT)
	{
		if (((*((integer8 *) (*s_objet_argument).objet)) < 1 ) ||
				((*((integer8 *) (*s_objet_argument).objet)) > 64))
		{
			liberation(s_etat_processus, s_objet_argument);

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

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

		(*((logical8 *) (*s_objet_binaire).objet)) = (logical8) ((*((integer8 *)
				(*s_objet_argument).objet)) - 1);

		i43 = test_cfsf(s_etat_processus, 43);
		i44 = test_cfsf(s_etat_processus, 44);

		sf(s_etat_processus, 44);
		cf(s_etat_processus, 43);

		valeur_binaire = formateur(s_etat_processus, 0, s_objet_binaire);

		liberation(s_etat_processus, s_objet_binaire);

		if (i43 == d_vrai)
		{
			sf(s_etat_processus, 43);
		}
		else
		{
			cf(s_etat_processus, 43);
		}

		if (i44 == d_vrai)
		{
			sf(s_etat_processus, 44);
		}
		else
		{
			cf(s_etat_processus, 44);
		}

		for(j = 37, i = strlen(valeur_binaire) - 2; i >= 2; i--)
		{
			if (valeur_binaire[i] == '0')
			{
				cf(s_etat_processus, (unsigned char) j++);
			}
			else
			{
				sf(s_etat_processus, (unsigned char) j++);
			}
		}

		for(; j <= 42; cf(s_etat_processus, (unsigned char) j++));

		free(valeur_binaire);
	}
	else
	{
		liberation(s_etat_processus, s_objet_argument);

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

	liberation(s_etat_processus, s_objet_argument);

	return;
}


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

void
instruction_sl(struct_processus *s_etat_processus)
{
	logical8							masque;
	logical8							tampon;

	struct_objet						*s_copie;
	struct_objet						*s_objet;

	unsigned long						i;
	unsigned long						j;
	unsigned long						longueur;

	(*s_etat_processus).erreur_execution = d_ex;

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

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(déplacement à gauche)\n\n");
		}
		else
		{
			printf("(shift left)\n\n");
		}

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

		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 == BIN)
	{
		if ((s_copie = copie_objet(s_etat_processus, s_objet, 'O')) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		longueur = 1;
		j = 1;

		for(i = 37; i <= 42; i++)
		{
			longueur += (test_cfsf(s_etat_processus, (unsigned char) i)
					== d_vrai) ? j : 0;
			j *= 2;
		}

		tampon = (*((logical8 *) (*s_copie).objet));
		tampon <<= 1;

		for(masque = 0, i = 1; i < longueur; i++)
		{
			masque <<= 1;
			masque |= (logical8) 1;
		}

		masque <<= 1;
		tampon &= masque;
		(*((logical8 *) (*s_copie).objet)) = tampon;

		if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
				s_copie) == d_erreur)
		{
			return;
		}
	}
	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;
}


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

void
instruction_slb(struct_processus *s_etat_processus)
{
	struct_liste_chainee	*l_base_pile;

	unsigned long			i;

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

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(déplacement d'un octet à gauche)\n\n");
		}
		else
		{
			printf("(shift left byte)\n\n");
		}

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

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

	l_base_pile = (*s_etat_processus).l_base_pile_last;
	(*s_etat_processus).l_base_pile_last = NULL;

	for(i = 0; i < 8; i++)
	{
		instruction_sl(s_etat_processus);

		if (((*s_etat_processus).erreur_systeme != d_es) ||
				((*s_etat_processus).erreur_execution != d_ex))
		{
			break;
		}
	}

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

	(*s_etat_processus).l_base_pile_last = l_base_pile;
	return;
}


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

void
instruction_sr(struct_processus *s_etat_processus)
{
	logical8							masque;
	logical8							tampon;

	struct_objet						*s_copie;
	struct_objet						*s_objet;

	unsigned long						i;
	unsigned long						j;
	unsigned long						longueur;

	(*s_etat_processus).erreur_execution = d_ex;

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

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(déplacement à droite)\n\n");
		}
		else
		{
			printf("(shift right)\n\n");
		}

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

		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 == BIN)
	{
		if ((s_copie = copie_objet(s_etat_processus, s_objet, 'O')) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		longueur = 1;
		j = 1;

		for(i = 37; i <= 42; i++)
		{
			longueur += (test_cfsf(s_etat_processus, (unsigned char) i)
					== d_vrai) ? j : 0;
			j *= 2;
		}

		tampon = (*((logical8 *) (*s_copie).objet));
		tampon >>= 1;

		for(masque = 0, i = 0; i < longueur; i++)
		{
			masque <<= 1;
			masque |= 1;
		}

		tampon &= masque;
		(*((logical8 *) (*s_copie).objet)) = tampon;

		if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
				s_copie) == d_erreur)
		{
			return;
		}
	}
	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;
}


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

void
instruction_srb(struct_processus *s_etat_processus)
{
	struct_liste_chainee	*l_base_pile;

	unsigned long			i;

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

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(déplacement d'un octet à droite)\n\n");
		}
		else
		{
			printf("(shift right byte)\n\n");
		}

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

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

	l_base_pile = (*s_etat_processus).l_base_pile_last;
	(*s_etat_processus).l_base_pile_last = NULL;

	for(i = 0; i < 8; i++)
	{
		instruction_sr(s_etat_processus);

		if (((*s_etat_processus).erreur_systeme != d_es) ||
				((*s_etat_processus).erreur_execution != d_ex))
		{
			break;
		}
	}

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

	(*s_etat_processus).l_base_pile_last = l_base_pile;
	return;
}


/*
================================================================================
  Fonction 'scatter' (passe en mode d'affichage échantilloné)
================================================================================
  Entrées : structure processus
--------------------------------------------------------------------------------
  Sorties :
--------------------------------------------------------------------------------
  Effets de bord : néant
================================================================================
*/

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

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

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(graphique statistique de type nuage de points)\n\n");
			printf("  Aucun argument\n");
		}
		else
		{
			printf("(scatter statistical graphic)\n\n");
			printf("  No argument\n");
		}

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

	strcpy((*s_etat_processus).type_trace_sigma, "POINTS");

	return;
}


/*
================================================================================
  Fonction '*s' (modifie les échelles verticale et horizontale)
================================================================================
  Entrées : structure processus
--------------------------------------------------------------------------------
  Sorties :
--------------------------------------------------------------------------------
  Effets de bord : néant
================================================================================
*/

void
instruction_star_s(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  *S ");

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(multiplie les dimensions de la fenêtre graphique)\n\n");
		}
		else
		{
			printf("()\n\n");
		}

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

	if ((*s_objet_argument).type == INT)
	{
		if ((*((integer8 *) (*s_objet_argument).objet)) <= 0)
		{
			liberation(s_etat_processus, s_objet_argument);

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

		if ((*s_etat_processus).systeme_axes == 0)
		{
			(*s_etat_processus).x_min *= (real8) (*((integer8 *)
					(*s_objet_argument).objet));
			(*s_etat_processus).x_max *= (real8) (*((integer8 *)
					(*s_objet_argument).objet));
			(*s_etat_processus).y_min *= (real8) (*((integer8 *)
					(*s_objet_argument).objet));
			(*s_etat_processus).y_max *= (real8) (*((integer8 *)
					(*s_objet_argument).objet));
			(*s_etat_processus).z_min *= (real8) (*((integer8 *)
					(*s_objet_argument).objet));
			(*s_etat_processus).z_max *= (real8) (*((integer8 *)
					(*s_objet_argument).objet));
		}
		else
		{
			(*s_etat_processus).x2_min *= (real8) (*((integer8 *)
					(*s_objet_argument).objet));
			(*s_etat_processus).x2_max *= (real8) (*((integer8 *)
					(*s_objet_argument).objet));
			(*s_etat_processus).y2_min *= (real8) (*((integer8 *)
					(*s_objet_argument).objet));
			(*s_etat_processus).y2_max *= (real8) (*((integer8 *)
					(*s_objet_argument).objet));
			(*s_etat_processus).z2_min *= (real8) (*((integer8 *)
					(*s_objet_argument).objet));
			(*s_etat_processus).z2_max *= (real8) (*((integer8 *)
					(*s_objet_argument).objet));
		}
	}
	else if ((*s_objet_argument).type == REL)
	{
		if ((*((real8 *) (*s_objet_argument).objet)) <= 0)
		{
			liberation(s_etat_processus, s_objet_argument);

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

		if ((*s_etat_processus).systeme_axes == 0)
		{
			(*s_etat_processus).x_min *= (*((real8 *)
					(*s_objet_argument).objet));
			(*s_etat_processus).x_max *= (*((real8 *)
					(*s_objet_argument).objet));
			(*s_etat_processus).y_min *= (*((real8 *)
					(*s_objet_argument).objet));
			(*s_etat_processus).y_max *= (*((real8 *)
					(*s_objet_argument).objet));
			(*s_etat_processus).z_min *= (*((real8 *)
					(*s_objet_argument).objet));
			(*s_etat_processus).z_max *= (*((real8 *)
					(*s_objet_argument).objet));
		}
		else
		{
			(*s_etat_processus).x2_min *= (*((real8 *)
					(*s_objet_argument).objet));
			(*s_etat_processus).x2_max *= (*((real8 *)
					(*s_objet_argument).objet));
			(*s_etat_processus).y2_min *= (*((real8 *)
					(*s_objet_argument).objet));
			(*s_etat_processus).y2_max *= (*((real8 *)
					(*s_objet_argument).objet));
			(*s_etat_processus).z2_min *= (*((real8 *)
					(*s_objet_argument).objet));
			(*s_etat_processus).z2_max *= (*((real8 *)
					(*s_objet_argument).objet));
		}
	}
	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 'stos'
================================================================================
  Entrées : structure processus
--------------------------------------------------------------------------------
  Sorties :
--------------------------------------------------------------------------------
  Effets de bord : néant
================================================================================
*/

void
instruction_stos(struct_processus *s_etat_processus)
{
	struct_objet						*s_objet;

	struct_variable						s_variable;

	(*s_etat_processus).erreur_execution = d_ex;

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

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(affectation de la variable %s)\n\n", ds_sdat);
		}
		else
		{
			printf("(store %s variable)\n\n", ds_sdat);
		}

		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 (recherche_variable_globale(s_etat_processus, ds_sdat) == d_vrai)
	{
		if ((*(*s_etat_processus).pointeur_variable_courante)
				.variable_verrouillee == d_vrai)
		{
			liberation(s_etat_processus, s_objet);

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

		liberation(s_etat_processus,
				(*(*s_etat_processus).pointeur_variable_courante).objet);
		(*(*s_etat_processus).pointeur_variable_courante).objet = s_objet;
	}
	else
	{
		/*
		 * La variable n'existe pas et on crée une variable globale.
		 */

		(*s_etat_processus).erreur_systeme = d_es;
		(*s_etat_processus).erreur_execution = d_ex;

		if ((s_variable.nom = malloc(6 * sizeof(unsigned char))) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		strcpy(s_variable.nom, ds_sdat);
		s_variable.niveau = 1;

		/*
		 * Le niveau 0 correspond aux définitions. Les variables
		 * commencent à 1 car elles sont toujours incluses dans
		 * une définition.
		 */

		s_variable.objet = s_objet;

		if (creation_variable(s_etat_processus, &s_variable, 'V', 'P')
				== d_erreur)
		{
			return;
		}
	}

	return;
}

// vim: ts=4