[RPL/2] RPL/2 4.0.0.prerelease.9 - bibliotheques_externes.c

DEMAINE Benoit-Pierre benoit at demaine.info
Lun 2 Fév 16:40:13 CET 2009


/*
================================================================================
  RPL/2 (R) version 4.0.0.prerelease.9
  Copyright (C) 1989-2009 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 at cecill.info.
================================================================================
*/


#include "rpl.conv.h"


/*
================================================================================
  Procédure de chargement d'une bibliothèque dynamique
================================================================================
  Entrée :
--------------------------------------------------------------------------------
  Sortie :
--------------------------------------------------------------------------------
  Effets de bord : néant
================================================================================
*/

void *
chargement_bibliotheque(struct_processus *s_etat_processus,
		unsigned char *bibliotheque)
{
	char					**(*fonction)(unsigned long *);
	char					*message;

	struct_rpl_arguments	rpl_arguments;

	struct_liste_chainee	*l_element_courant;
	struct_liste_chainee	*l_nouvel_element;

	unsigned char			**tableau;
	unsigned char			*tampon;

	unsigned long			nombre_symboles;
	unsigned long			i;

	void					*descripteur_bibliotheque;
	void					(*onloading)(struct_rpl_arguments *);

	/*
	 * On vérifie que la bibliothèque n'est pas déjà chargée.
	 */

	l_element_courant = (*s_etat_processus).s_bibliotheques;

	while(l_element_courant != NULL)
	{
		if (strcmp((*((struct_bibliotheque *) (*l_element_courant).donnee)).nom,
				bibliotheque) == 0)
		{
			(*s_etat_processus).erreur_execution = d_ex_bibliotheque_chargee;
			return(NULL);
		}

		l_element_courant = (*l_element_courant).suivant;
	}

	/*
	 * Ouverture de la bibliothèque
	 */

	if ((descripteur_bibliotheque = dlopen(bibliotheque,
			RTLD_NOW | RTLD_LOCAL)) == NULL)
	{
		printf("%s\n", message = dlerror());
		free(message);
		(*s_etat_processus).erreur_execution = d_ex_erreur_bibliotheque;
		return(NULL);
	}

	if ((message = dlerror()) != NULL)
	{
		free(message);
	}

	onloading = dlsym(descripteur_bibliotheque, "__runOnLoading");

	if ((message = dlerror()) == NULL)
	{
		rpl_arguments.l_base_pile = (*s_etat_processus).l_base_pile;
		rpl_arguments.l_base_pile_last = (*s_etat_processus).l_base_pile_last;

		for(i = 0; i < 8; i++)
		{
			rpl_arguments.drapeaux_etat[i] =
					(*s_etat_processus).drapeaux_etat[i];
		}

		rpl_arguments.message_erreur = NULL;
		rpl_arguments.type_erreur = 'E';
		rpl_arguments.erreur = 0;
		rpl_arguments.aide = ((*s_etat_processus).affichage_arguments
				== 'N') ? d_faux : d_vrai;
		rpl_arguments.affichage_arguments = (*s_etat_processus)
				.affichage_arguments;
		rpl_arguments.test_instruction = (*s_etat_processus).test_instruction;
		rpl_arguments.constante_symbolique = (*s_etat_processus)
				.constante_symbolique;
		rpl_arguments.instruction_valide = 'N';
		rpl_arguments.s_etat_processus = s_etat_processus;

		(*s_etat_processus).erreur_execution = d_ex;

		if ((*s_etat_processus).profilage == d_vrai)
		{
			if ((tampon = malloc((strlen(bibliotheque) + 14) *
					sizeof(unsigned char))) == NULL)
			{
				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
				return(NULL);
			}

			sprintf(tampon, "%s$runOnLoading", bibliotheque);
			profilage(s_etat_processus, tampon);
			free(tampon);

			if ((*s_etat_processus).erreur_systeme != d_es)
			{
				return(NULL);
			}
		}

		(*onloading)(&rpl_arguments);

		if ((*s_etat_processus).profilage == d_vrai)
		{
			profilage(s_etat_processus, NULL);
		}

		(*s_etat_processus).nombre_arguments = rpl_arguments.nombre_arguments;
		(*s_etat_processus).constante_symbolique = rpl_arguments
				.constante_symbolique;
		(*s_etat_processus).instruction_valide = rpl_arguments
				.instruction_valide;

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

		if (rpl_arguments.erreur != 0)
		{
			if (((*s_etat_processus).arret_si_exception == d_vrai) ||
					(rpl_arguments.type_erreur == 'S'))
			{
				if (test_cfsf(s_etat_processus, 51) == d_faux)
				{
					printf("%s", ds_beep);
				}

				if (rpl_arguments.type_erreur == 'S')
				{
					(*s_etat_processus).derniere_erreur_execution = -1;

					if ((*s_etat_processus).langue == 'F')
					{
						printf("+++Système : Fonction dynamique %s "
								"(ligne %lld)\n",
								"onLoading", rpl_arguments.erreur);
					}
					else
					{
						printf("+++System : %s dynamic function (line %lld)\n",
								"onLoading", rpl_arguments.erreur);
					}
				}
				else
				{
					(*s_etat_processus).derniere_erreur_systeme = -1;

					if ((*s_etat_processus).langue == 'F')
					{
						printf("+++Erreur : Fonction dynamique %s "
								"(ligne %lld)\n",
								"onLoading" , rpl_arguments.erreur);
					}
					else
					{
						printf("+++Error : %s dynamic function (line %lld)\n",
								"onLoading", rpl_arguments.erreur);
					}
				}

				if (rpl_arguments.message_erreur != NULL)
				{
					printf("%s\n", rpl_arguments.message_erreur);
				}

				fflush(stdout);
			}

			if (rpl_arguments.type_erreur == 'S')
			{
				(*s_etat_processus).erreur_systeme =
						d_es_execution_bibliotheque;
			}
			else
			{
				(*s_etat_processus).erreur_execution =
						d_ex_execution_bibliotheque;
			}
		}

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

		for(i = 0; i < 8; i++)
		{
			(*s_etat_processus).drapeaux_etat[i] =
					rpl_arguments.drapeaux_etat[i];
		}

		l_element_courant = (*s_etat_processus).l_base_pile;
		(*s_etat_processus).hauteur_pile_operationnelle = 0;

		while(l_element_courant != NULL)
		{
			(*s_etat_processus).hauteur_pile_operationnelle++;
			l_element_courant = (*l_element_courant).suivant;
		}
	}
	else
	{
		free(message);
	}

	if ((message = dlerror()) != NULL)
	{
		free(message);
	}

	fonction = dlsym(descripteur_bibliotheque, "__external_symbols");

	if ((message = dlerror()) != NULL)
	{
		free(message);

		(*s_etat_processus).erreur_execution = d_ex_erreur_bibliotheque;
		return(NULL);
	}

	/*
	 * Ajout des symboles externes
	 */

	if ((tableau = (unsigned char **) (*fonction)(&nombre_symboles)) == NULL)
	{
		if (nombre_symboles == 0)
		{
			(*s_etat_processus).erreur_execution = d_ex_aucun_symbole;
		}
		else
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
		}

		return(NULL);
	}

	if (((*s_etat_processus).s_instructions_externes = realloc(
			(*s_etat_processus).s_instructions_externes,
			((*s_etat_processus).nombre_instructions_externes + nombre_symboles)
			* sizeof(struct_instruction_externe))) == NULL)
	{
		(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
		return(NULL);
	}

	for(i = 0; i < nombre_symboles; i++)
	{
		(*s_etat_processus).s_instructions_externes[(*s_etat_processus)
				.nombre_instructions_externes].descripteur_bibliotheque =
				descripteur_bibliotheque;

		if (((*s_etat_processus).s_instructions_externes[(*s_etat_processus)
				.nombre_instructions_externes].nom =
				malloc((strlen(index(tableau[i], '$') + 1) + 1) *
				sizeof(unsigned char))) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return(NULL);
		}

		strcpy((*s_etat_processus).s_instructions_externes[(*s_etat_processus)
				.nombre_instructions_externes].nom,
				index(tableau[i], '$') + 1);

		*(index(tableau[i], '$')) = d_code_fin_chaine;

		if (((*s_etat_processus).s_instructions_externes[(*s_etat_processus)
				.nombre_instructions_externes].nom_bibliotheque = realloc(
				tableau[i], (strlen(tableau[i]) + 1) * sizeof(unsigned char)))
				== NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return(NULL);
		}

		(*s_etat_processus).nombre_instructions_externes++;
	}

	/*
	 * Ajout de la nouvelle bibliothèque
	 */

	if ((l_nouvel_element = (struct_liste_chainee *)
			malloc(sizeof(struct_liste_chainee))) == NULL)
	{
		(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
		return(NULL);
	}

	if (((*l_nouvel_element).donnee = malloc(sizeof(struct_bibliotheque)))
			== NULL)
	{
		(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
		return(NULL);
	}

	(*((struct_bibliotheque *) (*l_nouvel_element).donnee)).descripteur =
			descripteur_bibliotheque;
	(*((struct_bibliotheque *) (*l_nouvel_element).donnee)).pid =
			getpid();
	(*((struct_bibliotheque *) (*l_nouvel_element).donnee)).tid =
			pthread_self();

	if (((*((struct_bibliotheque *) (*l_nouvel_element).donnee)).nom =
			malloc((strlen((*s_etat_processus).s_instructions_externes
			[(*s_etat_processus).nombre_instructions_externes - 1]
			.nom_bibliotheque) + 1) * sizeof(unsigned char))) == NULL)
	{
		(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
		return(NULL);
	}

	strcpy((*((struct_bibliotheque *) (*l_nouvel_element).donnee)).nom,
			(*s_etat_processus).s_instructions_externes
			[(*s_etat_processus).nombre_instructions_externes - 1]
			.nom_bibliotheque);

	(*l_nouvel_element).suivant = (*s_etat_processus).s_bibliotheques;
	(*s_etat_processus).s_bibliotheques = l_nouvel_element;

	tri_base_symboles_externes(s_etat_processus);

	free(tableau);

	return(descripteur_bibliotheque);
}


/*
================================================================================
  Procédure de retrait d'une bibliothèque dynamique
================================================================================
  Entrée :
--------------------------------------------------------------------------------
  Sortie :
--------------------------------------------------------------------------------
  Effets de bord : néant
================================================================================
*/

logical1
retrait_bibliotheque(struct_processus *s_etat_processus,
		struct_bibliotheque *descripteur)
{
	char						*message;

	logical1					presence_bibliotheque;

	struct_instruction_externe	*registre;

	struct_liste_chainee		*l_element_courant;
	struct_liste_chainee		*l_element_precedent;

	struct_rpl_arguments		rpl_arguments;

	unsigned char				*tampon;

	unsigned long				i;
	unsigned long				j;
	unsigned long				nombre_symboles_residuels;

	void						(*onclosing)(struct_rpl_arguments *);

	l_element_courant = (*s_etat_processus).s_bibliotheques;
	presence_bibliotheque = d_faux;
	l_element_precedent = NULL;

	/*
	 * Recherche de la bibliothèque à supprimer
	 */

	while(l_element_courant != NULL)
	{
		if (((*((struct_bibliotheque *) (*l_element_courant).donnee))
				.descripteur == (*descripteur).descripteur) &&
				((*((struct_bibliotheque *) (*l_element_courant).donnee)).pid
				== getpid()) && (pthread_equal((*((struct_bibliotheque *)
				(*l_element_courant).donnee)).tid, pthread_self()) != 0))
		{
			presence_bibliotheque = d_vrai;
			break;
		}

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

	if (presence_bibliotheque == d_vrai)
	{
		if ((message = dlerror()) != NULL)
		{
			free(message);
		}

		onclosing = dlsym((*descripteur).descripteur, "__runOnClosing");

		if ((message = dlerror()) == NULL)
		{
			rpl_arguments.l_base_pile = (*s_etat_processus).l_base_pile;
			rpl_arguments.l_base_pile_last =
					(*s_etat_processus).l_base_pile_last;

			for(i = 0; i < 8; i++)
			{
				rpl_arguments.drapeaux_etat[i] =
						(*s_etat_processus).drapeaux_etat[i];
			}

			rpl_arguments.message_erreur = NULL;
			rpl_arguments.type_erreur = 'E';
			rpl_arguments.erreur = 0;
			rpl_arguments.aide = ((*s_etat_processus).affichage_arguments
					== 'N') ? d_faux : d_vrai;
			rpl_arguments.affichage_arguments = (*s_etat_processus)
					.affichage_arguments;
			rpl_arguments.test_instruction =
					(*s_etat_processus).test_instruction;
			rpl_arguments.constante_symbolique = (*s_etat_processus)
					.constante_symbolique;
			rpl_arguments.instruction_valide = 'N';
			rpl_arguments.s_etat_processus = s_etat_processus;

			(*s_etat_processus).erreur_execution = d_ex;

			if ((*s_etat_processus).profilage == d_vrai)
			{
				if ((tampon = malloc((strlen((*descripteur).nom) + 14) *
						sizeof(unsigned char))) == NULL)
				{
					(*s_etat_processus).erreur_systeme =
							d_es_allocation_memoire;
					return(d_erreur);
				}

				sprintf(tampon, "%s$runOnClosing", (*descripteur).nom);
				profilage(s_etat_processus, tampon);
				free(tampon);

				if ((*s_etat_processus).erreur_systeme != d_es)
				{
					return(d_erreur);
				}
			}

			(*onclosing)(&rpl_arguments);

			if ((*s_etat_processus).profilage == d_vrai)
			{
				profilage(s_etat_processus, NULL);
			}

			(*s_etat_processus).nombre_arguments =
					rpl_arguments.nombre_arguments;
			(*s_etat_processus).constante_symbolique = rpl_arguments
					.constante_symbolique;
			(*s_etat_processus).instruction_valide = rpl_arguments
					.instruction_valide;

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

			if (rpl_arguments.erreur != 0)
			{
				if (((*s_etat_processus).arret_si_exception == d_vrai) ||
						(rpl_arguments.type_erreur == 'S'))
				{
					if (test_cfsf(s_etat_processus, 51) == d_faux)
					{
						printf("%s", ds_beep);
					}

					if (rpl_arguments.type_erreur == 'S')
					{
						(*s_etat_processus).derniere_erreur_execution = -1;

						if ((*s_etat_processus).langue == 'F')
						{
							printf("+++Système : Fonction dynamique "
									"%s (ligne %lld)\n",
									"onClosing" , rpl_arguments.erreur);
						}
						else
						{
							printf("+++System : %s dynamic function "
									"(line %lld)\n",
									"onClosing", rpl_arguments.erreur);
						}
					}
					else
					{
						(*s_etat_processus).derniere_erreur_systeme = -1;

						if ((*s_etat_processus).langue == 'F')
						{
							printf("+++Erreur : Fonction dynamique %s "
									"(ligne %lld)\n",
									"onClosing", rpl_arguments.erreur);
						}
						else
						{
							printf("+++Error : %s dynamic function "
									"(line %lld)\n",
									"onClosing", rpl_arguments.erreur);
						}
					}

					if (rpl_arguments.message_erreur != NULL)
					{
						printf("%s\n", rpl_arguments.message_erreur);
					}

					fflush(stdout);
				}

				if (rpl_arguments.type_erreur == 'S')
				{
					(*s_etat_processus).erreur_systeme =
							d_es_execution_bibliotheque;
				}
				else
				{
					(*s_etat_processus).erreur_execution =
							d_ex_execution_bibliotheque;
				}
			}

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

			for(i = 0; i < 8; i++)
			{
				(*s_etat_processus).drapeaux_etat[i] =
						rpl_arguments.drapeaux_etat[i];
			}

			l_element_courant = (*s_etat_processus).l_base_pile;
			(*s_etat_processus).hauteur_pile_operationnelle = 0;

			while(l_element_courant != NULL)
			{
				(*s_etat_processus).hauteur_pile_operationnelle++;
				l_element_courant = (*l_element_courant).suivant;
			}
		}
		else
		{
			free(message);
		}

		/*
		 * Retrait de la bibliothèque de la pile
		 */

		dlclose((*descripteur).descripteur);

		l_element_courant = (*s_etat_processus).s_bibliotheques;

		while(l_element_courant != NULL)
		{
			if ((*((struct_bibliotheque *) (*l_element_courant).donnee))
					.descripteur == (*descripteur).descripteur)
			{
				break;
			}

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

		if (l_element_precedent == NULL)
		{
			(*s_etat_processus).s_bibliotheques = (*l_element_courant).suivant;
		}
		else
		{
			(*l_element_precedent).suivant = (*l_element_courant).suivant;
		}

		free((*((struct_bibliotheque *) (*l_element_courant).donnee)).nom);
		free((*l_element_courant).donnee);
		free(l_element_courant);

		/*
		 * Retrait des symboles associés à la bibliothèque
		 */

		nombre_symboles_residuels = 0;

		for(i = 0; i < (*s_etat_processus).nombre_instructions_externes; i++)
		{
			if ((*s_etat_processus).s_instructions_externes[i]
					.descripteur_bibliotheque != (*descripteur).descripteur)
			{
				nombre_symboles_residuels++;
			}
		}

		if (nombre_symboles_residuels == 0)
		{
			free((*s_etat_processus).s_instructions_externes);
			(*s_etat_processus).s_instructions_externes = NULL;
		}
		else
		{
			registre = (*s_etat_processus).s_instructions_externes;

			if (((*s_etat_processus).s_instructions_externes =
					malloc(nombre_symboles_residuels *
					sizeof(struct_instruction_externe))) == NULL)
			{
				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;

				return(d_erreur);
			}

			for(i = j = 0; i < (*s_etat_processus).nombre_instructions_externes;
					i++)
			{
				if (registre[i].descripteur_bibliotheque !=
						(*descripteur).descripteur)
				{
					(*s_etat_processus).s_instructions_externes[j].nom =
							registre[i].nom;
					(*s_etat_processus).s_instructions_externes[j]
							.nom_bibliotheque = registre[i].nom_bibliotheque;
					(*s_etat_processus).s_instructions_externes[j]
							.descripteur_bibliotheque = registre[i]
							.descripteur_bibliotheque;
					j++;
				}
			}

			free(registre);
		}

		(*s_etat_processus).nombre_instructions_externes =
				nombre_symboles_residuels;

		return(d_absence_erreur);
	}
	else
	{
		(*s_etat_processus).erreur_execution = d_ex_erreur_bibliotheque;

		return(d_erreur);
	}
}


/*
================================================================================
  Procédure d'exécution d'une fonction d'une bibliothèque
================================================================================
  Entrée :
--------------------------------------------------------------------------------
  Sortie :
--------------------------------------------------------------------------------
  Effets de bord : néant
================================================================================
*/

logical1
execution_fonction_de_bibliotheque(struct_processus *s_etat_processus,
		unsigned char *nom_fonction, unsigned char *bibliotheque)
{
	char							*message;

	logical1						presence_bibliotheque;
	logical1						unicite_symbole;

	long							difference;
	long							difference_inferieure;
	long							difference_superieure;

	struct_liste_chainee			*l_element_courant;

	struct_rpl_arguments			rpl_arguments;

	unsigned char					*nom_fonction_externe;
	unsigned char					*tampon;

	unsigned long					borne_inferieure;
	unsigned long					borne_superieure;
	unsigned long					i;
	unsigned long					moyenne;
	unsigned long					nombre_iterations_maximal;
	unsigned long					ordre_iteration;

	void							(*fonction)(struct_rpl_arguments *);

	/*
	 * Recherche dichotomique de la définition externe
	 */

	if ((*s_etat_processus).nombre_instructions_externes == 0)
	{
		return(d_faux);
	}

	if (bibliotheque != NULL)
	{
		presence_bibliotheque = d_faux;
		l_element_courant = (*s_etat_processus).s_bibliotheques;

		while(l_element_courant != NULL)
		{
			if (strcmp((*((struct_bibliotheque *) (*l_element_courant).donnee))
					.nom, bibliotheque) == 0)
			{
				presence_bibliotheque = d_vrai;
				break;
			}

			l_element_courant = (*l_element_courant).suivant;
		}

		if (presence_bibliotheque == d_faux)
		{
			return(d_faux);
		}
	}

	ordre_iteration = 0;
	nombre_iterations_maximal = ((unsigned long)
			(log((*s_etat_processus).nombre_instructions_externes) / log(2)))
			+ 2;

	borne_inferieure = 0;
	borne_superieure = (*s_etat_processus).nombre_instructions_externes - 1;

	do
	{
		moyenne = (borne_inferieure + borne_superieure) / 2;
		ordre_iteration++;

		if ((2 * ((unsigned long) ((borne_inferieure + borne_superieure) / 2)))
				== (borne_inferieure + borne_superieure))
		{
			difference = strcmp(nom_fonction, (*s_etat_processus)
					.s_instructions_externes[moyenne].nom);

			if (difference != 0)
			{
				if (difference > 0)
				{
					borne_inferieure = moyenne;
				}
				else
				{
					borne_superieure = moyenne;
				}
			}
		}
		else
		{
			difference_inferieure = strcmp(nom_fonction,
					(*s_etat_processus).s_instructions_externes[moyenne].nom);
			difference_superieure = strcmp(nom_fonction,
					(*s_etat_processus).s_instructions_externes[moyenne + 1]
					.nom);

			if (difference_inferieure == 0)
			{
				difference = 0;
			}
			else if (difference_superieure == 0)
			{
				difference = 0;
				moyenne++;
			}
			else
			{
				difference = difference_inferieure;

				if (difference > 0)
				{
					borne_inferieure = moyenne;
				}
				else
				{
					borne_superieure = moyenne;
				}
			}
		}
	} while((difference != 0) &&
			(ordre_iteration <= nombre_iterations_maximal));

	if (ordre_iteration > nombre_iterations_maximal)
	{
		return(d_faux);
	}

	if (bibliotheque != NULL)
	{ // Nom de la bibliothèque spécifié
		if (strcmp((*s_etat_processus).s_instructions_externes[moyenne]
				.nom_bibliotheque, bibliotheque) > 0)
		{
			i = moyenne;

			while(i >= 0)
			{
				if (strcmp((*s_etat_processus).s_instructions_externes[i]
						.nom, nom_fonction) != 0)
				{
					break;
				}
				else if (strcmp((*s_etat_processus).s_instructions_externes[i]
						.nom_bibliotheque, bibliotheque) == 0)
				{
					break;
				}

				i--;
			}

			moyenne = i;
		}
		else if (strcmp((*s_etat_processus).s_instructions_externes[moyenne]
				.nom_bibliotheque, bibliotheque) < 0)
		{
			i = moyenne;

			while(i < (*s_etat_processus).nombre_instructions_externes)
			{
				if (strcmp((*s_etat_processus).s_instructions_externes[i]
						.nom, nom_fonction) != 0)
				{
					break;
				}
				else if (strcmp((*s_etat_processus).s_instructions_externes[i]
						.nom_bibliotheque, bibliotheque) == 0)
				{
					break;
				}

				i++;
			}

			moyenne = i;
		}
	}
	else
	{ // Nom de la bibliothèque non spécifié

		/*
		 * Vérification de l'unicité du symbole
		 */

		unicite_symbole = d_vrai;

		if (moyenne > 0)
		{
			if (strcmp((*s_etat_processus).s_instructions_externes
					[moyenne - 1].nom, nom_fonction) == 0)
			{
				unicite_symbole = d_faux;
			}
		}

		if ((moyenne + 1) < (*s_etat_processus)
				.nombre_instructions_externes)
		{
			if (strcmp((*s_etat_processus).s_instructions_externes
					[moyenne + 1].nom, nom_fonction) == 0)
			{
				unicite_symbole = d_faux;
			}
		}

		if (unicite_symbole == d_faux)
		{
			(*s_etat_processus).erreur_execution = d_ex_definition_ambigue;
			return(d_faux);
		}
	}

	if ((nom_fonction_externe = malloc((strlen(nom_fonction) + 12)
			* sizeof(unsigned char))) == NULL)
	{
		(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
		return(d_faux);
	}

	sprintf(nom_fonction_externe, "__external_%s", nom_fonction);

	if ((message = dlerror()) != NULL)
	{
		free(message);
	}

	fonction = dlsym((*s_etat_processus).s_instructions_externes
			[moyenne].descripteur_bibliotheque, nom_fonction_externe);

	free(nom_fonction_externe);

	/*
	 * Vérification de la présence du symbole
	 */

	if ((message = dlerror()) != NULL)
	{
		free(message);
		return(d_faux);
	}

	/*
	 * Exécution de la fonction externe
	 */

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

	for(i = 0; i < 8; i++)
	{
		rpl_arguments.drapeaux_etat[i] =
				(*s_etat_processus).drapeaux_etat[i];
	}

	rpl_arguments.message_erreur = NULL;
	rpl_arguments.type_erreur = 'E';
	rpl_arguments.erreur = 0;
	rpl_arguments.aide = ((*s_etat_processus).affichage_arguments
			== 'N') ? d_faux : d_vrai;
	rpl_arguments.affichage_arguments = (*s_etat_processus)
			.affichage_arguments;
	rpl_arguments.test_instruction = (*s_etat_processus).test_instruction;
	rpl_arguments.constante_symbolique = (*s_etat_processus)
			.constante_symbolique;
	rpl_arguments.instruction_valide = 'N';
	rpl_arguments.s_etat_processus = s_etat_processus;

	(*s_etat_processus).erreur_execution = d_ex;

	if ((*s_etat_processus).profilage == d_vrai)
	{
		if ((tampon = malloc(strlen((*s_etat_processus)
				.s_instructions_externes[moyenne].nom_bibliotheque)
				+ strlen(nom_fonction) + 2)) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return(d_faux);
		}

		sprintf(tampon, "%s$%s", (*s_etat_processus).s_instructions_externes
				[moyenne].nom_bibliotheque, nom_fonction);
		profilage(s_etat_processus, tampon);
		free(tampon);

		if ((*s_etat_processus).erreur_systeme != d_es)
		{
			return(d_faux);
		}
	}

	(*fonction)(&rpl_arguments);

	if ((*s_etat_processus).profilage == d_vrai)
	{
		profilage(s_etat_processus, NULL);
	}

	(*s_etat_processus).nombre_arguments = rpl_arguments.nombre_arguments;
	(*s_etat_processus).constante_symbolique = rpl_arguments
			.constante_symbolique;
	(*s_etat_processus).instruction_valide = rpl_arguments
			.instruction_valide;

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

	if (rpl_arguments.erreur != 0)
	{
		if (((*s_etat_processus).arret_si_exception == d_vrai) ||
				(rpl_arguments.type_erreur == 'S'))
		{
			if (test_cfsf(s_etat_processus, 51) == d_faux)
			{
				printf("%s", ds_beep);
			}

			if (rpl_arguments.type_erreur == 'S')
			{
				(*s_etat_processus).derniere_erreur_execution = -1;

				if ((*s_etat_processus).langue == 'F')
				{
					printf("+++Système : Fonction dynamique %s (ligne %lld)\n",
							nom_fonction, rpl_arguments.erreur);
				}
				else
				{
					printf("+++System : %s dynamic function (line %lld)\n",
							nom_fonction, rpl_arguments.erreur);
				}
			}
			else
			{
				(*s_etat_processus).derniere_erreur_systeme = -1;

				if ((*s_etat_processus).langue == 'F')
				{
					printf("+++Erreur : Fonction dynamique %s (ligne %lld)\n",
							nom_fonction, rpl_arguments.erreur);
				}
				else
				{
					printf("+++Error : %s dynamic function (line %lld)\n",
							nom_fonction, rpl_arguments.erreur);
				}
			}

			if (rpl_arguments.message_erreur != NULL)
			{
				printf("%s\n", rpl_arguments.message_erreur);
			}

			fflush(stdout);
		}

		if (rpl_arguments.type_erreur == 'S')
		{
			(*s_etat_processus).erreur_systeme =
					d_es_execution_bibliotheque;
		}
		else
		{
			(*s_etat_processus).erreur_execution =
					d_ex_execution_bibliotheque;
		}
	}

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

	for(i = 0; i < 8; i++)
	{
		(*s_etat_processus).drapeaux_etat[i] =
				rpl_arguments.drapeaux_etat[i];
	}

	l_element_courant = (*s_etat_processus).l_base_pile;
	(*s_etat_processus).hauteur_pile_operationnelle = 0;

	while(l_element_courant != NULL)
	{
		(*s_etat_processus).hauteur_pile_operationnelle++;
		l_element_courant = (*l_element_courant).suivant;
	}

	return(d_vrai);
}


/*
================================================================================
  Wrapper vers une fonction intrinsèque
================================================================================
  Entrée :
--------------------------------------------------------------------------------
  Sortie :
--------------------------------------------------------------------------------
  Effets de bord : néant
================================================================================
*/

int
wrapper_instruction_intrinseque(void (*fonction)(),
		struct_rpl_arguments *rpl_arguments)
{
	int						i;

	struct_liste_chainee	*l_element_courant;

	struct_processus		*s_etat_processus;

	s_etat_processus = (*rpl_arguments).s_etat_processus;

	(*s_etat_processus).nombre_arguments = (*rpl_arguments).nombre_arguments;
	(*s_etat_processus).constante_symbolique = (*rpl_arguments)
			.constante_symbolique;
	(*s_etat_processus).instruction_valide = (*rpl_arguments)
			.instruction_valide;
	(*s_etat_processus).l_base_pile = (*rpl_arguments).l_base_pile;
	(*s_etat_processus).l_base_pile_last = (*rpl_arguments).l_base_pile_last;

	for(i = 0; i < 8; i++)
	{
		(*s_etat_processus).drapeaux_etat[i] =
				(*rpl_arguments).drapeaux_etat[i];
	}

	l_element_courant = (*s_etat_processus).l_base_pile;
	(*s_etat_processus).hauteur_pile_operationnelle = 0;

	while(l_element_courant != NULL)
	{
		(*s_etat_processus).hauteur_pile_operationnelle++;
		l_element_courant = (*l_element_courant).suivant;
	}

	(*fonction)(s_etat_processus);

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

	for(i = 0; i < 8; i++)
	{
		(*rpl_arguments).drapeaux_etat[i] =
				(*s_etat_processus).drapeaux_etat[i];
	}

	(*rpl_arguments).message_erreur = NULL;
	(*rpl_arguments).type_erreur = 'E';
	(*rpl_arguments).erreur = 0;
	(*rpl_arguments).aide = ((*s_etat_processus).affichage_arguments
			== 'N') ? d_faux : d_vrai;
	(*rpl_arguments).affichage_arguments = (*s_etat_processus)
			.affichage_arguments;
	(*rpl_arguments).test_instruction = (*s_etat_processus).test_instruction;
	(*rpl_arguments).constante_symbolique = (*s_etat_processus)
			.constante_symbolique;
	(*rpl_arguments).instruction_valide = 'N';
	(*rpl_arguments).s_etat_processus = s_etat_processus;

	if (((*s_etat_processus).erreur_execution != d_ex) ||
			((*s_etat_processus).exception != d_ep))
	{
		return(1);
	}

	if ((*s_etat_processus).erreur_systeme != d_es)
	{
		return(2);
	}

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

	return(0);
}


/*
================================================================================
  Procédure d'empilement d'un nouvel élément
================================================================================
  Entrée :
--------------------------------------------------------------------------------
  Sortie :
--------------------------------------------------------------------------------
  Effets de bord : néant
================================================================================
*/

struct_liste_chainee *
empilement_pile_operationnelle(struct_rpl_arguments *s_rpl_arguments,
		struct_objet *s_objet)
{
	struct_liste_chainee		*l_ancienne_base_liste;
	struct_liste_chainee		*l_nouvelle_base_liste;

	l_ancienne_base_liste = (*s_rpl_arguments).l_base_pile;

	l_nouvelle_base_liste = (struct_liste_chainee *) malloc(
			sizeof(struct_liste_chainee));

	if (l_nouvelle_base_liste != NULL)
	{
		(*l_nouvelle_base_liste).donnee = s_objet;
		(*l_nouvelle_base_liste).suivant = l_ancienne_base_liste;
	}

	(*s_rpl_arguments).l_base_pile = l_nouvelle_base_liste;

	return l_nouvelle_base_liste;
}


/*
================================================================================
  Procédure de dépilement d'un élément. L'emplacement est libéré dans la
pile.
================================================================================
  Entrée :
--------------------------------------------------------------------------------
  Sortie :
--------------------------------------------------------------------------------
  Effets de bord : néant
================================================================================
*/

struct_liste_chainee *
depilement_pile_operationnelle(struct_rpl_arguments *s_rpl_arguments,
		struct_objet **s_objet)
{
	struct_liste_chainee		*l_ancienne_base_liste;
	struct_liste_chainee		*l_nouvelle_base_liste;

	if ((*s_rpl_arguments).l_base_pile == NULL)
	{
		*s_objet = NULL;
		return(NULL);
	}
	else
	{
		l_ancienne_base_liste = (*s_rpl_arguments).l_base_pile;
		l_nouvelle_base_liste = (*l_ancienne_base_liste).suivant;

		*s_objet = (*l_ancienne_base_liste).donnee;
		free(l_ancienne_base_liste);

		(*s_rpl_arguments).l_base_pile = l_nouvelle_base_liste;

		return(l_nouvelle_base_liste);
	}
}


/*
================================================================================
  Procédure de sauvegarde des arguments dans la pile last
================================================================================
  Entrée : structure processus et nombre d'aguments à empiler
--------------------------------------------------------------------------------
  Sortie : drapeau d'erreur de la structure rpl_arguments
--------------------------------------------------------------------------------
  Effets de bord : efface le précédent contenu de la pile LAST
================================================================================
*/

struct_liste_chainee *
sauvegarde_arguments(struct_rpl_arguments *s_rpl_arguments,
		unsigned long nombre_arguments)
{
	struct_liste_chainee			*l_ancienne_base_liste;
	struct_liste_chainee			*l_element_courant;
	struct_liste_chainee			*l_element_suivant;
	struct_liste_chainee			*l_nouvelle_base_liste;

	struct_objet					*s_objet;

	logical1						erreur;

	t_8_bits						masque;

	unsigned char					indice_bit;
	unsigned char					indice_bloc;
	unsigned char					indice_drapeau;
	unsigned char					taille_bloc;

	unsigned long					i;

	(*s_rpl_arguments).erreur = 0;

	indice_drapeau = 31;
	indice_drapeau--;
	taille_bloc = sizeof(t_8_bits) * 8;
	indice_bloc = indice_drapeau / taille_bloc;
	indice_bit = indice_drapeau % taille_bloc;

	masque = ((t_8_bits) 1) << (taille_bloc - indice_bit - 1);

	if (((*s_rpl_arguments).drapeaux_etat[indice_bloc] & masque) == 0)
	{
		return (*s_rpl_arguments).l_base_pile_last;
	}
	
	erreur = d_absence_erreur;

	l_element_courant = (*s_rpl_arguments).l_base_pile_last;
	while(l_element_courant != NULL)
	{
		liberation((*l_element_courant).donnee);
		l_element_suivant = (*l_element_courant).suivant;
		free(l_element_courant);
		l_element_courant = l_element_suivant;
	}

	(*s_rpl_arguments).l_base_pile_last = NULL;
	l_element_courant = (*s_rpl_arguments).l_base_pile;
	l_nouvelle_base_liste = (*s_rpl_arguments).l_base_pile_last;

	for(i = 0; ((i < nombre_arguments) && (erreur == d_absence_erreur)
			&& (l_element_courant != NULL)); i++)
	{
		s_objet = copie_objet((*l_element_courant).donnee, 'P');

		if (s_objet != NULL)
		{
			l_ancienne_base_liste = l_nouvelle_base_liste;
			l_nouvelle_base_liste = (struct_liste_chainee *) malloc(
					sizeof(struct_liste_chainee));

			if (l_nouvelle_base_liste != NULL)
			{
				(*l_nouvelle_base_liste).donnee = s_objet;
				(*l_nouvelle_base_liste).suivant = l_ancienne_base_liste;
				
			}
			else
			{
				erreur = d_erreur;
			}

			l_element_courant = (*l_element_courant).suivant;
		}
		else
		{
			erreur = d_erreur;
		}
	}

	if (i != nombre_arguments)
	{
		/*
		 * Erreur système : la pile est vidée et la routine renvoie NULL.
		 */

		l_element_courant = l_nouvelle_base_liste;
		while(l_element_courant != NULL)
		{
			liberation((*l_element_courant).donnee);
			l_element_suivant = (*l_element_courant).suivant;
			free(l_element_courant);
			l_element_courant = l_element_suivant;
		}

		l_nouvelle_base_liste = NULL;
		(*s_rpl_arguments).erreur = i;
	}

	return(l_nouvelle_base_liste);
}


/*
================================================================================
  Procédure de tri des symboles externes

  Principe du tri dit de Shell-Metzner
================================================================================
  Entrée :
--------------------------------------------------------------------------------
  Sortie :
--------------------------------------------------------------------------------
  Effets de bord : néant
================================================================================
*/

void
tri_base_symboles_externes(struct_processus *s_etat_processus)
{
	logical1			terminaison_boucle;
	logical1			terminaison_boucle_1;
	logical1			terminaison_boucle_2;
	logical1			terminaison_boucle_3;

	signed long			indice_i;
	signed long			indice_j;
	signed long			indice_k;
	signed long			indice_l;

	unsigned long		borne_inferieure;
	unsigned long		borne_superieure;
	unsigned long		ecartement;
	unsigned long		indice;

	ecartement = (*s_etat_processus).nombre_instructions_externes;

	terminaison_boucle_1 = d_faux;

	do
	{
		ecartement = ecartement / 2;

		if (ecartement >= 1)
		{
			indice_j = 0;
			indice_k = (*s_etat_processus).nombre_instructions_externes
					- ecartement;

			terminaison_boucle_2 = d_faux;

			do
			{
				indice_i = indice_j;

				terminaison_boucle_3 = d_faux;

				do
				{
					indice_l = indice_i + ecartement;

					if ((indice_i > 0) && (indice_l > 0))
					{
						if (strcmp(((*s_etat_processus).s_instructions_externes
								[indice_i - 1]).nom, ((*s_etat_processus)
								.s_instructions_externes[indice_l - 1]).nom)
								> 0)
						{
							swap((void *) &((*s_etat_processus)
									.s_instructions_externes
									[indice_i - 1]), (void *)
									&((*s_etat_processus)
									.s_instructions_externes[indice_l - 1]),
									sizeof(struct_instruction_externe));

							indice_i -= ecartement;

							if (indice_i < 1)
							{
								terminaison_boucle_3 = d_vrai;
							}
						}
						else
						{
							terminaison_boucle_3 = d_vrai;
						}
					}
					else
					{
						terminaison_boucle_3 = d_vrai;
					}
				} while(terminaison_boucle_3 == d_faux);

				indice_j++;

				if (indice_j > indice_k)
				{
					terminaison_boucle_2 = d_vrai;
				}
			} while(terminaison_boucle_2 == d_faux);
		}
		else
		{
			terminaison_boucle_1 = d_vrai;
		}
	} while(terminaison_boucle_1 == d_faux);

	indice_i = 0;

	do
	{
		indice_j = indice_i;

		while(((indice_i + 1) < (*s_etat_processus)
				.nombre_instructions_externes) && (strcmp(((*s_etat_processus)
				.s_instructions_externes[indice_i]).nom, ((*s_etat_processus)
				.s_instructions_externes[indice_i + 1]).nom) == 0))
		{
			indice_i++;
		}

		borne_inferieure = indice_j;
		borne_superieure = indice_i;

		do
		{
			terminaison_boucle = d_vrai;

			for(indice = borne_inferieure + 1; indice <= borne_superieure;
					indice++)
			{
				if (strcmp((*s_etat_processus).s_instructions_externes[indice]
						.nom_bibliotheque, (*s_etat_processus)
						.s_instructions_externes[indice - 1].nom_bibliotheque)
						< 0)
				{
					swap((void *) &((*s_etat_processus).s_instructions_externes
							[indice - 1]), (void *) &((*s_etat_processus)
							.s_instructions_externes[indice]),
							sizeof(struct_instruction_externe));

					terminaison_boucle = d_faux;
				}
			}
		} while(terminaison_boucle == d_faux);

		indice_i++;
	} while((indice_i + 1) < (*s_etat_processus).nombre_variables);

	return;
}

// vim: ts=4


-- 
 >o_/ DEMAINE Benoit-Pierre (aka DoubleHP) http://benoit.demaine.info/
If computing were an exact science, IT engineers would not have work \_o<

"So all that's left, Is the proof that love's not only blind but deaf."
(FAKE TALES OF SAN FRANCISCO, Arctic Monkeys)


Plus d'informations sur la liste de diffusion RPL2