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

  This file is part of RPL/2.

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


#include "rpl.conv.h"


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

void
instruction_in(struct_processus *s_etat_processus)
{
	logical1				difference;

	struct_liste_chainee	*l_element_courant;

	struct_objet			*s_copie_1;
	struct_objet			*s_copie_2;
	struct_objet			*s_objet_argument_1;
	struct_objet			*s_objet_argument_2;
	struct_objet			*s_objet_resultat;
	struct_objet			*s_objet_resultat_intermediaire;

	(*s_etat_processus).erreur_execution = d_ex;

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

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(test de l'appartenance à un ensemble)\n\n");
		}
		else
		{
			printf("(check membership)\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_LST);
		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 == LST) &&
			(((*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 == TAB) ||
			((*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)))
	{
		if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		l_element_courant = (struct_liste_chainee *)
				(*s_objet_argument_1).objet;

		difference = d_vrai;

		while((difference == d_vrai) && (l_element_courant != NULL))
		{
			if ((s_copie_1 = copie_objet(s_etat_processus,
					(*l_element_courant).donnee, 'P')) == NULL)
			{
				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
				return;
			}

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

			if ((s_copie_2 = copie_objet(s_etat_processus,
					s_objet_argument_2, 'P')) == NULL)
			{
				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
				return;
			}

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

			instruction_same(s_etat_processus);

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

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

			if ((*s_objet_resultat_intermediaire).type != INT)
			{
				liberation(s_etat_processus, s_objet_argument_1);
				liberation(s_etat_processus, s_objet_argument_2);
				liberation(s_etat_processus, s_objet_resultat);

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

			difference = (*(((integer8 *) (*s_objet_resultat_intermediaire)
					.objet)) == 0) ? d_vrai : d_faux;

			liberation(s_etat_processus, s_objet_resultat_intermediaire);
			l_element_courant = (*l_element_courant).suivant;
		}

		if (difference == d_vrai)
		{
			(*((integer8 *) (*s_objet_resultat).objet)) = 0;
		}
		else
		{
			(*((integer8 *) (*s_objet_resultat).objet)) = -1;
		}
	}
	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;
}

// vim: ts=4