/*
================================================================================
  RPL/2 (R) version 4.1.28
  Copyright (C) 1989-2017 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.
================================================================================
*/


#ifdef RPLCAS

// Giac inclut <semaphore.h> et définit sem_t. Or l'émulation
// des IPCS POSIX requiert une redéfinition de sem_t.

#	ifdef IPCS_SYSV
//		NetBSD : _SEMAPHORE_H_
#		define _SEMAPHORE_H_
//		Linux : _SEMAPHORE_H
#		define _SEMAPHORE_H
#	endif

#	pragma GCC diagnostic push
#	pragma GCC diagnostic ignored "-Wstrict-aliasing"
#	pragma GCC diagnostic ignored "-Wunused-parameter"
#	pragma GCC diagnostic ignored "-Wempty-body"
#	pragma GCC diagnostic ignored "-Wunknown-pragmas"
#	include "giac.h"
#	pragma GCC diagnostic pop

#	undef PACKAGE
#	undef PACKAGE_NAME
#	undef PACKAGE_STRING
#	undef PACKAGE_TARNAME
#	undef PACKAGE_VERSION
#	undef VERSION
#endif

extern "C"
{
#	define __RPLCAS
#	include "rpl-conv.h"
}

#include <iostream>

using namespace std;

#ifdef RPLCAS
	using namespace giac;
#endif

void
initialisation_contexte_cas(struct_processus *s_etat_processus)
{
	s_etat_processus->contexte_cas = NULL;
	return;
}

void
liberation_contexte_cas(struct_processus *s_etat_processus)
{
	if (s_etat_processus->contexte_cas != NULL)
	{
#		ifdef RPLCAS
		delete reinterpret_cast<giac::context *>(
				s_etat_processus->contexte_cas);
#		endif
		s_etat_processus->contexte_cas = NULL;
	}

	return;
}

#ifdef RPLCAS
static unsigned char *
conversion_rpl_vers_cas(struct_processus *s_etat_processus,
		struct_objet **s_objet)
{
	logical1				drapeau;

	struct_liste_chainee	*l_element_courant;

	struct_objet			*s_objet_temporaire;

	t_8_bits				registre[8];

	unsigned char			*resultat;
	unsigned char			*index;

	for(int i = 0; i < 8; i++)
	{
		registre[i] = s_etat_processus->drapeaux_etat[i];
	}

	sf(s_etat_processus, 35);
	cf(s_etat_processus, 48);
	cf(s_etat_processus, 49);
	cf(s_etat_processus, 50);
	cf(s_etat_processus, 53);
	cf(s_etat_processus, 54);
	cf(s_etat_processus, 55);
	cf(s_etat_processus, 56);

	// GIAC considère que les fonctions sont écrites en minuscules. Le RPL/2
	// part de l'hypothèse inverse. Il faut donc convertir en minuscules tous
	// les noms de fonction. Les fonctions ne peuvent apparaître que dans le
	// cas d'un objet de type ALG.

	if ((*s_objet)->type == NOM)
	{
		if (strcmp((const char *) reinterpret_cast<unsigned char *>(
				reinterpret_cast<struct_nom *>((*s_objet)->objet)->nom),
				"infinity") == 0)
		{
			if (evaluation(s_etat_processus, *s_objet, 'N') == d_erreur)
			{
				return(NULL);
			}

			liberation(s_etat_processus, *s_objet);

			if (depilement(s_etat_processus, &(s_etat_processus
					->l_base_pile), s_objet) == d_erreur)
			{
				return(NULL);
			}
		}
	}
	else if ((*s_objet)->type == ALG)
	{
		if ((s_objet_temporaire = copie_objet(s_etat_processus,
				(*s_objet), 'O')) == NULL)
		{
			s_etat_processus->erreur_systeme = d_es_allocation_memoire;
			return(NULL);
		}

		liberation(s_etat_processus, (*s_objet));
		(*s_objet) = s_objet_temporaire;

		// Si l'expression contient la fonction infinity, on commence par
		// forcer une évaluation numérique.

		l_element_courant = reinterpret_cast<struct_liste_chainee *>(
				(*s_objet)->objet);
		drapeau = d_faux;

		while(l_element_courant != NULL)
		{
			if (l_element_courant->donnee->type == NOM)
			{
				if (strcmp((const char *) reinterpret_cast<unsigned char *>(
						reinterpret_cast<struct_nom *>(
						l_element_courant->donnee->objet)->nom),
						"infinity") == 0)
				{
					drapeau = d_vrai;
					break;
				}
			}

			l_element_courant = l_element_courant->suivant;
		}

		if (drapeau == d_vrai)
		{
			if (evaluation(s_etat_processus, *s_objet, 'N') == d_erreur)
			{
				return(NULL);
			}

			liberation(s_etat_processus, *s_objet);

			if (depilement(s_etat_processus, &(s_etat_processus
					->l_base_pile), s_objet) == d_erreur)
			{
				return(NULL);
			}
		}
	}

	if ((*s_objet)->type == ALG)
	{

		l_element_courant = reinterpret_cast<struct_liste_chainee *>(
				(*s_objet)->objet);

		while(l_element_courant != NULL)
		{
			if (l_element_courant->donnee->type == FCT)
			{
				unsigned char		*ptr;

				ptr = reinterpret_cast<unsigned char *>(
						reinterpret_cast<struct_fonction *>(
						l_element_courant->donnee->objet)->nom_fonction);

				while((*ptr) != d_code_fin_chaine)
				{
					int c = (*ptr);

					if (isalpha(c))
					{
						c = tolower(c);
						(*ptr) = (unsigned char) c;
					}

					ptr++;
				}
			}

			l_element_courant = l_element_courant->suivant;
		}
	}

	resultat = formateur(s_etat_processus, 0, (*s_objet));

	// Il faut remplacer les occurrences de 'relax' par '    +'.

	index = resultat;
	while((index = reinterpret_cast<unsigned char *>(
			strstr(reinterpret_cast<char *>(index),
			(const char *) "relax"))) != NULL)
	{
		strncpy(reinterpret_cast<char *>(index), "    +", 5);
	}

	// Si le résultat vaut infinity, on rajoute le signe +.

	if (strcmp(reinterpret_cast<char *>(resultat), "infinity") == 0)
	{
		if ((resultat = reinterpret_cast<unsigned char *>(
				realloc(resultat, (strlen(reinterpret_cast<char *>(
				resultat)) + 2) * sizeof(unsigned char)))) == NULL)
		{
			s_etat_processus->erreur_systeme = d_es_allocation_memoire;
			return(NULL);
		}

		strcpy(reinterpret_cast<char *>(resultat), "+infinity");
	}

	if (resultat[0] == '\'')
	{
		resultat[0] = ' ';
		resultat[strlen((const char *) resultat) - 1] = ' ';
	}

	for(int i = 0; i < 8; i++)
	{
		s_etat_processus->drapeaux_etat[i] = registre[i];
	}

	return(resultat);
}


