--- rpl/src/gestion_pile_systeme.c	2010/07/13 08:59:20	1.15
+++ rpl/src/gestion_pile_systeme.c	2013/03/06 10:05:09	1.53
@@ -1,7 +1,7 @@
 /*
 ================================================================================
-  RPL/2 (R) version 4.0.17
-  Copyright (C) 1989-2010 Dr. BERTRAND Joël
+  RPL/2 (R) version 4.1.13
+  Copyright (C) 1989-2013 Dr. BERTRAND Joël
 
   This file is part of RPL/2.
 
@@ -20,7 +20,7 @@
 */
 
 
-#include "rpl.conv.h"
+#include "rpl-conv.h"
 
 
 /*
@@ -130,7 +130,8 @@ empilement_pile_systeme(struct_processus
 	(*(*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).niveau_courant =
+			(*s_etat_processus).niveau_courant;
 	(*(*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;
@@ -301,10 +302,20 @@ effacement_pile_systeme(struct_processus
 void
 trace(struct_processus *s_etat_processus, FILE *flux)
 {
+	int								candidat;
+	int								j;
+	int								nb_variables;
+
 	integer8						i;
+	integer8						candidat8;
+	integer8						delta;
+
+	struct_liste_chainee			*l_element_expression;
 
 	struct_liste_pile_systeme		*l_element_courant;
 
+	struct_tableau_variables		*tableau;
+
 	unsigned char					*tampon;
 
 	l_element_courant = (*s_etat_processus).l_base_pile_systeme;
@@ -319,6 +330,17 @@ trace(struct_processus *s_etat_processus
 	l_element_courant = (*s_etat_processus).l_base_pile_systeme;
 	flockfile(flux);
 
+	nb_variables = nombre_variables(s_etat_processus);
+
+	if ((tableau = malloc(nb_variables * sizeof(struct_tableau_variables)))
+			== NULL)
+	{
+		(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
+		return;
+	}
+
+	liste_variables(s_etat_processus, tableau);
+
 	if ((flux == stderr) || (flux == stdout))
 	{
 		fprintf(flux, "+++Backtrace\n");
@@ -326,113 +348,329 @@ trace(struct_processus *s_etat_processus
 
 	while(l_element_courant != NULL)
 	{
-		fprintf(flux, "%d : (%p) D=", i--, l_element_courant);
+		fprintf(flux, "%d : address # %016Xh\n", 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).creation_variables_statiques == d_vrai)
+		{
+			fprintf(flux, "    Variables         = static\n");
+		}
+		else if ((*l_element_courant).creation_variables_partagees == d_vrai)
+		{
+			fprintf(flux, "    Variables         = shared\n");
+		}
+		else
+		{
+			fprintf(flux, "    Variables         = automatic\n");
+		}
 
-		if ((*l_element_courant).retour_definition == 'Y')
+		if ((*l_element_courant).arret_si_exception == d_vrai)
 		{
-			fprintf(flux, "RTRN ");
+			fprintf(flux, "    In exception      = abort\n");
+		}
+		else
+		{
+			fprintf(flux, "    In exception      = catch\n");
+		}
 
-			if ((*l_element_courant).origine_routine_evaluation == 'Y')
+		if ((*l_element_courant).clause != ' ')
+		{
+			fprintf(flux, "    Structure         = ");
+
+			switch((*l_element_courant).clause)
 			{
-				fprintf(flux, "EVL ");
+				case 'I':
+					fprintf(flux, "IF\n");
+					break;
 
-				if ((*l_element_courant).adresse_retour != 0)
-				{
-					fprintf(flux, "P=%lu", (*l_element_courant)
-							.adresse_retour);
-				}
+				case 'R':
+					fprintf(flux, "IFERR\n");
+					break;
+
+				case 'X':
+					fprintf(flux, "exception caught by IFERR\n");
+					break;
+
+				case 'T':
+					fprintf(flux, "THEN\n");
+					break;
+				
+				case 'E':
+					fprintf(flux, "ELSE\n");
+					break;
+
+				case 'Z':
+					fprintf(flux, "ELSE (false condition)\n");
+					break;
+
+				case 'D':
+					fprintf(flux, "DO\n");
+					break;
+
+				case 'U':
+					fprintf(flux, "UNTIL\n");
+					break;
+
+				case 'W':
+					fprintf(flux, "WHILE\n");
+					break;
+
+				case 'M':
+					fprintf(flux, "WHILE (false condition)\n");
+					break;
+
+				case 'S':
+					fprintf(flux, "SELECT\n");
+					break;
+
+				case 'K':
+					fprintf(flux, "CASE (no true condition)\n");
+					break;
+
+				case 'C':
+					fprintf(flux, "CASE (one or more true conditions)\n");
+					break;
+
+				case 'Q':
+					fprintf(flux, "CASE (treatment of a true condition)\n");
+					break;
+
+				case 'F':
+					fprintf(flux, "CASE (treatment of default case)\n");
+					break;
 			}
-			else
+		}
+
+		if ((*l_element_courant).type_cloture != ' ')
+		{
+			fprintf(flux, "    Next close        = ");
+
+			switch((*l_element_courant).type_cloture)
 			{
-				fprintf(flux, "SEQ ");
+				case 'C':
+					fprintf(flux, "SELECT\n");
+					break;
 
-				if ((*l_element_courant).pointeur_objet_retour != NULL)
-				{
-					fprintf(flux, "A=%X", (*l_element_courant)
-							.pointeur_objet_retour);
-				}
+				case 'D':
+					fprintf(flux, "DO\n");
+					break;
+
+				case 'I':
+					fprintf(flux, "IF\n");
+					break;
+
+				case 'J':
+					fprintf(flux, "IFERR\n");
+					break;
+
+				case 'K':
+					fprintf(flux, "CASE\n");
+					break;
+
+				case 'W':
+					fprintf(flux, "WHILE\n");
+					break;
+
+				case 'Q':
+					fprintf(flux, "CRITICAL\n");
+					break;
+
+				case 'F':
+					fprintf(flux, "FOR\n");
+					break;
+
+				case 'S':
+					fprintf(flux, "START\n");
+					break;
+
+				case 'L':
+					fprintf(flux, "internal loop\n");
+					break;
+
+				case 'A':
+					fprintf(flux, "FORALL\n");
+					break;
 			}
 		}
-		else
+
+		fprintf(flux, "    Level             = %d\n",
+				(*l_element_courant).niveau_courant);
+
+		if (((*l_element_courant).retour_definition == 'Y') ||
+				((*l_element_courant).origine_routine_evaluation == 'Y'))
 		{
-			fprintf(flux, "NONE ");
+			fprintf(flux, "    Return            = yes\n");
 
 			if ((*l_element_courant).origine_routine_evaluation == 'Y')
 			{
-				fprintf(flux, "EVL ");
+				if ((*l_element_courant).pointeur_objet_retour != NULL)
+				{
+					fprintf(flux, "    Come from         = compiled code ");
+					fprintf(flux, "(address # %016Xh)\n", (*l_element_courant)
+							.pointeur_objet_retour);
 
-				if ((*l_element_courant).adresse_retour != 0)
+					// Calcul de la routine de départ
+
+					candidat = -1;
+
+					for(j = 0; j < nb_variables; j++)
+					{
+						if (((*(tableau[j].objet)).type == RPN) ||
+								((*(tableau[j].objet)).type == ALG))
+						{
+							l_element_expression = (*(tableau[j].objet)).objet;
+
+							while(l_element_expression != NULL)
+							{
+								if (l_element_expression == (*l_element_courant)
+										.pointeur_objet_retour)
+								{
+									candidat = j;
+									break;
+								}
+
+								l_element_expression =
+										(*l_element_expression).suivant;
+							}
+
+							if (candidat != -1)
+							{
+								break;
+							}
+						}
+					}
+
+					if (candidat != -1)
+					{
+						fprintf(flux, "                      = %s [",
+								tableau[candidat].nom);
+					   
+						if ((*(tableau[candidat].objet)).type == RPN)
+						{
+							fprintf(flux, "definition");
+						}
+						else if ((*(tableau[candidat].objet)).type == ALG)
+						{
+							fprintf(flux, "algebraic");
+						}
+						else if ((*(tableau[candidat].objet)).type == NOM)
+						{
+							fprintf(flux, "name");
+						}
+						else
+						{
+							fprintf(flux, "unknown");
+						}
+
+						fprintf(flux, "]\n");
+					}
+					else
+					{
+						fprintf(flux, "                      = "
+								"optimized definition\n");
+					}
+				}
+				else
 				{
-					fprintf(flux, "P=%lu", (*l_element_courant)
-							.adresse_retour);
+					fprintf(flux, "    Come from         = compiled code\n");
+					fprintf(flux, "                      = "
+							"optimized definition\n");
 				}
 			}
 			else
 			{
-				fprintf(flux, "SEQ ");
+				fprintf(flux, "    Come from         = interpreted code ");
 
-				if ((*l_element_courant).pointeur_objet_retour != NULL)
+				if ((*l_element_courant).adresse_retour != 0)
 				{
-					fprintf(flux, "A=%X", (*l_element_courant)
-							.pointeur_objet_retour);
+					fprintf(flux, "(offset # %016Xh)\n", (*l_element_courant)
+							.adresse_retour);
+
+					// Calcul de la routine de départ
+
+					candidat8 = (*s_etat_processus)
+							.longueur_definitions_chainees;
+					candidat = -1;
+
+					for(j = 0; j < nb_variables; j++)
+					{
+						if ((*(tableau[j].objet)).type == ADR)
+						{
+							delta = (*l_element_courant).adresse_retour
+									- (*((unsigned long *)
+									(*(tableau[j].objet)).objet));
+
+							if ((delta >= 0) && (delta < candidat8))
+							{
+								candidat8 = delta;
+								candidat = j;
+							}
+						}
+					}
+
+					if (candidat != -1)
+					{
+						fprintf(flux, "                      = %s\n",
+								tableau[candidat].nom);
+					}
+					else
+					{
+						fprintf(flux, "                      = "
+								"unknown definition\n");
+					}
+				}
+				else
+				{
+					fprintf(flux, "\n");
+					fprintf(flux, "                      = RPL/2 "
+							"initialization\n");
 				}
 			}
 		}
-
-		fprintf(flux, "\n");
+		else
+		{
+			fprintf(flux, "    Return            = no\n");
+		}
 
 		if ((*l_element_courant).indice_boucle != NULL)
 		{
-			tampon = formateur(s_etat_processus, 0,
+			tampon = formateur(s_etat_processus, 24,
 					(*l_element_courant).indice_boucle);
-			fprintf(flux, "  Index         = %s\n", tampon);
+			fprintf(flux, "    Index             = %s\n", tampon);
 			free(tampon);
 		}
 
 		if ((*l_element_courant).limite_indice_boucle != NULL)
 		{
-			tampon = formateur(s_etat_processus, 0,
+			tampon = formateur(s_etat_processus, 24,
 					(*l_element_courant).limite_indice_boucle);
-			fprintf(flux, "  Limit         = %s\n", tampon);
+			fprintf(flux, "    Limit             = %s\n", tampon);
 			free(tampon);
 		}
 
 		if ((*l_element_courant).objet_de_test != NULL)
 		{
-			tampon = formateur(s_etat_processus, 0,
+			tampon = formateur(s_etat_processus, 24,
 					(*l_element_courant).objet_de_test);
-			fprintf(flux, "  Test object   = %s\n", tampon);
+			fprintf(flux, "    Test object       = %s\n", tampon);
 			free(tampon);
 		}
 
 		if ((*l_element_courant).nom_variable != NULL)
 		{
-			fprintf(flux, "  Variable name = %s\n",
+			fprintf(flux, "    Variable name     = %s\n",
 					(*l_element_courant).nom_variable);
 		}
 
+		fprintf(flux, "\n");
+
 		l_element_courant = (*l_element_courant).suivant;
 	}
 
 	fprintf(flux, "\n");
 	funlockfile(flux);
 
+	free(tableau);
+
 	return;
 }