/*
================================================================================
  RPL/2 (R) version 4.0.17
  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"


/*
================================================================================
  Procédure d'estimation de la longueur du tampon
================================================================================
  Entrée :
--------------------------------------------------------------------------------
  Sortie :
--------------------------------------------------------------------------------
  Effets de bord : néant
================================================================================
*/

static inline void
estimation_taille_pile_systeme(struct_processus *s_etat_processus)
{
	(*s_etat_processus).estimation_taille_pile_systeme_tampon =
			((*s_etat_processus).estimation_taille_pile_systeme_tampon *
			((double) 0.9)) + ((*s_etat_processus)
			.hauteur_pile_systeme * ((double) 0.1));
	return;
}


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

void
empilement_pile_systeme(struct_processus *s_etat_processus)
{
	struct_liste_pile_systeme		*l_ancienne_base_liste;
	struct_liste_pile_systeme		*l_nouvelle_base_liste;

	l_ancienne_base_liste = (*s_etat_processus).l_base_pile_systeme;

	if ((*s_etat_processus).debug == d_vrai)
		if (((*s_etat_processus).type_debug &
				d_debug_pile_systeme) != 0)
	{
		if (strlen((*s_etat_processus).instruction_courante) != 0)
		{
			if ((*s_etat_processus).langue == 'F')
			{
				printf("[%d] Empilement sur la pile système à la suite de "
						"l'instruction %s\n", (int) getpid(),
						(*s_etat_processus).instruction_courante);
			}
			else
			{
				printf("[%d] Pushing on system stack (instruction %s)\n",
						(int) getpid(),
						(*s_etat_processus).instruction_courante);
			}
		}
		else
		{
			if ((*s_etat_processus).langue == 'F')
			{
				printf("[%d] Empilement sur la pile système\n",
						(int) getpid());
			}
			else
			{
				printf("[%d] Pushing on system stack\n", (int) getpid());
			}
		}

		fflush(stdout);
	}

	if ((*s_etat_processus).pile_systeme_tampon == NULL)
	{
		// Tampon vide, on alloue un élément.

		if ((l_nouvelle_base_liste = malloc(sizeof(struct_liste_pile_systeme)))
				== NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}
	}
	else
	{
		// Tampon utilisable, on retire un élément du tampon.

		l_nouvelle_base_liste = (*s_etat_processus).pile_systeme_tampon;
		(*s_etat_processus).pile_systeme_tampon =
				(*l_nouvelle_base_liste).suivant;
		(*s_etat_processus).taille_pile_systeme_tampon--;
	}

	(*s_etat_processus).hauteur_pile_systeme++;
	(*s_etat_processus).l_base_pile_systeme = l_nouvelle_base_liste;
	(*(*s_etat_processus).l_base_pile_systeme).suivant =
			l_ancienne_base_liste;

	(*(*s_etat_processus).l_base_pile_systeme).type_cloture = ' ';
	(*(*s_etat_processus).l_base_pile_systeme).clause = ' ';
	(*(*s_etat_processus).l_base_pile_systeme).adresse_retour = 0;
	(*(*s_etat_processus).l_base_pile_systeme).niveau_courant = 0;
	(*(*s_etat_processus).l_base_pile_systeme).retour_definition = 'N';
	(*(*s_etat_processus).l_base_pile_systeme).indice_boucle = NULL;
	(*(*s_etat_processus).l_base_pile_systeme).limite_indice_boucle = NULL;
	(*(*s_etat_processus).l_base_pile_systeme).objet_de_test = NULL;
	(*(*s_etat_processus).l_base_pile_systeme).nom_variable = NULL;
	(*(*s_etat_processus).l_base_pile_systeme).pointeur_objet_retour = NULL;
	(*(*s_etat_processus).l_base_pile_systeme)
			.origine_routine_evaluation = 'N';
	(*(*s_etat_processus).l_base_pile_systeme).arret_si_exception =
			(*s_etat_processus).arret_si_exception;
	(*(*s_etat_processus).l_base_pile_systeme).creation_variables_statiques
			= (*s_etat_processus).creation_variables_statiques;
	(*(*s_etat_processus).l_base_pile_systeme).creation_variables_partagees
			= (*s_etat_processus).creation_variables_partagees;
	(*(*s_etat_processus).l_base_pile_systeme).evaluation_expression =
			d_faux;

	(*s_etat_processus).erreur_systeme = d_es;
	(*s_etat_processus).creation_variables_statiques = d_faux;
	(*s_etat_processus).creation_variables_partagees = d_faux;

	return;
}


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