static void
conversion_cas_vers_rpl(struct_processus *s_etat_processus,
		unsigned char *expression)
{
	logical1					drapeau;

	struct_liste_chainee		*l_element_courant;

	struct_objet				*s_objet;

	unsigned char				*registre;

	registre = s_etat_processus->instruction_courante;
	s_etat_processus->instruction_courante = expression;
	recherche_type(s_etat_processus);
	s_etat_processus->instruction_courante = registre;

	if ((s_etat_processus->l_base_pile == NULL) ||
			(s_etat_processus->erreur_execution != d_ex) ||
			(s_etat_processus->erreur_systeme != d_es))
	{
		return;
	}

	// Le niveau 1 de la pile opérationnelle contient l'expression
	// à convertir.

	if (depilement(s_etat_processus, &(s_etat_processus
			->l_base_pile), &s_objet) == d_erreur)
	{
		return;
	}

	if ((s_objet->type == ALG) || (s_objet->type == RPN))
	{
		// On transcrit les fonctions de GIAC vers le RPL/2.

		l_element_courant = reinterpret_cast<struct_liste_chainee *>(
				s_objet->objet);
		drapeau = d_faux;

		// S'il y a une valeur infini, on force l'évaluation de l'expression.

		while(l_element_courant != NULL)
		{
			if (l_element_courant->donnee->type == NOM)
			{
				if (strcmp((const char *) reinterpret_cast<unsigned char *>(
						reinterpret_cast<struct_nom *>(
						l_element_courant->donnee->objet)->nom),
						"infinity") == 0)
				{
					drapeau = d_vrai;
					break;
				}
			}

			l_element_courant = l_element_courant->suivant;
		}

		if (drapeau == d_vrai)
		{
			if (evaluation(s_etat_processus, s_objet, 'N') == d_erreur)
			{
				return;
			}

			liberation(s_etat_processus, s_objet);

			if (depilement(s_etat_processus, &(s_etat_processus
					->l_base_pile), &s_objet) == d_erreur)
			{
				return;
			}
		}
	}

	if ((s_objet->type == ALG) || (s_objet->type == RPN))
	{
		l_element_courant = reinterpret_cast<struct_liste_chainee *>(
				s_objet->objet);

		while(l_element_courant != NULL)
		{
			if (l_element_courant->donnee->type == FCT)
			{
				// Nous sommes en présence d'un nom, donc de quelque chose
				// qui n'est pas reconnu comme un mot-clef du RPL/2. S'il
				// s'agit d'un mot-clef de GIAC, on le convertit.

				if ((strcmp((const char *)
						reinterpret_cast<struct_fonction *>(l_element_courant
						->donnee->objet)->nom_fonction, "quote") == 0) ||
						(strcmp((const char *)
						reinterpret_cast<struct_fonction *>(l_element_courant
						->donnee->objet)->nom_fonction, "nop") == 0))
				{
					liberation(s_etat_processus, l_element_courant->donnee);

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

					if ((((struct_fonction *) l_element_courant->donnee->objet)
							->nom_fonction = reinterpret_cast<unsigned char *>(
							malloc(6 * sizeof(unsigned char))))
							== NULL)
					{
						s_etat_processus->erreur_systeme =
								d_es_allocation_memoire;
						return;
					}

					strcpy(reinterpret_cast<char *>(
							reinterpret_cast<struct_fonction *>(
							l_element_courant->donnee->objet)->nom_fonction),
							"RELAX");
				}
			}

			l_element_courant = l_element_courant->suivant;
		}
	}

	if (empilement(s_etat_processus, &(s_etat_processus->l_base_pile),
			s_objet) == d_erreur)
	{
		return;
	}

	return;
}
#endif