void
depilement_pile_systeme(struct_processus *s_etat_processus)
{
	struct_liste_pile_systeme		*l_ancienne_base_liste;
	struct_liste_pile_systeme		*l_nouvelle_base_liste;

	if ((*s_etat_processus).debug == d_vrai)
		if (((*s_etat_processus).type_debug &
				d_debug_pile_systeme) != 0)
	{
		if (strlen((*s_etat_processus).instruction_courante) != 0)
		{
			if ((*s_etat_processus).langue == 'F')
			{
				printf("[%d] Dépilement de la pile système à la suite "
						"de l'instruction %s\n", (int) getpid(),
						(*s_etat_processus).instruction_courante);
			}
			else
			{
				printf("[%d] Pulling from system stack (instruction %s)\n",
						(int) getpid(),
						(*s_etat_processus).instruction_courante);
			}
		}
		else
		{
			if ((*s_etat_processus).langue == 'F')
			{
				printf("[%d] Dépilement de la pile système\n",
						(int) getpid());
			}
			else
			{
				printf("[%d] Pulling from system stack\n", (int) getpid());
			}
		}

		fflush(stdout);
	}

	if ((*s_etat_processus).l_base_pile_systeme == NULL)
	{
		(*s_etat_processus).erreur_systeme = d_es_pile_vide;
	}
	else
	{
		(*s_etat_processus).hauteur_pile_systeme--;
		l_ancienne_base_liste = (*s_etat_processus).l_base_pile_systeme;
		l_nouvelle_base_liste = (*l_ancienne_base_liste).suivant;

		(*s_etat_processus).l_base_pile_systeme = l_nouvelle_base_liste;
		(*s_etat_processus).erreur_systeme = d_es;

		// On positionne le drapeau de création des variables statiques.

		(*s_etat_processus).creation_variables_statiques =
				 (*l_ancienne_base_liste).creation_variables_statiques;
		(*s_etat_processus).creation_variables_partagees =
				 (*l_ancienne_base_liste).creation_variables_partagees;

		if ((*l_ancienne_base_liste).nom_variable != NULL)
		{
			free((*l_ancienne_base_liste).nom_variable);
		}

		liberation(s_etat_processus, (*l_ancienne_base_liste).indice_boucle);
		liberation(s_etat_processus,
				(*l_ancienne_base_liste).limite_indice_boucle);
		liberation(s_etat_processus, (*l_ancienne_base_liste).objet_de_test);

		if ((*s_etat_processus).taille_pile_systeme_tampon <= (10 *
				((*s_etat_processus).estimation_taille_pile_systeme_tampon
				+ 1)))
		{
			// Enregistrement de la structure pour un usage ultérieur.

			(*l_ancienne_base_liste).suivant =
					(*s_etat_processus).pile_systeme_tampon;
			(*s_etat_processus).pile_systeme_tampon = l_ancienne_base_liste;
			(*s_etat_processus).taille_pile_systeme_tampon++;
		}
		else
		{
			// Libération car le tampon est plein.

			free(l_ancienne_base_liste);
		}
	}

	return;
}


/*
================================================================================
  Procédure d'effacement de la pile système
================================================================================
  Entrée :
--------------------------------------------------------------------------------
  Sortie :
--------------------------------------------------------------------------------
  Effets de bord : néant
================================================================================
*/

void
effacement_pile_systeme(struct_processus *s_etat_processus)
{
	while((*s_etat_processus).l_base_pile_systeme != NULL)
	{
		depilement_pile_systeme(s_etat_processus);
	}

	return;
}