/*
================================================================================
  Fonction 'interface_cas'
================================================================================
  Entrées : commande à effectuer.
  Le contrôle des types est effectué dans la fonction appelant interface_cas().
--------------------------------------------------------------------------------
  Sorties : retour par la pile.
--------------------------------------------------------------------------------
  Effets de bord : néant
================================================================================
*/

#pragma GCC diagnostic push
#pragma GCC diagnostic ignored "-Wunused-parameter"
void
interface_cas(struct_processus *s_etat_processus,
		enum t_rplcas_commandes commande)
{
#ifdef RPLCAS
	struct_objet			*s_objet_argument_1;
	struct_objet			*s_objet_argument_2;
	struct_objet			*s_objet_temporaire;

	struct_liste_chainee	*l_element_courant;

	unsigned char			*argument_1;
	unsigned char			*argument_2;
	unsigned char			*argument_3;
	unsigned char			*argument_4;

	unsigned int			position;

	giac::context			*contexte;

	if (s_etat_processus->contexte_cas == NULL)
	{
		try
		{
			s_etat_processus->contexte_cas = new giac::context;
		}
		catch(bad_alloc exception)
		{
			s_etat_processus->erreur_systeme = d_es_allocation_memoire;
			return;
		}
		catch(...)
		{
			s_etat_processus->erreur_execution = d_ex_erreur_interne_rplcas;
			return;
		}
	}

	contexte = reinterpret_cast<giac::context *>(
			s_etat_processus->contexte_cas);

	if ((s_etat_processus->erreur_execution != d_ex) ||
			(s_etat_processus->erreur_systeme != d_es))
	{
		return;
	}

	switch(commande)
	{
		case RPLCAS_INTEGRATION:
		{
			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 ((argument_1 = conversion_rpl_vers_cas(s_etat_processus,
					&s_objet_argument_1)) == NULL)
			{
				s_etat_processus->erreur_systeme = d_es_allocation_memoire;
				return;
			}

			if ((argument_2 = conversion_rpl_vers_cas(s_etat_processus,
					&s_objet_argument_2)) == NULL)
			{
				s_etat_processus->erreur_systeme = d_es_allocation_memoire;
				return;
			}

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

			try
			{
				gen variable(
						string(reinterpret_cast<const char *>(argument_1)),
						contexte);
				gen expression(
						string(reinterpret_cast<const char *>(argument_2)),
						contexte);

				gen resultat = integrate_gen(expression, variable,
						contexte);
				string chaine = "'" + resultat.print() + "'";

				conversion_cas_vers_rpl(s_etat_processus,
						reinterpret_cast<unsigned char *>(const_cast<char *>(
						chaine.c_str())));
			}
			catch(bad_alloc exception)
			{
				s_etat_processus->erreur_systeme = d_es_allocation_memoire;
			}
			catch(...)
			{
				s_etat_processus->erreur_execution = d_ex_erreur_interne_rplcas;
			}

			free(argument_1);
			free(argument_2);

			break;
		}

		case RPLCAS_LIMITE:
		{
			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;
			}

			// Fonction

			if ((argument_2 = conversion_rpl_vers_cas(s_etat_processus,
					&s_objet_argument_2)) == NULL)
			{
				s_etat_processus->erreur_systeme = d_es_allocation_memoire;
				return;
			}

			// On parcourt la liste. Cette liste est tout d'abord copiée
			// car on est susceptible de modifier le second élément.

			if ((s_objet_temporaire = copie_objet(s_etat_processus,
					s_objet_argument_1, 'O')) == NULL)
			{
				s_etat_processus->erreur_systeme = d_es_allocation_memoire;
				return;
			}

			liberation(s_etat_processus, s_objet_argument_1);
			s_objet_argument_1 = s_objet_temporaire;

			l_element_courant = reinterpret_cast<struct_liste_chainee *>
					(s_objet_argument_1->objet);
			position = 1;
			argument_1 = NULL;
			argument_3 = NULL;
			argument_4 = NULL;

			while(l_element_courant != NULL)
			{
				switch(position)
				{
					case 1:
					{
						// Variable

						if ((argument_1 = reinterpret_cast<unsigned char *>
								(malloc((strlen((const char *)
								((struct_variable *) (l_element_courant
								->donnee->objet))->nom)
								+ 1) * sizeof(unsigned char)))) == NULL)
						{
							s_etat_processus->erreur_systeme =
									d_es_allocation_memoire;
							return;
						}

						strcpy(reinterpret_cast<char *>(argument_1),
								(const char *) ((struct_variable *)
								(l_element_courant->donnee->objet))->nom);
						break;
					}

					case 2:
					{
						// Valeur
						if ((argument_3 = conversion_rpl_vers_cas(
								s_etat_processus,
								&(l_element_courant->donnee))) == NULL)
						{
							s_etat_processus->erreur_systeme =
									d_es_allocation_memoire;
							return;
						}

						break;
					}

					case 3:
					{
						// Direction

						if ((argument_4 = reinterpret_cast<unsigned char *>
								(malloc((strlen((const char *)
								((struct_fonction *) (l_element_courant
								->donnee->objet))->nom_fonction)
								+ 1) * sizeof(unsigned char)))) == NULL)
						{
							s_etat_processus->erreur_systeme =
									d_es_allocation_memoire;
							return;
						}

						strcpy(reinterpret_cast<char *>(argument_4),
								(const char *) ((struct_fonction *)
								(l_element_courant->donnee->objet))
								->nom_fonction);
						break;
					}
				}

				l_element_courant = (*l_element_courant).suivant;
				position++;
			}

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

			try
			{
				int				direction;

				if (argument_4 == NULL)
				{
					direction = 0;
				}
				else
				{
					direction = (strcmp((const char *) argument_4, "+") == 0)
							? 1 : -1;
				}

				gen expression(
						string(reinterpret_cast<const char *>(argument_2)),
						contexte);
				identificateur variable(
						string(reinterpret_cast<const char *>(argument_1)));
				gen valeur(string(reinterpret_cast<const char *>
						(argument_3)), contexte);

				gen resultat = limit(expression, variable, valeur, direction,
						contexte);
				string chaine = "'" + resultat.print() + "'";

				conversion_cas_vers_rpl(s_etat_processus,
						reinterpret_cast<unsigned char *>(const_cast<char *>(
						chaine.c_str())));
			}
			catch(bad_alloc exception)
			{
				s_etat_processus->erreur_systeme = d_es_allocation_memoire;
			}
			catch(...)
			{
				s_etat_processus->erreur_execution = d_ex_erreur_interne_rplcas;
			}

			free(argument_1);
			free(argument_2);
			free(argument_3);

			if (argument_4 != NULL)
			{
				free(argument_4);
			}

			break;
		}
	}

	return;
#else

	if (s_etat_processus->langue == 'F')
	{
		printf("+++Attention : RPL/CAS non compilé !\n");
	}
	else
	{
		printf("+++Warning : RPL/CAS not available !\n");
	}

	fflush(stdout);

	return;

#endif
}
#pragma GCC diagnostic pop

// vim: ts=4