/*
================================================================================
  Procédure d'affichage de la pile système
================================================================================
  Entrée :
--------------------------------------------------------------------------------
  Sortie :
--------------------------------------------------------------------------------
  Effets de bord : néant
================================================================================
*/

void
trace(struct_processus *s_etat_processus, FILE *flux)
{
	integer8						i;

	struct_liste_pile_systeme		*l_element_courant;

	unsigned char					*tampon;

	l_element_courant = (*s_etat_processus).l_base_pile_systeme;
	i = 0;

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

	l_element_courant = (*s_etat_processus).l_base_pile_systeme;
	flockfile(flux);

	if ((flux == stderr) || (flux == stdout))
	{
		fprintf(flux, "+++Backtrace\n");
	}

	while(l_element_courant != NULL)
	{
		fprintf(flux, "%d : (%p) D=", i--, l_element_courant);

		fprintf(flux, ((*l_element_courant).creation_variables_statiques
				== d_vrai) ? "1" : "0");
		fprintf(flux, ((*l_element_courant).creation_variables_partagees
				== d_vrai) ? "1" : "0");
		fprintf(flux, ((*l_element_courant).arret_si_exception == d_vrai)
				? "1" : "0");
		fprintf(flux, ((*l_element_courant).evaluation_expression == d_vrai)
				? "1" : "0");

		fprintf(flux, " F=%c%c L=%lu ",
				((*l_element_courant).clause == ' ') ? '-' :
				(*l_element_courant).clause,
				((*l_element_courant).type_cloture == ' ') ? '-' :
				(*l_element_courant).type_cloture,
				(*l_element_courant).niveau_courant);

		if ((*l_element_courant).retour_definition == 'Y')
		{
			fprintf(flux, "RTRN ");

			if ((*l_element_courant).origine_routine_evaluation == 'Y')
			{
				fprintf(flux, "EVL ");

				if ((*l_element_courant).adresse_retour != 0)
				{
					fprintf(flux, "P=%lu", (*l_element_courant)
							.adresse_retour);
				}
			}
			else
			{
				fprintf(flux, "SEQ ");

				if ((*l_element_courant).pointeur_objet_retour != NULL)
				{
					fprintf(flux, "A=%X", (*l_element_courant)
							.pointeur_objet_retour);
				}
			}
		}
		else
		{
			fprintf(flux, "NONE ");

			if ((*l_element_courant).origine_routine_evaluation == 'Y')
			{
				fprintf(flux, "EVL ");

				if ((*l_element_courant).adresse_retour != 0)
				{
					fprintf(flux, "P=%lu", (*l_element_courant)
							.adresse_retour);
				}
			}
			else
			{
				fprintf(flux, "SEQ ");

				if ((*l_element_courant).pointeur_objet_retour != NULL)
				{
					fprintf(flux, "A=%X", (*l_element_courant)
							.pointeur_objet_retour);
				}
			}
		}

		fprintf(flux, "\n");

		if ((*l_element_courant).indice_boucle != NULL)
		{
			tampon = formateur(s_etat_processus, 0,
					(*l_element_courant).indice_boucle);
			fprintf(flux, "  Index         = %s\n", tampon);
			free(tampon);
		}

		if ((*l_element_courant).limite_indice_boucle != NULL)
		{
			tampon = formateur(s_etat_processus, 0,
					(*l_element_courant).limite_indice_boucle);
			fprintf(flux, "  Limit         = %s\n", tampon);
			free(tampon);
		}

		if ((*l_element_courant).objet_de_test != NULL)
		{
			tampon = formateur(s_etat_processus, 0,
					(*l_element_courant).objet_de_test);
			fprintf(flux, "  Test object   = %s\n", tampon);
			free(tampon);
		}

		if ((*l_element_courant).nom_variable != NULL)
		{
			fprintf(flux, "  Variable name = %s\n",
					(*l_element_courant).nom_variable);
		}

		l_element_courant = (*l_element_courant).suivant;
	}

	fprintf(flux, "\n");
	funlockfile(flux);

	return;
}

// vim: ts=4